pax_global_header00006660000000000000000000000064135476626710014533gustar00rootroot0000000000000052 comment=6f14a63a120d001655d46a672842985960999459 net-ldapapi-3.0.7/000077500000000000000000000000001354766267100137405ustar00rootroot00000000000000net-ldapapi-3.0.7/.gitignore000066400000000000000000000003231354766267100157260ustar00rootroot00000000000000blib/ /.build/ _build/ cover_db/ inc/ Build !Build/ Build.bat .last_cover_stats Makefile Makefile.old MANIFEST.bak META.json MYMETA.* nytprof.out pm_to_blib *.o *.bs *.gcov *.gcda *.gcno *~ LDAPapi.c constant.h net-ldapapi-3.0.7/Changes000066400000000000000000000254531354766267100152440ustar00rootroot00000000000000Revision history for Perl5 Net::LDAPapi Module. 3.0.7 Thu Oct 10 10:06:00 PST 2019 - Fix undeclared variables introduced in fixes for Issue #51 3.0.6 Mon Oct 07 10:03:00 PST 2019 - Fix memory leaks (Issue #51) 3.0.5 Fri Dec 01 10:03:00 PST 2017 - Fix cookie handling with MMR configuration - Fix ASN1 encoding of sync cookie 3.0.4 Mon Nov 30 19:00:00 PST 2015 - Fix undef comparison - Misc variable initializations to quiet warnings - Fixed sasl mechanisms initializtion - Examples cleanup - LDAPv3 extended operation support - New developer mode test suite - Fixed quanah/net-ldapapi#3: ldap_set_rebind_proc XS being called with invalid arguments from set_rebind_proc - Fixed quanah/net-ldapapi#6: ldap_sasl_bind has wrong prototype in LDAPapi.xs - Fixed quanah/net-ldapapi#8: search_s() clobbers ATTRS parameter - Fixed quanah/net-ldapapi#11: result() blocking when called with output from rename() - Fixed quanah/net-ldapapi#20: ldap_result() doesn't honour passed timeout value - Fixed quanah/net-ldapapi#21: ldap_set_option(LDAP_OPT_TIMEOUT, 1) on OpenLDAP returns -1 - Fixed quanah/net-ldapapi#28: Server control responses get eaten after a NULL character in the berval - Fixed quanah/net-ldapapi#30: ldap_search_ext() and ldap_search_ext_s() segfault when used with timeout - Fixed quanah/net-ldapapi#31: ldap_result() and ldap_url_search_st() timeout parameters have a granularity of 1 second - Fixed quanah/net-ldapapi#40: Server control requests get eaten after a NULL character in the berval 3.0.3 Wed Aug 20 12:23:00 PST 2008 - Add Convert::ASN1 requirement. - Fix error code handling (CPAN bug#35910) 3.0.2 Wed Jan 02 12:23:00 PST 2008 - Fix various variable initializations and scope issues - Fix initialization of sasl parm - Fix test unbind - Add ldap_perror function 3.0.1 Thu Aug 09 17:22:15 PDT 2007 - New 3.0.1 release, fixes sasl headers 3.0.0 Thu Jul 12 12:13:00 PDT 2007 - New 3.0 release, using the LDAP V3 api 2.01 Fri Feb 09 08:41:46 PST 2007 - Fix library linking 2.00 Tue Feb 06 18:46:38 PST 2007 - Stripped out ISODE, UMich bits - Updated to refer to Mozilla C SDK 1.43 Sat Jun 13 02:39:15 CDT 1998 - Added replacement for strcasecmp that was more portable - Fixed a few memory leaks caused by changes in 1.42 and tested these changes on both Netscape and UMICH SDKs. - Changed the test.pl to be more intuitive and no longer require modifications. - Made a few cosmetic changes to Makefile.PL 1.42 Sat Apr 25 22:27:22 CDT 1998 - Added named arguments to all methods - Got rid of a few old ber_free's that were causing problems - Fixed the sort functions (Thanks to Miguel Marques) - Added the ldap_url functions - I was destroying error messages before I printed them in a few of the ldapwalk examples. Whoops. Fixed. - Fixed problem with Out of Memory errors on some platforms with the get_all_values function. - Fixed a multitude of problems with rebinding - Resolved issue resulting in dumped core on modify where NULL values were passed. - Much more extensive testing by the author against both Netscape and University of Michigan libraries. Many small corrections. - Added Makefile.PL options for Netscape LDAPv3 SDK. No v3 calls added yet. 1.40a Wed Jan 28 11:20:51 CST 1998 - sort_entries and multisort_entries have been added with the single arguments $attr and \@attr respectively. Neither seem to work properly on my system when sorting anything besides DN (attr = non-null). Please try this function on your system and let me know if it you can get it to work. If so, I will finish adding this function with another argument to specify a perl based compare function for the sort. - Lots of changes from Hallvard B. Furuseth Including: o Got rid of extra checks in LDAPapi.pm where checks exist in XS or Perl. o Cleaned up ldap_[_s] with a few simple changes to hash2mod() function. Also fixed bug in that function that causes problems when you supply an empty hash. o Small typos and bug fixes in test.pl fixed. o Error string is now retrieved when requested, rather than after every call (What was I thinking when I did this? Who knows....) o Fixed some reverse logic in ldap__option in the XS file. - Changed memory related calls to use 'New' and 'Safefree' macros, which seems to be what the perlguts document suggests. - Got rid of the ber_free define in ldap_compat.h when using UMICH. This was causing core dumps on some platforms. - Added ldap_mod_attr.pl to the examples. A wonderful script from Andrew J Cosgriff . 1.40 Wed Jan 21 11:12:24 CST 1998 - I never did include the new version of web500.pl that supports Add functionality. It did exist, and I've included it with this release. - There was a bug when adding or modifying a record where the value was set to be an integer. The bug has probably existed since a very old version of the module. It has now been fixed. - Fix to internal rebind process for Netscape API users provided by Rob Weltman of Netscape. 1.40beta Tue Jan 13 14:54:13 CST 1998 - Wow, what hasn't changed in this version... - Removed the extra 'free' in ldap_get_dn that was submitted as a fix to a memory leak. The fix seems to give inconsistent results on different platforms and APIs. - Added Perl-OO methods for virtually all API calls. The C style API calls still work, and will work in all future versions. Note that I haven't added named arguments yet, so argument order matters. This should be in the next version. - Manpages completely rewritten. Please send me any errors or typos. - All examples except the two web ones have been rewritten to run under 'use Strict'. - Test program and all examples except web500.pl have been rewritten to use Perl-OO methods. Might need to clean-up comments and code after so many rewrites. - Minor bugfixes to web500.pl 1.39a Tue Nov 25 16:37:35 CST 1997 - Version 1.39 "overimproved" memory handling. It seemed to dump core, as it occasionally freed memory that Perl felt very inclined to freeing on its own. Whoops! This is only a bugfix release put out while I work on v1.40. - In the process of debugging, also changed several scripts to run under 'use strict' and 'perl -w'. 1.39 Mon Oct 27 15:33:12 CST 1997 - Added Al Grimstead's memory leak fix for ldap_get_all_entries. - Added Windows NT 4.0 Support (using Perl5.004, not ActiveState Perl) - Added finished web500.pl Gateway - Improved memory handling in Add/Modify Routine - Included updatepw.pl in the examples directory. This is a script that can syncronize unix passwords into directories supporting crypted passwords. 1.36 Fri Aug 29 14:54:38 CDT 1997 - Added ldap_get_all_entries, which is not a C API command, but useful anyway. Thanks to Andreas Beck for some of the code to make this possible. - Included a few new examples (ldapwalk2.pl and web500.pl) 1.35 Tue Aug 26 15:44:25 CDT 1997 - Added SSL Functions when using Netscape SDK - Added the following functions for non-Netscape SDKs (and ensured that they now work properly for Netscape SDK users): ldap_get_lderrno (to get errno from LDAP struct) ldap_set_lderrno (to set errno from LDAP struct) ldap_msgid (to obtain msgid from an LDAPMessage *) ldap_msgtype (to obtain msgtype from an LDAPMessage *) ldap_set_option (to set some LDAP * options) ldap_get_option (to get some LDAP * options) - Added support for a rebind process. Mostly untested, so let me know how well this works for you. You can set this to a PERL routine using ldap_set_rebind_proc($ld,\&perl_function_name), then make sure that this function returns DN, PASSWORD, and AUTHTYPE. - Added more code and documentation fixes from Hallvard Furuseth - Fixed documentation/code errors noted by Al Grimstad - Added ldap_compat.h for non-Netscape SDK users. - Added Credits file containing people who have provided feedback and fixes. - Added Todo file containing list of things I'm working on (or would like to be working on). 1.31 Tue Jul 29 17:25:54 CDT 1997 - Added function prototypes for internal functions so that some C compilers don't complain. - Fixed the ldap_*_option functions for Netscape SDK users. - Implemented fixes from Hallvard Furuseth for ISODE support and lots of code cleanup, including a very nice script to autogenerate a constant.h file. THANKS! 1.30 Tue Jul 22 17:19:36 CDT 1997 - Fixes Makefile.PL to add Kerberos libraries if needed. Also added LDAP_AUTH_KRB* defines to LDAPapi.xs file. - Changed all malloc to PERL5 safe versions. - Now properly free all LDAPMod structures after ldap_add & ldap_modify - Completely rewrote add and modify routines and added binary value support to add and modify command - Added ldap_get_values_len function to support retrieving binary attributes. 1.21 Fri Jul 18 08:53:11 CDT 1997 - Fixed the compile warnings with University of Michigan - Changed www-ldap.pl to only submit changed items. - Updated all files changing module name from LDAP to Net::LDAPapi 1.20 Thu Jul 17 01:20:08 CDT 1997 - Changed LDAP.xs - added hash2add and hash2mod internal routines and seriously cleaned up the add and modify routines. - References to Arrays (\%) are now required as the third parameter to ldap_add* and ldap_modify* functions. - Updated README, Man Page in LDAP.pm, and other documentation changes. 1.11 Wed Jul 16 10:48:17 CDT 1997 - Changed LDAP.xs and Makefile.PL to make this module work with University of Michigan LDAP SDK. Tested on Solaris. - 'ldap_init' call does not seem to work properly if compiled with University of Michigan LDAP SDK. Otherwise all OK. Use ldap_open as a temporary work-around. 1.1 Tue Jul 15 17:54:27 CDT 1997 - Fixed a few simple bugs in ldap_modify* and ldap_add* commands. - Included new www-ldap.pl CGI script 1.0 Thu Jun 26 13:35:14 CDT 1997 - All Async and Sync Add, Modify, and Delete commands have been added. As have commands to manipulate DNs and other data. - FIRST RELEASE VERSION - See README for supported LDAP API calls 0.5 Tue May 6 09:00:31 CDT 1997 - original version; Original name: LDAP. Modify Routines Not Yet Available net-ldapapi-3.0.7/Credits000066400000000000000000000033401354766267100152600ustar00rootroot00000000000000############################################### # Net::LDAPapi - Credits List # ############################################### Special thanks to the following people for providing useful fixes and suggestions. Hallvard B. Furuseth (Various Fixes/Suggestions) - Most of the fixes and suggestions implemeted in 1.40a were from Hallvard. - Many of fixes made in 1.21 were also suggested by Hallvard. Andreas Beck - Supplied much of the code and the idea for ldap_get_all_entries Douglas Gray Stephens - Various fixes, both to the CGIs and other things... Al Grimstad - Helped debug lderrno/etc and helped fix a number of memory leaks Christian Murphy - Small fix for AIX Library Name in Makefile Jauder Ho - Redhat Linux Makefile Fix and useful bug reports Bill Dixon - His example isolated the bug w/ integer modifys Rob Weltman - Supplied fix for rebinding when using Netscape SDK Andrew J Cosgriff - The wonderful ldap_mod_attr.pl script - Various Useful Bug Reports Dmitri Priimak - For doing the majority of the Net::LDAPapi 3.0 work Howard Chu - For getting this project started again Marcus Watts - For submitting patches to the new code line Phillip O'Donnell - Extended operation support - Behaviour driven development test suite - Bugfixes -- Quanah Gibson-Mount quanah.gibsonmount@gmail.com CPAN: /by-authors/id/M/MI/MISHIKAL/ -- Clayton Donley donley@wwa.com http://www.wwa.com/~donley/ CPAN: /authors/id/CDONLEY net-ldapapi-3.0.7/LDAPapi.pm000066400000000000000000002542101354766267100155140ustar00rootroot00000000000000package Net::LDAPapi; use strict; use Carp; use Convert::ASN1; use vars qw($VERSION @ISA @EXPORT $AUTOLOAD); no warnings "uninitialized"; require Exporter; require DynaLoader; require AutoLoader; @ISA = qw(Exporter DynaLoader); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. @EXPORT = qw( ldap_create ldap_set_option ldap_get_option ldap_unbind_ext ldap_unbind_ext_s ldap_version ldap_abandon_ext ldap_add_ext ldap_add_ext_s ldap_set_rebind_proc ldap_rename ldap_rename_s ldap_compare_ext ldap_compare_ext_s ldap_delete_ext ldap_delete_ext_s ldap_search_ext ldap_search_ext_s ldap_result ldap_extended_operation ldap_extended_operation_s ldap_parse_extended_result ldap_parse_whoami ldap_whoami ldap_whoami_s ldap_msgfree ldap_msg_free ldap_msgid ldap_msgtype ldap_get_lderrno ldap_set_lderrno ldap_parse_result ldap_err2string ldap_count_entries ldap_first_entry ldap_next_entry ldap_get_dn ldap_err2string ldap_dn2ufn ldap_str2dn ldap_str2rdn ldap_explode_rdn ldap_explode_dns ldap_first_attribute ldap_next_attribute ldap_get_values ldap_get_values_len ldap_sasl_bind ldap_sasl_bind_s ldapssl_client_init ldapssl_init ldapssl_install_routines ldap_get_all_entries ldap_multisort_entries ldap_is_ldap_url ldap_url_parse ldap_url_search ldap_url_search_s ldap_url_search_st ber_free ldap_init ldap_initialize ldap_start_tls_s ldap_sasl_interactive_bind_s ldap_create_control ldap_control_berval LDAP_RES_BIND LDAP_RES_SEARCH_ENTRY LDAP_RES_SEARCH_REFERENCE LDAP_RES_SEARCH_RESULT LDAP_RES_MODIFY LDAP_RES_ADD LDAP_RES_DELETE LDAP_RES_MODDN LDAP_RES_COMPARE LDAP_RES_EXTENDED LDAP_RES_INTERMEDIATE LDAP_RES_ANY LDAP_RES_UNSOLICITED LDAPS_PORT LDAP_ADMIN_LIMIT_EXCEEDED LDAP_AFFECTS_MULTIPLE_DSAS LDAP_ALIAS_DEREF_PROBLEM LDAP_ALIAS_PROBLEM LDAP_ALREADY_EXISTS LDAP_AUTH_KRBV4 LDAP_AUTH_KRBV41 LDAP_AUTH_KRBV41_30 LDAP_AUTH_KRBV42 LDAP_AUTH_KRBV42_30 LDAP_AUTH_NONE LDAP_AUTH_SASL LDAP_AUTH_SIMPLE LDAP_AUTH_UNKNOWN LDAP_BUSY LDAP_CACHE_CHECK LDAP_CACHE_LOCALDB LDAP_CACHE_POPULATE LDAP_CALLBACK LDAP_COMPARE_FALSE LDAP_COMPARE_TRUE LDAP_CONNECT_ERROR LDAP_CONSTRAINT_VIOLATION LDAP_CONTROL_ASSERT LDAP_CONTROL_DUPENT LDAP_CONTROL_DUPENT_ENTRY LDAP_CONTROL_DUPENT_REQUEST LDAP_CONTROL_DUPENT_RESPONSE LDAP_CONTROL_GROUPING LDAP_CONTROL_MANAGEDIT LDAP_CONTROL_MANAGEDSAIT LDAP_CONTROL_NOOP LDAP_CONTROL_NO_SUBORDINATES LDAP_CONTROL_PAGEDRESULTS LDAP_CONTROL_PASSWORDPOLICYREQUEST LDAP_CONTROL_PASSWORDPOLICYRESPONSE LDAP_CONTROL_PERSIST_ENTRY_CHANGE_NOTICE LDAP_CONTROL_PERSIST_REQUEST LDAP_CONTROL_POST_READ LDAP_CONTROL_PRE_READ LDAP_CONTROL_PROXY_AUTHZ LDAP_CONTROL_SLURP LDAP_CONTROL_SORTREQUEST LDAP_CONTROL_SORTRESPONSE LDAP_CONTROL_SUBENTRIES LDAP_CONTROL_SYNC LDAP_CONTROL_SYNC_DONE LDAP_CONTROL_SYNC_STATE LDAP_CONTROL_VALSORT LDAP_CONTROL_VALUESRETURNFILTER LDAP_CONTROL_VLVREQUEST LDAP_CONTROL_VLVRESPONSE LDAP_CONTROL_X_CHAINING_BEHAVIOR LDAP_CONTROL_X_DOMAIN_SCOPE LDAP_CONTROL_X_EXTENDED_DN LDAP_CONTROL_X_INCREMENTAL_VALUES LDAP_CONTROL_X_PERMISSIVE_MODIFY LDAP_CONTROL_X_SEARCH_OPTIONS LDAP_CONTROL_X_TREE_DELETE LDAP_CONTROL_X_VALUESRETURNFILTER LDAP_CUP_INVALID_DATA LDAP_DECODING_ERROR LDAP_DEREF_ALWAYS LDAP_DEREF_FINDING LDAP_DEREF_NEVER LDAP_DEREF_SEARCHING LDAP_ENCODING_ERROR LDAP_FILTER_ERROR LDAP_FILT_MAXSIZ LDAP_INAPPROPRIATE_AUTH LDAP_INAPPROPRIATE_MATCHING LDAP_INSUFFICIENT_ACCESS LDAP_INVALID_CREDENTIALS LDAP_INVALID_DN_SYNTAX LDAP_INVALID_SYNTAX LDAP_IS_LEAF LDAP_LOCAL_ERROR LDAP_LOOP_DETECT LDAP_MOD_ADD LDAP_MOD_BVALUES LDAP_MOD_DELETE LDAP_MOD_REPLACE LDAP_NAMING_VIOLATION LDAP_NOT_ALLOWED_ON_NONLEAF LDAP_NOT_ALLOWED_ON_RDN LDAP_NO_LIMIT LDAP_NO_MEMORY LDAP_NO_OBJECT_CLASS_MODS LDAP_NO_SUCH_ATTRIBUTE LDAP_NO_SUCH_OBJECT LDAP_OBJECT_CLASS_VIOLATION LDAP_OPERATIONS_ERROR LDAP_OPT_CACHE_ENABLE LDAP_OPT_CACHE_FN_PTRS LDAP_OPT_CACHE_STRATEGY LDAP_OPT_DEBUG_LEVEL LDAP_OPT_DEREF LDAP_OPT_DESC LDAP_OPT_DNS LDAP_OPT_IO_FN_PTRS LDAP_OPT_OFF LDAP_OPT_ON LDAP_OPT_PROTOCOL_VERSION LDAP_OPT_REBIND_ARG LDAP_OPT_REBIND_FN LDAP_OPT_REFERRALS LDAP_OPT_REFERRAL_HOP_LIMIT LDAP_OPT_RESTART LDAP_OPT_SIZELIMIT LDAP_OPT_SSL LDAP_OPT_THREAD_FN_PTRS LDAP_OPT_TIMELIMIT LDAP_OPT_TIMEOUT LDAP_OPT_NETWORK_TIMEOUT LDAP_OTHER LDAP_PARAM_ERROR LDAP_PARTIAL_RESULTS LDAP_PORT LDAP_PORT_MAX LDAP_PROTOCOL_ERROR LDAP_REFERRAL LDAP_RESULTS_TOO_LARGE LDAP_SASL_AUTOMATIC LDAP_SASL_INTERACTIVE LDAP_SASL_NULL LDAP_SASL_QUIET LDAP_SASL_SIMPLE LDAP_SCOPE_BASE LDAP_SCOPE_ONELEVEL LDAP_SCOPE_SUBTREE LDAP_SECURITY_NONE LDAP_SERVER_DOWN LDAP_SIZELIMIT_EXCEEDED LDAP_STRONG_AUTH_NOT_SUPPORTED LDAP_STRONG_AUTH_REQUIRED LDAP_SUCCESS LDAP_SYNC_INFO LDAP_TIMELIMIT_EXCEEDED LDAP_TIMEOUT LDAP_TYPE_OR_VALUE_EXISTS LDAP_UNAVAILABLE LDAP_UNAVAILABLE_CRITICAL_EXTN LDAP_UNDEFINED_TYPE LDAP_UNWILLING_TO_PERFORM LDAP_URL_ERR_BADSCOPE LDAP_URL_ERR_MEM LDAP_URL_ERR_NODN LDAP_URL_ERR_NOTLDAP LDAP_URL_ERR_PARAM LDAP_URL_OPT_SECURE LDAP_USER_CANCELLED LDAP_VERSION LDAP_VERSION1 LDAP_VERSION2 LDAP_VERSION3 LDAP_TAG_SYNC_NEW_COOKIE LDAP_TAG_SYNC_REFRESH_DELETE LDAP_TAG_SYNC_REFRESH_PRESENT LDAP_TAG_SYNC_ID_SET LDAP_TAG_SYNC_COOKIE LDAP_TAG_REFRESHDELETES LDAP_TAG_REFRESHDONE LDAP_TAG_RELOAD_HINT LDAP_TAG_EXOP_MODIFY_PASSWD_ID LDAP_TAG_EXOP_MODIFY_PASSWD_OLD LDAP_TAG_EXOP_MODIFY_PASSWD_NEW LDAP_TAG_EXOP_MODIFY_PASSWD_GEN LDAP_TAG_MESSAGE LDAP_TAG_MSGID LDAP_TAG_LDAPDN LDAP_TAG_LDAPCRED LDAP_TAG_CONTROLS LDAP_TAG_REFERRAL LDAP_TAG_NEWSUPERIOR LDAP_TAG_EXOP_REQ_OID LDAP_TAG_EXOP_REQ_VALUE LDAP_TAG_EXOP_RES_OID LDAP_TAG_EXOP_RES_VALUE LDAP_TAG_IM_RES_OID LDAP_TAG_IM_RES_VALUE LDAP_TAG_SASL_RES_CREDS ); $VERSION = '3.0.7'; sub AUTOLOAD { # This AUTOLOAD is used to 'autoload' constants from the constant() # XS function. If a constant is not found then control is passed # to the AUTOLOAD in AutoLoader. my $constname; ($constname = $AUTOLOAD) =~ s/.*:://; my $val = constant($constname, @_ ? $_[0] : 0); if ($! != 0) { if ($! =~ /Invalid/) { # try constants_h $val = '"'.constant_s($constname).'"'; goto SUBDEF if ($! == 0); $AutoLoader::AUTOLOAD = $AUTOLOAD; goto &AutoLoader::AUTOLOAD; } else { croak "Your vendor has not defined LDAP macro $constname"; } } SUBDEF: eval "sub $AUTOLOAD { $val }"; goto &$AUTOLOAD; } bootstrap Net::LDAPapi $VERSION; # creats blessed ldap object. # accepts following arguments '-host', '-port', '-url', '-debug' # if '-url' is given then then '-host' and '-port' are not used sub new { my ($this, @args) = @_; my $class = ref($this) || $this; my $self = {}; my $ld; bless $self, $class; my ($host, $port, $url, $debug) = $self->rearrange(['HOST','PORT','URL', 'DEBUG'],@args); if ( defined($url) ) { return -1 unless (ldap_initialize($ld, $url) == $self->LDAP_SUCCESS ); } else { $host = "localhost" unless $host; $port = $self->LDAP_PORT unless $port; return -1 unless ( ldap_initialize($ld, "ldap://$host:$port") == $self-> LDAP_SUCCESS); } # Following ASN.1 contains definitions for synrepl API my $asn = Convert::ASN1->new; $asn->prepare(<error; syncUUID ::= OCTET STRING syncCookie ::= OCTET STRING syncRequestValue ::= SEQUENCE { mode ENUMERATED { refreshOnly (1), refreshAndPersist (3) }, cookie syncCookie OPTIONAL, reloadHint BOOLEAN } syncStateValue ::= SEQUENCE { state ENUMERATED, entryUUID syncUUID, cookie syncCookie OPTIONAL } refresh_Delete ::= SEQUENCE { cookie syncCookie OPTIONAL, refreshDone BOOLEAN OPTIONAL } refresh_Present ::= SEQUENCE { cookie syncCookie OPTIONAL, refreshDone BOOLEAN OPTIONAL } syncId_Set ::= SEQUENCE { cookie syncCookie OPTIONAL, refreshDeletes BOOLEAN OPTIONAL, syncUUIDs SET OF syncUUID } syncInfoValue ::= CHOICE { newcookie [0] syncCookie, refreshDelete [1] refresh_Delete, refreshPresent [2] refresh_Present, syncIdSet [3] syncId_Set } ASN $self->{"asn"} = $asn; $self->{"ld"} = $ld; $self->{"errno"} = 0; $self->{"errstring"} = undef; $self->{"debug"} = $debug; ldap_set_option($ld, $self->LDAP_OPT_PROTOCOL_VERSION, $self->LDAP_VERSION3); return $self; } # end of new sub DESTROY {}; sub abandon { my ($self, @args) = @_; my ($status, $sctrls, $cctrls); my ($msgid, $serverctrls, $clientctrls) = $self->rearrange(['MSGID', 'SCTRLS', 'CCTRLS'], @args); croak("Invalid MSGID") if ($msgid < 0); $sctrls = $self->create_controls_array(@$serverctrls) if $serverctrls; $cctrls = $self->create_controls_array(@$clientctrls) if $clientctrls; $status = ldap_abandon_ext($self->{"ld"}, $msgid, $sctrls, $cctrls); $self->errorize($status); ldap_controls_array_free($sctrls) if $sctrls; ldap_controls_array_free($cctrls) if $cctrls; return $status; } # end of abandon # synonim for abandon(...) sub abandon_ext { my ($self, @args) = @_; return $self->abandon(@args); } # end of abandon_ext sub add { my ($self,@args) = @_; my ($msgid, $sctrls, $cctrls, $status); my ($dn, $mod, $serverctrls, $clientctrls) = $self->rearrange(['DN', 'MOD', 'SCTRLS', 'CCTRLS'], @args); croak("No DN Specified") if ($dn eq ""); croak("LDAPMod structure is not a hash reference.") if( ref($mod) ne "HASH" ); $sctrls = $self->create_controls_array(@$serverctrls) if $serverctrls; $cctrls = $self->create_controls_array(@$clientctrls) if $clientctrls; $status = ldap_add_ext($self->{"ld"}, $dn, $mod, $sctrls, $cctrls, $msgid); ldap_controls_array_free($sctrls) if $sctrls; ldap_controls_array_free($cctrls) if $cctrls; $self->errorize($status); if( $status != $self->LDAP_SUCCESS ) { return undef; } return $msgid; } # end of add # synonym for add sub add_ext { my ($self, @args) = @_; return $self->add(@args); } # end of add_ext sub add_s { my ($self,@args) = @_; my ($sctrls, $cctrls, $status); my ($dn, $mod, $serverctrls, $clientctrls) = $self->rearrange(['DN', 'MOD', 'SCTRLS', 'CCTRLS'], @args); croak("No DN Specified") if ($dn eq ""); croak("LDAP Modify Structure Not a HASH Reference") if (ref($mod) ne "HASH"); $sctrls = $self->create_controls_array(@$serverctrls) if $serverctrls; $cctrls = $self->create_controls_array(@$clientctrls) if $clientctrls; $status = ldap_add_ext_s($self->{"ld"}, $dn, $mod, $sctrls, $cctrls); ldap_controls_array_free($sctrls) if $sctrls; ldap_controls_array_free($cctrls) if $cctrls; $self->errorize($status); return $status; } # end of add_s # synonym for add_s sub add_ext_s { my ($self, @args) = @_; return $self->add_s(@args); } # end of add_ext_s sub bind { my ($self,@args) = @_; my ($msgid, $sctrls, $cctrls, $status); my ($dn, $pass, $authtype, $serverctrls, $clientctrls) = $self->rearrange(['DN', 'PASSWORD', 'TYPE', 'SCTRLS', 'CCTRLS'],@args); $dn = "" unless $dn; $pass = "" unless $pass; $authtype = $authtype || $self->LDAP_AUTH_SIMPLE; croak("bind supports only LDAP_AUTH_SIMPLE auth type") unless $authtype == $self->LDAP_AUTH_SIMPLE; $sctrls = $self->create_controls_array(@$serverctrls) if $serverctrls; $cctrls = $self->create_controls_array(@$clientctrls) if $clientctrls; $status = ldap_sasl_bind($self->{"ld"}, $dn, $pass, $sctrls, $cctrls, $msgid); ldap_controls_array_free($sctrls) if $sctrls; ldap_controls_array_free($cctrls) if $cctrls; $self->errorize($status); if( $status != $self->LDAP_SUCCESS ) { return undef; } return $msgid; } # end of bind sub bind_s { my ($self, @args) = @_; my ($status, $servercredp, $sctrls, $cctrls); my ($dn, $pass, $authtype, $serverctrls, $clientctrls) = $self->rearrange(['DN', 'PASSWORD', 'TYPE', 'SCTRLS', 'CCTRLS'], @args); $dn = "" unless $dn; $pass = "" unless $pass; $sctrls = 0 unless $sctrls; $cctrls = 0 unless $cctrls; $authtype = $authtype || $self->LDAP_AUTH_SIMPLE; $sctrls = $self->create_controls_array(@$serverctrls) if $serverctrls; $cctrls = $self->create_controls_array(@$clientctrls) if $clientctrls; if ($authtype == $self->LDAP_AUTH_SASL) { $status = ldap_sasl_interactive_bind_s($self->{"ld"}, $dn, $pass, $sctrls, $cctrls, $self->{"saslmech"}, $self->{"saslrealm"}, $self->{"saslauthzid"}, $self->{"saslsecprops"}, $self->{"saslflags"}); } else { # not sure here what to do with $servercredp $status = ldap_sasl_bind_s($self->{"ld"}, $dn, $pass, $sctrls, $cctrls, \$servercredp); } ldap_controls_array_free($sctrls) if $sctrls; ldap_controls_array_free($cctrls) if $cctrls; $self->errorize($status); return $status; } # end of bind_s sub sasl_parms { my ($self,@args) = @_; my ($mech, $realm, $authzid, $secprops, $flags) = $self->rearrange(['MECH', 'REALM', 'AUTHZID', 'SECPROPS', 'FLAGS'], @args); $mech = "" unless $mech; $realm = "" unless $realm; $authzid = "" unless $authzid; $secprops = "" unless $secprops; $flags = $self->LDAP_SASL_QUIET unless defined($flags); $self->{"saslmech"} = $mech; $self->{"saslrealm"} = $realm; $self->{"saslauthzid"} = $authzid; $self->{"saslsecprops"} = $secprops; $self->{"saslflags"} = $flags; } # end of sasl_parms sub compare { my ($self, @args) = @_; my ($status, $msgid, $sctrls, $cctrls); my ($dn, $attr, $value, $serverctrls, $clientctrls) = $self->rearrange(['DN','ATTR', ['VALUE', 'VALUES'], 'SCTRLS', 'CCTRLS'], @args); croak("No DN Specified") if ($dn eq ""); $value = "" unless $value; $sctrls = $self->create_controls_array(@$serverctrls) if $serverctrls; $cctrls = $self->create_controls_array(@$clientctrls) if $clientctrls; $status = ldap_compare_ext($self->{"ld"}, $dn, $attr, $value, $sctrls, $cctrls, $msgid); ldap_controls_array_free($sctrls) if $sctrls; ldap_controls_array_free($cctrls) if $cctrls; $self->errorize($status); if( $status != $self->LDAP_SUCCESS ) { return undef; } return $msgid; } # end of compare # synonym for compare sub compare_ext { my ($self, @args) = @_; return $self->compare(@args); } # end of compare_ext # needs to use ldap_compare_ext_s sub compare_s { my ($self, @args) = @_; my ($status, $sctrls, $cctrls); my ($dn, $attr, $value, $serverctrls, $clientctrls) = $self->rearrange(['DN', 'ATTR' , ['VALUE', 'VALUES'], 'SCTRLS', 'CCTRLS'], @args); croak("No DN Specified") if ($dn eq ""); $value = "" unless $value; $sctrls = $self->create_controls_array(@$serverctrls) if $serverctrls; $cctrls = $self->create_controls_array(@$clientctrls) if $clientctrls; $status = ldap_compare_ext_s($self->{"ld"}, $dn, $attr, $value, $sctrls, $cctrls); ldap_controls_array_free($sctrls) if $sctrls; ldap_controls_array_free($cctrls) if $cctrls; $self->errorize($status); return $status; } # end of compare_s # synonym for compare sub compare_ext_s { my ($self, @args) = @_; return $self->compare_s(@args); } # end of compare_ext # needs DOC in POD bellow. XXX sub start_tls { my ($self, @args) = @_; my ($msgid, $status, $sctrls, $cctrls); my ($serverctrls, $clientctrls) = $self->rearrange(['SCTRLS', 'CCTRLS'], @args); $sctrls = $self->create_controls_array(@$serverctrls) if $serverctrls; $cctrls = $self->create_controls_array(@$clientctrls) if $clientctrls; $status = ldap_start_tls($self->{"ld"}, $sctrls, $cctrls, $msgid); ldap_controls_array_free($sctrls) if $sctrls; ldap_controls_array_free($cctrls) if $cctrls; $self->errorize($status); if( $status != $self->LDAP_SUCCESS ) { return undef; } return $msgid; } # end of start_tls # needs DOC in POD bellow. XXX sub start_tls_s { my ($self, @args) = @_; my ($status, $sctrls, $cctrls); $sctrls=0; $cctrls=0; my ($serverctrls, $clientctrls) = $self->rearrange(['SCTRLS', 'CCTRLS'], @args); $sctrls = $self->create_controls_array(@$serverctrls) if $serverctrls; $cctrls = $self->create_controls_array(@$clientctrls) if $clientctrls; $status = ldap_start_tls_s($self->{"ld"}, $sctrls, $cctrls); ldap_controls_array_free($sctrls) if $sctrls; ldap_controls_array_free($cctrls) if $cctrls; $self->errorize($status); return $status; } # end of start_tls_s sub count_entries { my ($self, @args) = @_; my ($result) = $self->rearrange(['RESULT'], @args); $result = $self->{"result"} unless $result; croak("No result is given") unless $result; return ldap_count_entries($self->{"ld"}, $result); } # end of count_entries sub delete { my ($self,@args) = @_; my ($msgid, $status, $sctrls, $cctrls); my ($dn, $serverctrls, $clientctrls) = $self->rearrange(['DN', 'SCTRLS', 'CCTRLS'], @args); croak("No DN Specified") if ($dn eq ""); $sctrls = 0; $cctrls = 0; $sctrls = $self->create_controls_array(@$serverctrls) if $serverctrls; $cctrls = $self->create_controls_array(@$clientctrls) if $clientctrls; $status = ldap_delete_ext($self->{"ld"}, $dn, $sctrls, $cctrls, $msgid); ldap_controls_array_free($sctrls) if $sctrls; ldap_controls_array_free($cctrls) if $cctrls; $self->errorize($status); if( $status != $self->LDAP_SUCCESS ) { return undef; } return $msgid; } # end of delete sub delete_s { my ($self,@args) = @_; my ($status, $sctrls, $cctrls); my ($dn, $serverctrls, $clientctrls) = $self->rearrange(['DN', 'SCTRLS', 'CCTRLS'], @args); croak("No DN Specified") if ($dn eq ""); $sctrls = $self->create_controls_array(@$serverctrls) if $serverctrls; $cctrls = $self->create_controls_array(@$clientctrls) if $clientctrls; $status = ldap_delete_ext_s($self->{"ld"}, $dn, $sctrls, $cctrls); ldap_controls_array_free($sctrls) if $sctrls; ldap_controls_array_free($cctrls) if $cctrls; $self->errorize($status); return $status; } # end of delete_s sub dn2ufn { my ($self, @args) = @_; my ($dn) = $self->rearrange(['DN'], @args); return ldap_dn2ufn($dn); } # end of dn2ufn sub explode_dn { my ($self, @args) = @_; my ($dn, $notypes) = $self->rearrange(['DN', 'NOTYPES'],@args); return ldap_explode_dn($dn, $notypes); } # end of explode_dn sub explode_rdn { my ($self, @args) = @_; my (@components); my ($rdn, $notypes) = $self->rearrange(['RDN', 'NOTYPES'], @args); return ldap_explode_rdn($rdn, $notypes); } # end of explode_rdn sub first_message { my ($self, @args) = @_; my ($result) = $self->rearrange(['RESULT'], @args); $result = $self->{"result"} unless $result; croak("No Current Result") unless $result; $self->{"msg"} = ldap_first_message($self->{"ld"}, $self->{"result"}); return $self->{"msg"}; } # end of first_message sub next_message { my ($self, @args) = @_; my ($msg) = $self->rearrange(['MSG'], @args); $msg = $self->{"msg"} unless $msg; croak("No Current Message") unless $msg; $self->{"msg"} = ldap_next_message($self->{"ld"}, $msg); return $self->{"msg"}; } # end of next_message # using this function you don't have to call fist_message and next_message # here is an example: # # print "message = $message\n" while( $msg = $ld->result_message ); # sub result_message { my ($self, @args) = @_; my ($result) = $self->rearrange(['RESULT'], @args); $result = $self->{"result"} unless $result; croak("No Current Result") unless $result; if( $self->{"msg"} == 0 ) { $self->{"msg"} = ldap_first_message($self->{"ld"}, $self->{"result"}); } else { $self->{"msg"} = ldap_next_message($self->{"ld"}, $self->{"msg"}); } return $self->{"msg"}; } # end of result_message sub next_changed_entries { my ($self, @args) = @_; my ($msgid, $allnone, $timeout) = $self->rearrange(['MSGID', 'ALL', 'TIMEOUT'], @args); my ($rc, $msg, $msgtype, $asn, $syncInfoValue, $syncInfoValues, $refreshPresent, $ctrl, $oid, %parsed, $retdatap, $retoidp, @entries, $syncStateValue, $syncStateValues, $state, $berval, $cookie); $rc = $self->result($msgid, $allnone, $timeout); @entries = (); if ($self->{'status'} == 0) { # ldap_result return 0 = timeout return @entries; } $asn = $self->{"asn"}; while( $msg = $self->result_message ) { $msgtype = $self->msgtype($msg); if( $msgtype eq $self->LDAP_RES_SEARCH_ENTRY ) { my %entr = ('entry' => $msg); push(@entries, \%entr); $self->{"entry"} = $msg; # extract controls if any my @sctrls = $self->get_entry_controls($msg); foreach $ctrl (@sctrls) { $oid = $self->get_control_oid($ctrl); if( $oid eq $self->LDAP_CONTROL_SYNC_STATE ) { $berval = $self->get_control_berval($ctrl); $syncStateValue = $asn->find('syncStateValue'); $syncStateValues = $syncStateValue->decode($berval); $state = $syncStateValues->{'state'}; if( $state == 0 ) { $entr{'state'} = "present"; } elsif( $state == 1 ) { $entr{'state'} = "add"; } elsif( $state == 2 ) { $entr{'state'} = "modify"; } elsif( $state == 3 ) { $entr{'state'} = "delete"; } else { $entr{'state'} = "unknown"; } } $cookie = $syncStateValues->{'cookie'}; if( $cookie ) { # save the cookie save_cookie($cookie, $self->{"cookie"}); } ldap_control_free($ctrl); } } elsif( $msgtype eq $self->LDAP_RES_INTERMEDIATE ) { %parsed = $self->parse_intermediate($msg); $retdatap = $parsed{'retdatap'}; $retoidp = $parsed{'retoidp'}; if( $retoidp eq $self->LDAP_SYNC_INFO ) { my $cookie; $asn->configure(encoding => "DER"); $syncInfoValue = $asn->find('syncInfoValue'); $syncInfoValues = $syncInfoValue->decode($retdatap); # trying to get the cookie from one of the foolowing choices. $cookie = $syncInfoValues->{'newcookie'}; my $refreshPresent = $syncInfoValues->{'refreshPresent'}; $cookie = $refreshPresent->{'cookie'} if( $refreshPresent ); my $refreshDelete = $syncInfoValues->{'refreshDelete'}; $cookie = $refreshDelete->{'cookie'} if( $refreshDelete ); my $syncIdSet = $syncInfoValues->{'syncIdSet'}; $cookie = $syncIdSet->{'cookie'} if( $syncIdSet ); $asn->configure(encoding => "BER"); # see if we got any and save it. if( $cookie ) { save_cookie($cookie, $self->{"cookie"}); } } } } return @entries; } # next_changed_entries sub save_cookie { my ($self,@args) = @_; my $cookiestr = $_[0]; my $cookie = $_[1]; # Skip all if there's no csn value if ($cookiestr =~ m/csn=/) { # Get new CSN array and a copy chomp(my @newcsns = split(';',$cookiestr =~ s/(rid=\d{3},)|(sid=\d{3},)|(csn=)//rg)); # These will be the CSNs to write to the cookie file # All CSNs from the new cookie must be used # my @outcsns = @newcsns; my @outcsns = @newcsns; # Get the old cookie for comparison/persisting if (-w $cookie) { open(COOKIE_FILE, "<", $cookie) || die("Cannot open file '".$cookie."' for reading."); chomp(my @oldcsns = ); close(COOKIE_FILE); # Look for old CSNs with SIDs that don't match any of the new # CSNs. If there are no matches, push the old CSN to the list # of CSNs to be written to the cookie file. foreach my $oldcsn (@oldcsns) { my $match = 0; my $p_sid = ($oldcsn =~ /(#\d{3}#)/i)[0]; foreach my $newcsn (@newcsns) { if ($newcsn =~ m/\Q$p_sid/) { $match = 1; last; } } if (!$match) { push @outcsns,$oldcsn; } } } # Write the cookie open(COOKIE_FILE, ">", $cookie) || die("Cannot open file '".$cookie."' for writing."); print COOKIE_FILE "$_\n" for @outcsns; close(COOKIE_FILE); } } # end save_cookie sub first_entry { my ($self) = @_; croak("No Current Result") if ($self->{"result"} == 0); $self->{"entry"} = ldap_first_entry($self->{"ld"}, $self->{"result"}); return $self->{"entry"}; } # end of first_entry sub next_entry { my ($self) = @_; croak("No Current Entry") if ($self->{"entry"} == 0); $self->{"entry"} = ldap_next_entry($self->{"ld"}, $self->{"entry"}); return $self->{"entry"}; } # end of next_entry # using this function you don't have to call fist_entry and next_entry # here is an example: # # print "entry = $entry\n" while( $entry = $ld->result_entry ); # sub result_entry { my ($self) = @_; croak("No Current Result") if ($self->{"result"} == 0); if( $self->{"entry"} == 0 ) { $self->{"entry"} = ldap_first_entry($self->{"ld"}, $self->{"result"}); } else { $self->{"entry"} = ldap_next_entry($self->{"ld"}, $self->{"entry"}); } return $self->{"entry"}; } # end of result_entry sub get_entry_controls { my ($self, @args) = @_; my ($msg) = $self->rearrange(['MSG'], @args); $msg = $self->{"msg"} unless $msg; croak("No Current Message/Entry") unless $msg; my @serverctrls = (); my $serverctrls_ref = \@serverctrls; ldap_get_entry_controls($self->{"ld"}, $msg, $serverctrls_ref); return @serverctrls; } # end of get_entry_controls sub get_control_oid { my ($self, @args) = @_; my ($ctrl) = $self->rearrange(['CTRL'], @args); return ldap_control_oid($ctrl); } # end of get_control_oid sub get_control_berval { my ($self, @args) = @_; my ($ctrl) = $self->rearrange(['CTRL'], @args); return ldap_control_berval($ctrl); } # end of get_control_berval sub get_control_critical { my ($self, @args) = @_; my ($ctrl) = $self->rearrange(['CTRL'], @args); return ldap_control_critical($ctrl); } # end of get_control_critical sub first_attribute { my ($self) = @_; my ($attr, $ber); croak("No Current Entry") if ($self->{"entry"} == 0); $attr = ldap_first_attribute($self->{"ld"}, $self->{"entry"}, $ber); $self->{"ber"} = $ber; return $attr; } # end of first_attribute sub next_attribute { my ($self) = @_; my ($attr); croak("No Current Entry") if ($self->{"entry"} == 0); croak("Empty Ber Value") if ($self->{"ber"} == 0); $attr = ldap_next_attribute($self->{"ld"}, $self->{"entry"}, $self->{"ber"}); ber_free($self->{"ber"}, 0) if (!$attr); return $attr; } # end of next_attribute # using this function you don't have to call fist_attribute and next_attribute # as in the following example: # # print "<$attr>\n" while( $attr = $ld->entry_attribute ); # sub entry_attribute { my ($self, @args) = @_; my ($msg) = $self->rearrange(['MSG'], @args); my ($attr, $ber); $msg = $self->{"entry"} unless $msg; croak("No Current Entry") unless $msg; if ($self->{"ber"} == 0) { $attr = ldap_first_attribute($self->{"ld"}, $msg, $ber); $self->{"ber"} = $ber; } else { croak("Empty Ber Value") if ($self->{"ber"} == 0); $attr = ldap_next_attribute($self->{"ld"}, $msg, $self->{"ber"}); if (!$attr) { ber_free($self->{"ber"}, 0); $self->{"ber"} = undef; } } return $attr; } # end of entry_attribute sub parse_result { my ($self, @args) = @_; my ($msg, $freeMsg) = $self->rearrange(['MSG', 'FREEMSG'], @args); my ($status, %result); $freeMsg = 0 unless $freeMsg; $msg = $self->{"entry"} unless $msg; my ($errcode, $matcheddn, $errmsg, @referrals, @serverctrls); @serverctrls = (); my $serverctrls_ref = \@serverctrls; @referrals = (); my $referrals_ref = \@referrals; $status = ldap_parse_result($self->{"ld"}, $msg, $errcode, $matcheddn, $errmsg, $referrals_ref, $serverctrls_ref, $freeMsg); $self->errorize($status); if( $status != $self->LDAP_SUCCESS ) { return undef; } $result{"errcode"} = $errcode; $result{"matcheddn"} = $matcheddn; $result{"errmsg"} = $errmsg; $result{"referrals"} = $referrals_ref; $result{"serverctrls"} = $serverctrls_ref; return %result; } # end of parse_result(...) sub parse_extended_result { my ($self, @args) = @_; my ($msg, $freeMsg) = $self->rearrange(['MSG', 'FREEMSG'], @args); my ($status, %result); $freeMsg = 0 unless $freeMsg; $msg = $self->{"msg"} unless $msg; my ($retoidp, $retdatap); $status = ldap_parse_extended_result($self->{"ld"}, $msg, $retoidp, $retdatap, $freeMsg); $self->errorize($status); if( $status != $self->LDAP_SUCCESS ) { return undef; } $result{"retoidp"} = $retoidp; $result{"retdatap"} = $retdatap; return %result; } # end of parse_extended_result(...) # needs docs bellow in POD. XXX sub parse_intermediate { my ($self, @args) = @_; my ($msg, $freeMsg) = $self->rearrange(['MSG', 'FREEMSG'], @args); my ($status, %result); $freeMsg = 0 unless $freeMsg; $msg = $self->{"msg"} unless $msg; my ($retoidp, $retdatap, @serverctrls); @serverctrls = (); my $serverctrls_ref = \@serverctrls; $status = ldap_parse_intermediate($self->{"ld"}, $msg, $retoidp, $retdatap, $serverctrls_ref, $freeMsg); $self->errorize($status); if( $status != $self->LDAP_SUCCESS ) { return undef; } $result{"retoidp"} = $retoidp; $result{"retdatap"} = $retdatap; $result{"serverctrls"} = $serverctrls_ref; return %result; } # end of parse_result(...) sub parse_whoami { my ($self, @args) = @_; my ($msg) = $self->rearrange(['MSG'], @args); my ($status, %result); $msg = $self->{"msg"} unless $msg; my ($authzid); $status = ldap_parse_whoami($self->{"ld"}, $msg, $authzid); $self->errorize($status); if( $status != $self->LDAP_SUCCESS ) { return undef; } return $authzid; } # end of parse_whoami(...) sub perror { my ($self, @args) = @_; my ($msg) = $self->rearrange(['MSG'], @args); ldap_perror($self->{"ld"}, $msg); } # get dn for current entry sub get_dn { my ($self, @args) = @_; my ($entry) = $self->rearrange(['MSG'], @args); $entry = $self->{"entry"} unless $entry; croak("No Current Entry") unless $entry; my $dn = ldap_get_dn($self->{"ld"}, $entry); return $dn; } # end of get_dn # get array of values for current entry and a given attribute sub get_values { my ($self, @args) = @_; my ($attr) = $self->rearrange(['ATTR'], @args); croak("No Current Entry") if ($self->{"entry"} == 0); croak("No Attribute Specified") if ($attr eq ""); my @vals = ldap_get_values_len($self->{"ld"}, $self->{"entry"}, $attr); return @vals; } # end of get_values # synonym for get_values(...) sub get_values_len { my ($self, @args) = @_; return $self->get_values(@args); } # end of get_values_len sub msgfree { my ($self, @args) = @_; my ($result) = $self->rearrange(['RESULT'], @args); $result = $self->{"result"} unless $result; return ldap_msgfree($self->{"result"}); } # end of msgfree sub modify { my ($self, @args) = @_; my ($msgid, $sctrls, $cctrls, $status); my ($dn, $mod, $serverctrls, $clientctrls) = $self->rearrange(['DN', 'MOD', 'SCTRLS', 'CCTRLS'], @args); croak("No DN Specified") if ($dn eq ""); croak("LDAP Modify Structure Not a Reference") if (ref($mod) ne "HASH"); $sctrls = $self->create_controls_array(@$serverctrls) if $serverctrls; $cctrls = $self->create_controls_array(@$clientctrls) if $clientctrls; $status = ldap_modify_ext($self->{"ld"}, $dn, $mod, $sctrls, $cctrls, $msgid); $self->errorize($status); if( $status != $self->LDAP_SUCCESS ) { return undef; } ldap_controls_array_free($sctrls) if $sctrls; ldap_controls_array_free($cctrls) if $cctrls; return $msgid; } # end of modify # synonym for modify sub modify_ext { my ($self, @args) = @_; return $self->modify(@args); } # end of modify_ext sub modify_s { my ($self,@args) = @_; my ($status, $sctrls, $cctrls); my ($dn, $mod, $serverctrls, $clientctrls) = $self->rearrange(['DN', 'MOD', 'SCTRLS', 'CCTRLS'], @args); croak("No DN Specified") if ($dn eq ""); croak("LDAP Modify Structure Not a Reference") if (ref($mod) ne "HASH"); $sctrls = $self->create_controls_array(@$serverctrls) if $serverctrls; $cctrls = $self->create_controls_array(@$clientctrls) if $clientctrls; $status = ldap_modify_ext_s($self->{"ld"}, $dn, $mod, $sctrls, $cctrls); ldap_controls_array_free($sctrls) if $sctrls; ldap_controls_array_free($cctrls) if $cctrls; $self->errorize($status); return $status; } # end of modify_s # synonym for modify sub modify_ext_s { my ($self, @args) = @_; return $self->modify_s(@args); } # end of modify_ext # needs updated docs in POD bellow sub rename { my ($self, @args) = @_; my ($sctrls, $cctrls, $msgid, $status); my ($dn, $newrdn, $newsuper, $delete, $serverctrls, $clientctrls) = $self->rearrange(['DN', 'NEWRDN', 'NEWSUPER', 'DELETE', 'SCTRLS', 'CCTRLS'], @args); $sctrls = $self->create_controls_array(@$serverctrls) if $serverctrls; $cctrls = $self->create_controls_array(@$clientctrls) if $clientctrls; $status = ldap_rename($self->{"ld"}, $dn, $newrdn, $newsuper, $delete, $sctrls, $cctrls, $msgid); ldap_controls_array_free($sctrls) if $sctrls; ldap_controls_array_free($cctrls) if $cctrls; $self->errorize($status); if( $status != $self->LDAP_SUCCESS ) { return undef; } return $msgid; } # end of rename # needs updated docs in POD bellow sub rename_s { my ($self, @args) = @_; my ($sctrls, $cctrls, $status); my ($dn, $newrdn, $newsuper, $delete, $serverctrls, $clientctrls) = $self->rearrange(['DN', 'NEWRDN', 'NEWSUPER', 'DELETE', 'SCTRLS', 'CCTRLS'], @args); $sctrls = $self->create_controls_array(@$serverctrls) if $serverctrls; $cctrls = $self->create_controls_array(@$clientctrls) if $clientctrls; $status = ldap_rename_s($self->{"ld"}, $dn, $newrdn, $newsuper, $delete, $sctrls, $cctrls); ldap_controls_array_free($sctrls) if $sctrls; ldap_controls_array_free($cctrls) if $cctrls; $self->errorize($status); return $status; } # end of rename_s # this function is used to retrieve results of asynchronous search operation # it returns LDAPMesage which is to be processed by functions first_entry, # result_entry, first_message, result_message. To find message type one # should use function msgtype(...) sub result { my ($self, @args) = @_; my ($result, $status, $err) = (undef, undef, undef); my ($msgid, $allnone, $timeout) = $self->rearrange(['MSGID', 'ALL', 'TIMEOUT'], @args); croak("Invalid MSGID") if ($msgid < 0); $status = ldap_result($self->{"ld"}, $msgid, $allnone, $timeout, $result); $self->{"result"} = $result; $self->{"status"} = $status; $self->errorize($status); if( $status == -1 || $status == 0 ) { return undef; } return $result; } # end of result sub is_ldap_url { my ($self,@args) = @_; my ($url) = $self->rearrange(['URL'],@args); return ldap_is_ldap_url($url); } # end of is_ldap_url sub url_parse { my ($self,@args) = @_; my ($url) = $self->rearrange(['URL'],@args); return ldap_url_parse($url); } # end of url_parse # needs testing XXX. present only in Mozilla SDK sub url_search { my ($self,@args) = @_; my ($msgid,$errdn,$extramsg); my ($url,$attrsonly) = $self->rearrange(['URL','ATTRSONLY'],@args); if (($msgid = ldap_url_search($self->{"ld"},$url,$attrsonly)) < 0) { $self->{"errno"} = ldap_get_lderrno($self->{"ld"},$errdn,$extramsg); $self->{"extramsg"} = undef; } else { $self->{"errno"} = 0; $self->{"extramsg"} = ""; } return $msgid; } # end of url_search # needs testing XXX. present only in Mozilla SDK sub url_search_s { my ($self, @args) = @_; my ($result, $status, $errdn, $extramsg); my ($url,$attrsonly) = $self->rearrange(['URL', 'ATTRSONLY'], @args); if( ($status = ldap_url_search_s($self->{"ld"}, $url, $attrsonly, $result)) != $self->LDAP_SUCCESS ) { $self->{"errno"} = ldap_get_lderrno($self->{"ld"},$errdn,$extramsg); $self->{"extramsg"} = $extramsg; } else { $self->{"errno"} = 0; $self->{"extramsg"} = undef; } $self->{"result"} = $result; return $status; } # end of url_search_s # needs testing XXX. present only in Mozilla SDK sub url_search_st { my ($self,@args) = @_; my ($result,$status,$errdn,$extramsg); my ($url,$attrsonly,$timeout) = $self->rearrange(['URL','ATTRSONLY', 'TIMEOUT'],@args); if (($status = ldap_url_search_st($self->{"ld"},$url,$attrsonly,$timeout, $result)) != $self->LDAP_SUCCESS) { $self->{"errno"} = ldap_get_lderrno($self->{"ld"},$errdn,$extramsg); $self->{"extramsg"} = $extramsg; } else { $self->{"errno"} = 0; $self->{"extramsg"} = undef; } $self->{"result"} = $result; return $status; } # end of url_search_st # needs testing XXX. present only in Mozilla SDK sub multisort_entries { my ($self,@args) = @_; my ($status,$errdn,$extramsg); my ($attr) = $self->rearrange(['ATTR'],@args); if (!$self->{"result"}) { croak("No Current Result"); } $status = ldap_multisort_entries($self->{"ld"},$self->{"result"},$attr); $self->errorize($status); return $status; } # end of multisort_entries sub listen_for_changes { my ($self, @args) = @_; my ($msgid, $status, $sctrls, $the_cookie, $syncRequestBerval); my ($basedn, $scope, $filter, $attrs, $attrsonly, $timeout, $sizelimit, $cookie, $rid) = $self->rearrange(['BASEDN', 'SCOPE', 'FILTER', 'ATTRS', 'ATTRSONLY', 'TIMEOUT', 'SIZELIMIT', 'COOKIE', 'RID'], @args); croak("No Filter Specified") if (!defined($filter)); croak("No cookie file specified") unless $cookie; $self->{"cookie"} = $cookie; $self->{"rid"} = defined($rid) ? $rid : '000'; if( !defined($attrs) ) { my @null_array = (); $attrs = \@null_array; } # load cookie from the file if( open(COOKIE, $cookie) ) { chomp(my @csns = ); if (scalar(@csns)) { $the_cookie = sprintf("rid=%d,csn=%s",$rid,join(';',@csns)); } } else { warn "Failed to open file '".$cookie."' for reading.\n"; } my $asn = $self->{"asn"}; my $syncRequestValue = $asn->find('syncRequestValue'); # refreshAndPersist mode if( $the_cookie ) { # we have the cookie $syncRequestBerval = $syncRequestValue->encode(mode => 3, cookie => $the_cookie, reloadHint => 1); } else { $syncRequestBerval = $syncRequestValue->encode(mode => 3, reloadHint => 1); } my $ctrl_persistent = $self->create_control(-oid => $self->LDAP_CONTROL_SYNC, -berval => $syncRequestBerval, -critical => $self->CRITICAL); my @controls = ($ctrl_persistent); $sctrls = $self->create_controls_array(@controls); $status = ldap_search_ext($self->{"ld"}, $basedn, $scope, $filter, $attrs, $attrsonly, $sctrls, undef, $timeout, $sizelimit, $msgid); ldap_controls_array_free($sctrls); ldap_control_free($ctrl_persistent); $self->errorize($status); if( $status != $self->LDAP_SUCCESS ) { return undef; } return $msgid; } # listen_for_changes sub search { my ($self, @args) = @_; my ($msgid, $status, $sctrls, $cctrls); my ($basedn, $scope, $filter, $attrs, $attrsonly, $serverctrls, $clientctrls, $timeout, $sizelimit) = $self->rearrange(['BASEDN', 'SCOPE', 'FILTER', 'ATTRS', 'ATTRSONLY', 'SCTRLS', 'CCTRLS', 'TIMEOUT', 'SIZELIMIT'], @args); croak("No Filter Specified") if (!defined($filter)); if( !defined($attrs) ) { my @null_array = (); $attrs = \@null_array; } $sctrls = $self->create_controls_array(@$serverctrls) if $serverctrls; $cctrls = $self->create_controls_array(@$clientctrls) if $clientctrls; $status = ldap_search_ext($self->{"ld"}, $basedn, $scope, $filter, $attrs, $attrsonly, $sctrls, $cctrls, $timeout, $sizelimit, $msgid); ldap_controls_array_free($sctrls) if $sctrls; ldap_controls_array_free($cctrls) if $cctrls; $self->errorize($status); if( $status != $self->LDAP_SUCCESS ) { return undef; } return $msgid; } # end of search # synonym for search sub search_ext { my ($self, @args) = @_; return $self->search(@args); } # end of search_ext sub search_s { my ($self, @args) = @_; my ($result, $status, $sctrls, $cctrls); my ($basedn, $scope, $filter, $attrs, $attrsonly, $serverctrls, $clientctrls, $timeout, $sizelimit) = $self->rearrange(['BASEDN', 'SCOPE', 'FILTER', 'ATTRS', 'ATTRSONLY', 'SCTRLS', 'CCTRLS', 'TIMEOUT', 'SIZELIMIT' ], @args); croak("No Filter Passed as Argument 3") if ($filter eq ""); if( !defined($attrs) ) { my @null_array = (); $attrs = \@null_array; } $sctrls = $self->create_controls_array(@$serverctrls) if $serverctrls; $cctrls = $self->create_controls_array(@$clientctrls) if $clientctrls; $status = ldap_search_ext_s($self->{"ld"}, $basedn, $scope, $filter, $attrs, $attrsonly, $sctrls, $cctrls, $timeout, $sizelimit, $result); ldap_controls_array_free($sctrls) if $sctrls; ldap_controls_array_free($cctrls) if $cctrls; $self->errorize($status); $self->{"result"} = $result; return $status; } # end of search_s # synonym for search_s(...) sub search_ext_s { my ($self, @args) = @_; return $self->search_s(@args); } # end of search_ext_s sub extended_operation { my ($self, @args) = @_; my ($msgid, $status, $sctrls, $cctrls); my ($oid, $berval, $serverctrls, $clientctrls) = $self->rearrange(['OID', 'BERVAL', 'SCTRLS', 'CCTRLS'], @args); $sctrls = $self->create_controls_array(@$serverctrls) if $serverctrls; $cctrls = $self->create_controls_array(@$clientctrls) if $clientctrls; $status = ldap_extended_operation($self->{"ld"}, $oid, $berval, length($berval), $sctrls, $cctrls, $msgid); ldap_controls_array_free($sctrls) if $sctrls; ldap_controls_array_free($cctrls) if $cctrls; $self->errorize($status); if( $status != $self->LDAP_SUCCESS ) { return undef; } return $msgid; } # end of extended_operation sub extended_operation_s { my ($self, @args) = @_; my ($status, $retoidp, $retdatap, $sctrls, $cctrls); my ($oid, $berval, $serverctrls, $clientctrls, $result) = $self->rearrange(['OID', 'BERVAL', 'SCTRLS', 'CCTRLS', 'RESULT'], @args); $sctrls = $self->create_controls_array(@$serverctrls) if $serverctrls; $cctrls = $self->create_controls_array(@$clientctrls) if $clientctrls; $status = ldap_extended_operation_s($self->{"ld"}, $oid, $berval, length($berval), $sctrls, $cctrls, $retoidp, $retdatap); ldap_controls_array_free($sctrls) if $sctrls; ldap_controls_array_free($cctrls) if $cctrls; $self->errorize($status); $result->{'retoidp'} = $retoidp; $result->{'retdatap'} = $retdatap; return $status; } # end of extended_operation_s sub whoami { my ($self, @args) = @_; my ($msgid, $status, $sctrls, $cctrls); my ($serverctrls, $clientctrls) = $self->rearrange(['SCTRLS', 'CCTRLS'], @args); $sctrls = $self->create_controls_array(@$serverctrls) if $serverctrls; $cctrls = $self->create_controls_array(@$clientctrls) if $clientctrls; $status = ldap_whoami($self->{"ld"}, $sctrls, $cctrls, $msgid); ldap_controls_array_free($sctrls) if $sctrls; ldap_controls_array_free($cctrls) if $cctrls; $self->errorize($status); if( $status != $self->LDAP_SUCCESS ) { return undef; } return $msgid; } # end of whoami sub whoami_s { my ($self, @args) = @_; my ($status, $authzidOut, $sctrls, $cctrls); my ($authzid, $serverctrls, $clientctrls) = $self->rearrange(['AUTHZID', 'SCTRLS', 'CCTRLS'], @args); $sctrls = $self->create_controls_array(@$serverctrls) if $serverctrls; $cctrls = $self->create_controls_array(@$clientctrls) if $clientctrls; $status = ldap_whoami_s($self->{"ld"}, $authzidOut, $sctrls, $cctrls); ldap_controls_array_free($sctrls) if $sctrls; ldap_controls_array_free($cctrls) if $cctrls; $self->errorize($status); $$authzid = $authzidOut; return $status; } # end of whoami_s sub count_references { my ($self, @args) = @_; my ($msg) = $self->rearrange(['MSG'], @args); $msg = $self->{"entry"} unless $msg; return ldap_count_references($self->{"ld"}, $msg); } # end of count_references sub get_option { my ($self, @args) = @_; my ($status); my ($option, $optdata) = $self->rearrange(['OPTION', 'OPTDATA'], @args); $status = ldap_get_option($self->{"ld"}, $option, $optdata); return $status; } # end of get_option sub set_option { my ($self,@args) = @_; my ($status); my ($option,$optdata) = $self->rearrange(['OPTION','OPTDATA'],@args); $status = ldap_set_option($self->{"ld"},$option,$optdata); return $status; } # end of set_option # needs testing more XXX sub set_rebind_proc { my ($self, @args) = @_; my ($status); my ($rebindproc, $params) = $self->rearrange(['REBINDPROC', 'PARAMS'], @args); if( ref($rebindproc) eq "CODE" ) { $status = ldap_set_rebind_proc($self->{"ld"}, $rebindproc, $params); } else { croak("REBINDPROC is not a CODE Reference"); } return $status; } # end of set_rebind_proc # needs docs in a POD bellow. XXX sub get_all_entries { my ($self, @args) = shift; my ($result) = $self->rearrange(['RESULT'], @args); $result = $self->{"result"} unless $result; croak("NULL Result") unless $result; return ldap_get_all_entries($self->{"ld"}, $result); } # end of get_all_entries sub unbind { my ($self, @args) = @_; my ($status, $sctrls, $cctrls); my ($serverctrls, $clientctrls) = $self->rearrange(['SCTRLS', 'CCTRLS'], @args); $sctrls = 0; $cctrls = 0; $sctrls = $self->create_controls_array(@$serverctrls) if $serverctrls; $cctrls = $self->create_controls_array(@$clientctrls) if $clientctrls; $status = ldap_unbind_ext_s($self->{"ld"}, $sctrls, $cctrls); ldap_controls_array_free($sctrls) if $sctrls; ldap_controls_array_free($cctrls) if $cctrls; $self->errorize($status); return $status; } # end of unbind # do we need these ssl function sub ssl_client_init { my ($self,@args) = @_; my ($status); my ($certdbpath,$certdbhandle) = $self->rearrange(['DBPATH','DBHANDLE'], @args); $status = ldapssl_client_init($certdbpath,$certdbhandle); return($status); } # end of ssl_client_init # do we need these ssl function sub ssl { my ($self) = @_; my ($status); $status = ldapssl_install_routines($self->{"ld"}); return $status; } # end of ssl sub entry { my ($self) = @_; return $self->{"entry"}; } # end of entry sub err { my ($self) = @_; return $self->{"errno"}; } # end of err sub errno { my ($self) = @_; return $self->{"errno"}; } # end of errno sub errstring { my ($self) = @_; return ldap_err2string($self->{"errno"}); } # end of errstring sub extramsg { my ($self) = @_; return $self->{"extramsg"}; } # end of extramsg sub ld { my ($self) = @_; return $self->{"ld"}; } # end of ld sub msgtype { my ($self, @args) = @_; my ($msg) = $self->rearrange(['MSG'], @args); $msg = $self->{"msg"} unless $msg; return ldap_msgtype($msg); } # end of msgtype sub msgtype2str { my ($self, @args) = @_; my ($type) = $self->rearrange(['TYPE'], @args); if( $type == $self->LDAP_RES_BIND ) { return "LDAP_RES_BIND"; } elsif( $type == $self->LDAP_RES_SEARCH_ENTRY ) { return "LDAP_RES_SEARCH_ENTRY"; } elsif( $type == $self->LDAP_RES_SEARCH_REFERENCE ) { return "LDAP_RES_SEARCH_REFERENCE"; } elsif( $type == $self->LDAP_RES_SEARCH_RESULT ) { return "LDAP_RES_SEARCH_RESULT"; } elsif( $type == $self->LDAP_RES_MODIFY ) { return "LDAP_RES_MODIFY"; } elsif( $type == $self->LDAP_RES_ADD ) { return "LDAP_RES_ADD"; } elsif( $type == $self->LDAP_RES_DELETE ) { return "LDAP_RES_DELETE"; } elsif( $type == $self->LDAP_RES_MODDN ) { return "LDAP_RES_MODDN"; } elsif( $type == $self->LDAP_RES_COMPARE ) { return "LDAP_RES_COMPARE"; } elsif( $type == $self->LDAP_RES_EXTENDED ) { return "LDAP_RES_EXTENDED"; } elsif( $type == $self->LDAP_RES_INTERMEDIATE ) { return "LDAP_RES_INTERMEDIATE"; } elsif( $type == $self->LDAP_RES_ANY ) { return "LDAP_RES_ANY"; } elsif( $type == $self->LDAP_RES_UNSOLICITED ) { return "LDAP_RES_UNSOLICITED"; } else { return "UNKNOWN"; } } # end of msgtype2str sub msgid { my ($self, @args) = @_; my ($result) = $self->rearrange(['RESULT'], @args); $result = $self->{"result"} unless $result; return ldap_msgid($self->{"ld"}, $result); } # end of msgid # Given array of elements of type Net::LDAP::Control # array of controls sutable for passing to C-calls is created. # It is to be freed by calling ldap_controls_array_free(...) # Note that this method is *NOT* to be used by the end user of # this library. sub create_controls_array { my ($self, @args) = @_; my ($location, $status, $ctrlp); my $ctrls = ldap_controls_array_init($#args + 2); for( $location = 0; $location < $#args + 1; $location++ ) { ldap_control_set($ctrls, $args[$location], $location); } ldap_control_set($ctrls, undef, $#args + 1); return $ctrls; } # create_controls_array # Creates control given its OID and berval. Default value of criticality is true. sub create_control { my ($self, @args) = @_; my ($oid, $berval, $critical) = $self->rearrange(['OID', 'BERVAL', 'CRITICAL'], @args); croak("No OID of controls is passed") unless $oid; croak("No BerVal is passed") unless $berval; $critical = 1 if !defined($critical); my ($ctrl) = undef; my $status = ldap_create_control($oid, $berval, length($berval), $critical, $ctrl); $self->errorize($status); return $ctrl; } # end of create_control sub free_control { my ($self, @args) = @_; my ($control) = $self->rearrange(['CONTROL'], @args); ldap_control_free($control); } # end of free_control # This subroutine was borrowed from CGI.pm. It does a wonderful job and # is much better than anything I created in my first attempt at named # arguments. I may replace it later. sub make_attributes { my $attr = shift; return () unless $attr && ref($attr) && ref($attr) eq 'HASH'; my $escape = shift || 0; my(@att); foreach (keys %{$attr}) { my($key) = $_; $key=~s/^\-//; # get rid of initial - if present # old way: breaks EBCDIC! # $key=~tr/A-Z_/a-z-/; # parameters are lower case, use dashes ($key="\L$key") =~ tr/_/-/; # parameters are lower case, use dashes my $value = $escape ? simple_escape($attr->{$_}) : $attr->{$_}; push(@att, defined($attr->{$_}) ? qq/$key="$value"/ : qq/$key/); } return @att; } # end of make_attributes sub rearrange { my($self, $order, @param) = @_; return () unless @param; return @param unless (defined($param[0]) && substr($param[0],0,1) eq '-'); my $i; for ($i=0;$i<@param;$i+=2) { $param[$i]=~s/^\-//; # get rid of initial - if present $param[$i]=~tr/a-z/A-Z/; # parameters are upper case } my(%param) = @param; # convert into associative array my(@return_array); my($key)=''; foreach $key (@$order) { my($value); # this is an awful hack to fix spurious warnings when the # -w switch is set. if (ref($key) && ref($key) eq 'ARRAY') { foreach (@$key) { last if defined($value); $value = $param{$_}; delete $param{$_}; } } else { $value = $param{$key}; delete $param{$key}; } push(@return_array,$value); } push (@return_array, $self->make_attributes(\%param)) if %param; return (@return_array); } # end of rearrange # places internal ldap errors into $self under keys "errno" and "extramsg" sub errorize { my ($self, $status) = @_; my ($errdn, $extramsg); if ($status != $self->LDAP_SUCCESS) { $self->{"errno"} = ldap_get_lderrno($self->{"ld"}, $errdn, $extramsg); $self->{"extramsg"} = $extramsg; if( $self->{"debug"} ) { print "LDAP ERROR STATUS: $status ".ldap_err2string($status)."\n"; printf("LDAP ERROR CODE: %x\n", $self->{"errno"}); print "LDAP ERROR MESSAGE: $extramsg\n"; } } else { $self->{"errno"}=0; $self->{"errstring"}=undef; } } # end of errorize sub CRITICAL { 1; } sub NONCRITICAL { 0; } # Preloaded methods go here. # Autoload methods go after =cut, and are processed by the autosplit program. 1; __END__ =head1 NAME Net::LDAPapi - Perl5 Module Supporting LDAP API =head1 SYNOPSIS use Net::LDAPapi; See individual items and Example Programs for Usage =head1 DESCRIPTION This module allows Perl programmers to access and manipulate an LDAP based Directory. Versions beginning with 1.40 support both the original "C API" and new "Perl OO" style interface methods. With version 1.42, I've added named arguments. =head1 THE INTIAL CONNECTION All connections to the LDAP server are started by creating a new "blessed object" in the Net::LDAPapi class. This can be done quite easily by the following type of statement. $ld = new Net::LDAPapi($hostname); Where $hostname is the name of your LDAP server. If you are not using the standard LDAP port (389), you will also need to supply the portnumber. $ld = new Net::LDAPapi($hostname, 15555); The new method can also be called with named arguments. $ld = new Net::LDAPapi(-host=>$hostname, -port=>15389); Instead of the above mentioned argumens -url can be used in the following form $ld = new Net::LDAPapi(-url=>"ldap://host:port"); Setting -debug=>"TRUE" will enable more verbose error messages. Note that with named arguments, the order of the arguments is insignificant. =head1 CONTROLS In LDAP v3 controls are an additional piece of data, which can be submitted with most of the requests to the server and returned back attached to the result. Controls, passed to the call, are separated in two types. The client side controls, which are not passed to the server and are of not much use. They are denoted by -cctrls named parameter. The server side controls, denoted by -sctrls named parameter are actually passed to the server and may affect its operation or returned results. Each entry of the result may have controls attached to it as well ( see parse_entry(...) call ). -cctrls and -sctrls must be reference to array of controls. To create control call create_control(...) method. Bellow is an example of creating valsort control. my $asn = Convert::ASN1->new; $asn->prepare('SEQUENCE { b BOOLEAN }'); my $berval = $asn->encode(b=>1); # or 1 my $ctrl = $ld->create_control(-oid=>Net::LDAPapi::LDAP_CONTROL_VALSORT, -berval=>$berval, -critical=>Net::LDAPapi::CRITICAL); The control is to be freed by calling free_control($ctrl). If contol is attached to results entry, it can be retrieved by calling parse_result($entry). If no entry is passed to parse_result(...) then current entry is used. It returns hash with following keys Key Value ------------------- matcheddn string errmsg string referrals array reference serverctrls array reference You can look into content of the control by using get_contol_XXX functions like this: local %parsed = $ld->parse_result($entry); local $serverctrls = $parsed{"serverctrls"}; local @sctrls = @$serverctrls; if( scalar(@sctrls) > 0 ) { foreach $ctrl (@sctrls) { print "\nreceived control\n"; print "oid = ".$ld->get_control_oid($ctrl)."\n"; print "berval = ".$ld->get_control_berval($ctrl)."\n"; print "critical = ".$ld->get_control_critical($ctrl)."\n"; } } =head1 BINDING After creating a connection to the LDAP server, you may need to bind to the server prior to performing any LDAP related functions. This can be done with the 'bind' methods. An anonymous bind can be performed without arguments: $status = $ld->bind_s; A simple bind can be performed by specifying the DN and PASSWORD of the user you are authenticating as: $status = $ld->bind_s($dn, $password); Note that if $password above was "", you would be doing a reference bind, which would return success even if the password in the directory was non-null. Thus if you were using the bind to check a password entered with one in the directory, you should first check to see if $password was NULL. To perform SASL bind fill in appropriate parameters calling sasl_params(...) and call $status = $ld->bind_s(-type=>LDAP_AUTH_SASL) Bellow is an example of GSSAPI K5 bind parameters. $ld->sasl_parms(-mech=>"GSSAPI", -realm=>"domain.name.com", -authzid=>"", -secprops=>"", -flags=>LDAP_SASL_QUIET); For all of the above operations, you could compare $status to LDAP_SUCCESS to see if the operation was successful. Additionally, you could use 'bind' rather than 'bind_s' if you wanted to use the Asynchronous LDAP routines. The asynchronous routines would return a MSGID rather than a status. To find the status of an Asynchronous bind, you would need to first obtain the result with a call to $ld->result. See the entry for result later in the man page, as well as the 'ldapwalk.pl' example for further information on obtaining results from Asynchronous operations. The bind operations can also accept named arguments. $status = $ld->bind_s(-dn=>$dn, -password=>$password, -type=>LDAP_AUTH_SIMPLE); As with all other commands that support named arguments, the order of the arguments makes no difference. =head1 GENERATING AN ADD/MODIFY HASH For the add and modify routines you will need to generate a list of attributes and values. You will do this by creating a HASH table. Each attribute in the hash contains associated values. These values can be one of three things. - SCALAR VALUE (ex. "Clayton Donley") - ARRAY REFERENCE (ex. ["Clayton Donley","Clay Donley"]) - HASH REFERENCE (ex. {"r",["Clayton Donley"]} note: the value inside the HASH REFERENCE must currently be an ARRAY REFERENCE. The key inside the HASH REFERENCE must be one of the following for a modify operation: - "a" for LDAP_MOD_ADD (Add these values to the attribute) - "r" for LDAP_MOD_REPLACE (Replace these values in the attribute) - "d" for LDAP_MOD_DELETE (Delete these values from the attribute) Additionally, in add and modify operations, you may specify "b" if the attributes you are adding are BINARY (ex. "rb" to replace binary). Currently, it is only possible to do one operation per add/modify operation, meaning you can't do something like: {"d",["Clayton"],"a",["Clay"]} <-- WRONG! Using any combination of the above value types, you can do things like: %ldap_modifications = ( "cn", "Clayton Donley", # Replace 'cn' values "givenname", ["Clayton","Clay"], # Replace 'givenname' values "mail", {"a",["donley\@cig.mcel.mot.com"], #Add 'mail' values "jpegphoto", {"rb",[$jpegphotodata]}, # Replace Binary jpegPhoto ); Then remember to call the add or modify operations with a REFERENCE to this HASH. Something like: $ld->modify_s($modify_dn,\%ldap_modifications); =head1 GETTING/SETTING LDAP INTERNAL VALUES The following methods exist to obtain internal values within a Net::LDAPapi object: o errno - The last error-number returned by the LDAP library for this connection. ex: print "Error Number: " . $ld->errno . "\n"; o errstring - The string equivalent of 'errno'. ex: print "Error: " . $ld->errstring . "\n"; o ld - Reference to the actual internal LDAP structure. Only useful if you needed to obtain this pointer for use in non-OO routines. ex: $ldptr = $ld->ld; o entry - Reference to the current entry. Not typically needed, but method supplied, just in case. ex: $entry = $ld->entry; o msgid - Get msgid from an LDAP Result. ex: $msgid = $ld->msgid; # msgid of current result ex: $msgid = $ld->msgid($result) # msgid of $result o msgtype - Get msgtype from an LDAP Result. ex: $msgtype = $ld->msgtype; # msgtype of current result ex: $msgtype = $ld->msgtype($result) # msgtype of $result These methods are only useful for GETTING internal information, not setting it. No methods are currently available for SETTING these internal values. =head1 GETTING AND SETTING LDAP SESSION OPTIONS The get_option and set_option methods can be used to get and set LDAP session options. The following LDAP options can be set or gotten with these methods: LDAP_OPT_DEREF - Dereference LDAP_OPT_SIZELIMIT - Maximum Number of Entries to Return LDAP_OPT_TIMELIMIT - Timeout for LDAP Operations LDAP_OPT_REFERRALS - Follow Referrals For both get and set operations, the first argument is the relivant option. In get, the second argument is a reference to a scalar variable that will contain the current value of the option. In set, the second argument is the value at which to set this option. Examples: $ld->set_option(LDAP_OPT_SIZELIMIT,50); $ld->get_option(LDAP_OPT_SIZELIMIT,\$size); When setting LDAP_OPT_REFERRALS, the second argument is either LDAP_OPT_ON or LDAP_OPT_OFF. Other options require a number. Both get_option and set_option return 0 on success and non-zero otherwise. =head1 SSL SUPPORT When compiled with the Mozilla SDK, this module now supports SSL. I do not have an SSL capable server, but I'm told this works. The functions available are: o ssl - Turn on SSL for this connection. Install I/O routines to make SSL over LDAP possible o ssl_client_init($certdbpath,$certdbhandle) Initialize the secure parts (called only once) Example: $ld = new Net::LDAPapi("host",LDAPS_PORT); $ld->ssl_client_init($certdbpath,$certdbhandle); $ld->ssl; =head1 SETTING REBIND PROCESS As of version 1.42, rebinding now works properly. The set_rebind_proc method is used to set a PERL function to supply DN, PASSWORD, and AUTHTYPE for use when the server rebinds (for referals, etc...). Usage should be something like: $rebind_ref = \&my_rebind_proc; $ld->set_rebind_proc($rebind_ref); You can then create the procedure specified. It should return 3 values. Example: sub my_rebind_proc { return($dn,$pass,LDAP_AUTH_SIMPLE); } =head1 EXTENDED OPERATIONS Extended operations are supported. The extended_operation and extended_operation_s methods are used to invoke extended operations. Example (WHOAMI): %result = (); if ($ld->extended_operation_s(-oid => "1.3.6.1.4.1.4203.1.11.3", -result => \%result) != LDAP_SUCCESS) { $ld->perror("ldap_extended_operation_s"); exit -1; } Note that WHOAMI is already natively implemented via whoami and whoami_s methods. =head1 SUPPORTED METHODS =over 4 =item abandon MSGID SCTRLS CCTRLS This cancels an asynchronous LDAP operation that has not completed. It returns an LDAP STATUS code upon completion. Example: $status = ldap_abandon($ld, $msgid); # XXX fix this =item add DN ATTR SCTRLS CCTRLS Begins an an asynchronous LDAP Add operation. It returns a MSGID or undef upon completion. Example: %attributes = ( "cn", ["Clayton Donley","Clay Donley"] #Add Multivalue cn "sn", "Donley", #Add sn "telephoneNumber", "+86-10-65551234", #Add telephoneNumber "objectClass", ["person","organizationalPerson"], # Add Multivalue objectClass "jpegphoto", {"b",[$jpegphoto]}, # Add Binary jpegphoto ); $entrydn = "cn=Clayton Donley, o=Motorola, c=US"; $msgid = $ld->add($entrydn, \%attributes); Note that in most cases, you will need to be bound to the LDAP server as an administrator in order to add users. =item add_s DN ATTR SCTRLS CCTRLS Synchronous version of the 'add' method. Arguments are identical to the 'add' method, but this operation returns an LDAP STATUS, not a MSGID. Example: $ld->add_s($entrydn, \%attributes); See the section on creating the modify structure for more information on populating the ATTRIBUTES field for Add and Modify operations. =item bind DN PASSWORD TYPE SCTRLS CCTRLS Asynchronous method for binding to the LDAP server. It returns a MSGID. Examples: $msgid = $ld->bind; $msgid = $ld->bind("cn=Clayton Donley, o=Motorola, c=US", "abc123"); =item bind_s DN PASSWORD TYPE SCTRLS CCTRLS Synchronous method for binding to the LDAP server. It returns an LDAP STATUS. Examples: $status = $ld->bind_s; $status = $ld->bind_s("cn=Clayton Donley, o=Motorola, c=US", "abc123"); =item compare DN ATTR VALUE SCTRLS CCTRLS Asynchronous method for comparing a value with the value contained within DN. Returns a MSGID or undef. Example: $msgid = $ld->compare("cn=Clayton Donley, o=Motorola, c=US", \ $type, $value); =item compare_s DN ATTR VALUE SCTRLS CCTRLS Synchronous method for comparing a value with the value contained within DN. Returns an LDAP_COMPARE_TRUE, LDAP_COMPARE_FALSE or an error code. Example: $status = $ld->compare_s("cn=Clayton Donley, o=Motorola, c=US", \ $type, $value); =item count_entries Returns the number of entries in an LDAP result chain. Example: $number = $ld->count_entries; =item count_references MSG Return number of references in a given/current message. Example: $number = $ld->count_references =item delete DN Asynchronous method to delete DN. Returns a MSGID or -1 if error. Example: $msgid = $ld->delete("cn=Clayton Donley, o=Motorola, c=US"); =item delete_s DN Synchronous method to delete DN. Returns an LDAP STATUS. Example: $status = $ld->delete_s("cn=Clayton Donley, o=Motorola, c=US"); =item dn2ufn DN Converts a Distinguished Name (DN) to a User Friendly Name (UFN). Returns a string with the UFN. Since this operation doesn't require an LDAP object to work, you could technically access the function directly as 'ldap_dn2ufn' rather that the object oriented form. Example: $ufn = $ld->dn2ufn("cn=Clayton Donley, o=Motorola, c=US"); =item explode_dn DN NOTYPES Splits the DN into an array comtaining the separate components of the DN. Returns an Array. NOTYPES is a 1 to remove attribute types and 0 to retain attribute types. Can also be accessed directly as 'ldap_explode_dn' if no session is initialized and you don't want the object oriented form. In OpenLDAP this call is depricated. Example: @components = $ld->explode_dn($dn, 0); =item explode_rdn RDN NOTYPES Same as explode_dn, except that the first argument is a Relative Distinguished Name. NOTYPES is a 1 to remove attribute types and 0 to retain attribute types. Returns an array with each component. Can also be accessed directly as 'ldap_explode_rdn' if no session is initialized and you don't want the object oriented form. In OpenLDAP this call is depricated. Example: @components = $ld->explode_rdn($rdn, 0); =item extended_operation OID BERVAL SCTRLS CCTRLS Asynchronous method for invoking an extended operation. Returns a non-negative MSGID upon success. Examples: $msgid = $ld->extended_operation("1.3.6.1.4.1.4203.1.11.3"); =item extended_operation_s OID BERVAL SCTRLS CCTRLS RESULT Synchronous method for invoking an extended operation. Returns LDAP_SUCCESS upon success. Examples: $status = $ld->extended_operation_s(-oid => "1.3.6.1.4.1.4203.1.11.3", \ -result => \%result); =item first_attribute Returns pointer to first attribute name found in the current entry. Note that this only returning attribute names (ex: cn, mail, etc...). Returns a string with the attribute name. Returns an empty string when no attributes are available. Example: $attr = $ld->first_attribute; =item first_entry Sets internal pointer to the first entry in a chain of results. Returns an empty string when no entries are available. Example: $entry = $ld->first_entry; =item first_message Return the first message in a chain of result returned by the search operation. LDAP search operations return LDAPMessage, which is a head in chain of messages accessable to the user. Not all all of them are entries though. Type of the message can be obtained by calling msgtype(...) function. =item get_all_entries RESULT Returns result of the search operation in the following format (HASH) dn -> (HASH) key -> (ARRAY) Example: my $all_entries_ref = $ld->get_all_entries; my %all_entries = %$all_entries_ref; foreach (keys %all_entries) { print "<$_> -> <".$all_entries{$_}.">\n"; $entry = $all_entries{$_}; local %entry_h = %$entry; foreach $k (keys %entry_h) { $values = $entry_h{$k}; print " <$k> ->\n"; foreach $val (@$values) { print " <$val>\n"; } } } =item get_dn MSG Returns a string containing the DN for the specified message or an empty string if an error occurs. If no message is specified then then default entry is used. Example: $dn = $ld->get_dn; =item get_entry_controls MSG Returns an array of controls returned with the given entry. If not MSG is given as a paramater then current message/entry is used. Example: my @sctrls = $ld->get_entry_controls($msg); foreach $ctrl (@sctrls) { print "control oid is ".$self->get_control_oid($ctrl)."\n"; } =item get_values ATTR Obtain a list of all values associated with a given attribute. Returns an empty list if none are available. Example: @values = $ld->get_values("cn"); This would put all the 'cn' values for $entry into the array @values. =item get_values_len ATTR Retrieves a set of binary values for the specified attribute. Example: @values = $ld->get_values_len("jpegphoto"); This would put all the 'jpegphoto' values for $entry into the array @values. These could then be written to a file, or further processed. =item is_ldap_url URL Checks to see if a specified URL is a valid LDAP Url. Returns 0 on false and 1 on true. Example: $isurl = $ld->is_ldap_url("ldap://x500.my.org/o=Org,c=US"); =item listen_for_changes BASEDN SCOPE FILTER ATTRS ATTRSONLY TIMEOUT SIZELIMIT COOKIE Experimental function which implements syncrepl API in refreshAndPersist mode. All but one arguments are the same as in search function. Argument 'cookie' is the special one here. It must be specified and is a file name in which cookie is to be stored. On a subsequent restart of the seach only the newer results will be returned than those indicated by the stored cookie. To refresh all entries, one would have to remove that file. This function is to be used in conjunction with next_changed_entries(...), there you will also find example of its usage. =item msgfree Frees the current LDAP result. Returns the type of message freed. Example: $type = $ld->msgfree; =item msgtype MSG Returns the numeric id of a given message. If no MSG is given as a parameter then current message is used. Following types are recognized: LDAP_RES_BIND, LDAP_RES_SEARCH_ENTRY, LDAP_RES_SEARCH_REFERENCE, LDAP_RES_SEARCH_RESULT, LDAP_RES_MODIFY, LDAP_RES_ADD, LDAP_RES_DELETE, LDAP_RES_MODDN, LDAP_RES_COMPARE, LDAP_RES_EXTENDED, LDAP_RES_INTERMEDIATE, LDAP_RES_ANY, LDAP_RES_UNSOLICITED. Example: $type = $ld->msgtype =item msgtype2str TYPE Returns string representation of a given numeric message type. Example: print "type = ".$ld->msgtype2str($ld->msgtype)."\n"; =item modify DN MOD Asynchronous method to modify an LDAP entry. DN is the DN to modify and MOD contains a hash-table of attributes and values. If multiple values need to be passed for a specific attribute, a reference to an array must be passed. Returns the MSGID of the modify operation. Example: %mods = ( "telephoneNumber", "", #remove telephoneNumber "sn", "Test", #set SN to TEST "mail", ["me\@abc123.com","me\@second-home.com"], #set multivalue 'mail' "pager", {"a",["1234567"]}, #Add a Pager Value "jpegphoto", {"rb",[$jpegphoto]}, # Replace Binary jpegphoto ); $msgid = $ld->modify($entrydn,\%mods); The above would remove the telephoneNumber attribute from the entry and replace the "sn" attribute with "Test". The value in the "mail" attribute for this entry would be replaced with both addresses specified in @mail. The "jpegphoto" attribute would be replaced with the binary data in $jpegphoto. =item modify_s DN MOD Synchronous version of modify method. Returns an LDAP STATUS. See the modify method for notes and examples of populating the MOD parameter. Example: $status = $ld->modify_s($entrydn,\%mods); =item modrdn2 DN NEWRDN DELETE No longer available. Use function 'rename'. =item modrdn2_s DN NEWRDN DELETE No longer available. Use function 'rename_s'. =item next_attribute Similar to first_attribute, but obtains next attribute. Returns a string comtaining the attribute name. An empty string is returned when no further attributes exist. Example: $attr = $ld->next_attribute; =item next_changed_entries MSGID ALL TIMEOUT This function is too be used together with listen_for_changes(...) (see above). It returns an array of Entries, which has just changed. Each element in this array is a hash reference with two key value pairs, 'entry' which contains usual entry and 'state' which contain one of the following strings 'present', 'add', 'modify' or 'delete'. Example: my $msgid = $ld->listen_for_changes('', LDAP_SCOPE_SUBTREE, "(cn=Dm*)", NULL, NULL, NULL, NULL, $cookie); while(1) { while( @entries = $ld->next_changed_entries($msgid, 0, -1) ) { foreach $entry (@entries) { print "entry dn is <".$ld->get_dn($entry->{'entry'})."> ". $entry->{'state'}."\n"; } } } =item next_entry Moves internal pointer to the next entry in a chain of search results. Example: $entry = $ld->next_entry; =item next_message Moves internal pointer to the next message in a chain of search results. Example: $msg = $ld->next_message; =item parse_result MSG FREEMSG This function is used to retrieve auxiliary data associated with the message. The return value is a hashtable containing following kevalue pairs. 'errcode' -> numeric 'matcheddn' -> string 'errmsg' -> string 'referrals' -> array reference 'serverctrls' -> array reference The FREEMSG parameter determines whether the parsed message is freed or not after the extraction. Any non-zero value will make it free the message. The msgfree() routine can also be used to free the message later. =item perror MSG If an error occurs while performing an LDAP function, this procedure will display it. You can also use the err and errstring methods to manipulate the error number and error string in other ways. Note that this function does NOT terminate your program. You would need to do any cleanup work on your own. Example: $ld->perror("add_s"); =item rename DN NEWRDN NEWSUPER DELETE SCTRLS CCTRLS Asynchronous method to change the name of an entry. NEWSUPER is a new parent (superior entry). If set to NULL then only the RDN is changed. Set DELETE to non-zero if you wish to remove the attribute values from the old name. Returns a MSGID. Example: $msgid = $ld->rename("cn=Clayton Donley, o=Motorola, c=US", \ "cn=Clay Donley", NULL, 0); =item rename_s DN NEWRDN NEWSUPER DELETE SCTRLS CCTRLS Synchronous method to change the name of an entry. NEWSUPER is a new parent (superior entry). If set to NULL then only the RDN is changed. Set DELETE to non-zero if you wish to remove the attribute values from the old name. Returns a LDAP STATUS. Example: $status = $ld->rename("cn=Clayton Donley, o=Motorola, c=US", \ "cn=Clay Donley", NULL, 0); =item result MSGID ALL TIMEOUT Retrieves the result of an operation initiated using an asynchronous LDAP call. It calls internally ldap_result function. Returns LDAP message or undef if error. Return value of ldap_result call stored in $ld->{"status"} and is set -1 if something wrong happened, 0 if specified timeout was exceeded or type of the returned message. MSGID is the MSGID returned by the Asynchronous LDAP call. Set ALL to 0 to receive entries as they arrive, or non-zero to receive all entries before returning. Set TIMEOUT to the number of seconds to wait for the result, or -1 for no timeout. Example: $entry = $ld->result($msgid, 0, 1); print "msgtype = ".$ld->msgtype2str($ld->{"status"})."\n"; =item result_entry This function is a shortcut for moving pointer along the chain of entries in the result. It is used instead of first_entry and next_entry functions. Example while( $entry = $ld->result_entry ) { print "dn = ".$ld->get_dn($entry)."\n"; } =item result_message This function is a shortcut for moving pointer along the chain of messages in the result. It is used instead of first_message and next_message functions. Example while( $msg = $ld->result_message ) { $msgtype = $self->msgtype($msg); } =item search BASE SCOPE FILTER ATTRS ATTRSONLY Begins an asynchronous LDAP search. Returns a MSGID or -1 if an error occurs. BASE is the base object for the search operation. FILTER is a string containing an LDAP search filter. ATTRS is a reference to an array containing the attributes to return. An empty array would return all attributes. ATTRSONLY set to non-zero will only obtain the attribute types without values. SCOPE is one of the following: LDAP_SCOPE_BASE LDAP_SCOPE_ONELEVEL LDAP_SCOPE_SUBTREE Example: @attrs = ("cn","sn"); # Return specific attributes @attrs = (); # Return all Attributes $msgid = $ld->search("o=Motorola, c=US", LDAP_SCOPE_SUBTREE, \ "(sn=Donley), \@attrs, 0); =item search_s BASE SCOPE FILTER ATTRS ATTRSONLY (rewrite XXX) Performs a synchronous LDAP search. Returns an LDAP STATUS. BASE is the base object for the search operation. FILTER is a string containing an LDAP search filter. ATTRS is a reference to an array containing the attributes to return. An empty array would return all attributes. ATTRSONLY set to non-zero will only obtain the attribute types without values. SCOPE is one of the following: LDAP_SCOPE_BASE LDAP_SCOPE_ONELEVEL LDAP_SCOPE_SUBTREE Example: @attrs = ("cn","sn"); # Return specific attributes @attrs = (); # Return all attributes $status = $ld->search_s("o=Motorola, c=US",LDAP_SCOPE_SUBTREE, \ "(sn=Donley)",\@attrs,0); =item search_st BASE SCOPE FILTER ATTRS ATTRSONLY TIMEOUT (rewrite/remove XXX) Performs a synchronous LDAP search with a TIMEOUT. See search_s for a description of parameters. Returns an LDAP STATUS. Results are put into RESULTS. TIMEOUT is a number of seconds to wait before giving up, or -1 for no timeout. Example: $status = $ld->search_st("o=Motorola, c=US",LDAP_SCOPE_SUBTREE, \ "(sn=Donley),[],0,3); =item unbind SCTRLS CCTRLS Unbind LDAP connection with specified SESSION handler. Example: $ld->unbind; =item url_parse URL Parses an LDAP URL into separate components. Returns a HASH reference with the following keys, if they exist in the URL: host - LDAP Host port - LDAP Port dn - LDAP Base DN attr - LDAP Attributes to Return (ARRAY Reference) filter - LDAP Search Filter scope - LDAP Search Scope options - Mozilla key specifying LDAP over SSL Example: $urlref = $ld->url_parse("ldap://ldap.my.org/o=My,c=US"); =item url_search URL ATTRSONLY Perform an asynchronous search using an LDAP URL. URL is the LDAP URL to search on. ATTRSONLY determines whether we are returning the values for each attribute (0) or only returning the attribute names (1). Results are retrieved and parsed identically to a call to the search method. Returns a non-negative MSGID upon success. Example: $msgid = $ld->url_search($my_ldap_url, 0); =item url_search_s URL ATTRSONLY Synchronous version of the url_search method. Results are retrieved and parsed identically to a call to the search_s method. Returns LDAP_SUCCESS upon success. Example: $status = $ld->url_search_s($my_ldap_url, 0); =item url_search_st URL ATTRSONLY TIMEOUT Similar to the url_search_s method, except that it allows a timeout to be specified. The timeout is specified as seconds. A timeout of 0 specifies an unlimited timeout. Results are retrieved and parsed identically to a call to the search_st method. Returns LDAP_SUCCESS upon success. Example: $status = $ld->url_search_s($my_ldap_url,0,2); =item whoami SCTRLS CCTRLS Asynchronous method for invoking an LDAP whoami extended operation. Returns a non-negative MSGID upon success. Examples: $msgid = $ld->whoami(); =item whoami_s AUTHZID SCTRLS CCTRLS Synchronous method for invoking an LDAP whoami extended operation. Returns LDAP_SUCCESS upon success. Examples: $status = $ld->whoami_s(\$authzid); =back =head1 AUTHOR Clayton Donley, donley@wwa.com http://miso.wwa.com/~donley/ =head1 SEE ALSO perl(1). =cut net-ldapapi-3.0.7/LDAPapi.xs000066400000000000000000001267641354766267100155460ustar00rootroot00000000000000/* This file was modified by Howard Chu, hyc@symas.com, 2000-2003. * Most changes are #if OPENLDAP, some are not marked. */ #ifdef __cplusplus extern "C" { #endif #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #ifdef __cplusplus } #endif #include #include #include /* Mozilla prototypes declare things as "const char *" while */ /* OpenLDAP uses "char *" */ #ifdef MOZILLA_LDAP #define LDAP_CHAR const char #include #else #ifndef OPENLDAP #include "ldap_compat.h" #endif #define LDAP_CHAR char #endif #ifndef LDAP_RES_INTERMEDIATE #define LDAP_RES_INTERMEDIATE 0x79U /* 121 */ #endif /* Function Prototypes for Internal Functions */ static char **av2modvals(AV *ldap_value_array_av, int ldap_isa_ber); static LDAPMod *parse1mod(SV *ldap_value_ref,char *ldap_current_attribute, int ldap_add_func,int cont); static LDAPMod **hash2mod(SV *ldap_change,int ldap_add_func, const char *func); #ifdef OPENLDAP static int internal_rebind_proc(LDAP *ld, LDAP_CONST char *url, ber_tag_t request, ber_int_t msgid, void *params); #endif /* The Name of the PERL function to return DN, PASSWD, AUTHTYPE on Rebind */ /* Set using 'set_rebind_proc()' */ SV *ldap_perl_rebindproc = NULL; /* Use constant.h generated from constant.gen */ /* Courtesy of h.b.furuseth@usit.uio.no */ #include "constant.h" /* Strcasecmp - Some operating systems don't have this, including NT */ int StrCaseCmp(const char *s, const char *t) { while (*s && *t && toupper(*s) == toupper(*t)) { s++; t++; } return(toupper(*s) - toupper(*t)); } /* av2modvals - Takes a single Array Reference (AV *) and returns */ /* a null terminated list of char pointers. */ static char **av2modvals(AV *ldap_value_array_av, int ldap_isa_ber) { I32 ldap_arraylen; char **ldap_ch_modvalues = NULL; char *ldap_current_value_char = NULL; struct berval **ldap_bv_modvalues = NULL; struct berval *ldap_current_bval = NULL; SV **ldap_current_value_sv; int ldap_value_count = 0,ldap_pvlen,ldap_real_valuecount = 0; ldap_arraylen = av_len(ldap_value_array_av); if (ldap_arraylen < 0) return(NULL); if (ldap_isa_ber == 1) { New(1,ldap_bv_modvalues,2+ldap_arraylen,struct berval *); } else { New(1,ldap_ch_modvalues,2+ldap_arraylen,char *); } for (ldap_value_count = 0; ldap_value_count <=ldap_arraylen; ldap_value_count++) { ldap_current_value_sv = av_fetch(ldap_value_array_av,ldap_value_count,0); ldap_current_value_char = SvPV(*ldap_current_value_sv,PL_na); ldap_pvlen = SvCUR(*ldap_current_value_sv); if (strcmp(ldap_current_value_char,"") != 0) { if (ldap_isa_ber == 1) { New(1,ldap_current_bval,1,struct berval); ldap_current_bval->bv_len = ldap_pvlen; ldap_current_bval->bv_val = ldap_current_value_char; ldap_bv_modvalues[ldap_real_valuecount] = ldap_current_bval; } else { ldap_ch_modvalues[ldap_real_valuecount] = ldap_current_value_char; } ldap_real_valuecount++; } } if (ldap_isa_ber == 1) { ldap_bv_modvalues[ldap_real_valuecount] = NULL; return ((char **)ldap_bv_modvalues); } else { ldap_ch_modvalues[ldap_real_valuecount] = NULL; return (ldap_ch_modvalues); } } /* parse1mod - Take a single reference, figure out if it is a HASH, */ /* ARRAY, or SCALAR, then extract the values and attributes and */ /* return a single LDAPMod pointer to this data. */ static LDAPMod *parse1mod(SV *ldap_value_ref,char *ldap_current_attribute, int ldap_add_func,int cont) { LDAPMod *ldap_current_mod; static HV *ldap_current_values_hv; HE *ldap_change_element; char *ldap_current_modop; SV *ldap_current_value_sv; I32 keylen; int ldap_isa_ber = 0; if (ldap_current_attribute == NULL) return(NULL); New(1,ldap_current_mod,1,LDAPMod); ldap_current_mod->mod_type = ldap_current_attribute; if (SvROK(ldap_value_ref)) { if (SvTYPE(SvRV(ldap_value_ref)) == SVt_PVHV) { if (!cont) { ldap_current_values_hv = (HV *) SvRV(ldap_value_ref); hv_iterinit(ldap_current_values_hv); } if ((ldap_change_element = hv_iternext(ldap_current_values_hv)) == NULL) return(NULL); ldap_current_modop = hv_iterkey(ldap_change_element,&keylen); ldap_current_value_sv = hv_iterval(ldap_current_values_hv, ldap_change_element); if (ldap_add_func == 1) { ldap_current_mod->mod_op = 0; } else { if (strchr(ldap_current_modop,'a') != NULL) { ldap_current_mod->mod_op = LDAP_MOD_ADD; } else if (strchr(ldap_current_modop,'r') != NULL) { ldap_current_mod->mod_op = LDAP_MOD_REPLACE; } else if (strchr(ldap_current_modop,'d') != NULL) { ldap_current_mod->mod_op = LDAP_MOD_DELETE; } else { return(NULL); } } if (strchr(ldap_current_modop,'b') != NULL) { ldap_isa_ber = 1; ldap_current_mod->mod_op = ldap_current_mod->mod_op | LDAP_MOD_BVALUES; } if (SvTYPE(SvRV(ldap_current_value_sv)) == SVt_PVAV) { if (ldap_isa_ber == 1) { ldap_current_mod->mod_values = av2modvals((AV *)SvRV(ldap_current_value_sv),ldap_isa_ber); } else { ldap_current_mod->mod_values = av2modvals((AV *)SvRV(ldap_current_value_sv),ldap_isa_ber); } } } else if (SvTYPE(SvRV(ldap_value_ref)) == SVt_PVAV) { if (cont) return NULL; if (ldap_add_func == 1) ldap_current_mod->mod_op = 0; else ldap_current_mod->mod_op = LDAP_MOD_REPLACE; ldap_current_mod->mod_values = av2modvals((AV *)SvRV(ldap_value_ref),0); if (ldap_current_mod->mod_values == NULL) { ldap_current_mod->mod_op = LDAP_MOD_DELETE; } } } else { if (cont) return NULL; if (strcmp(SvPV(ldap_value_ref,PL_na),"") == 0) { if (ldap_add_func != 1) { ldap_current_mod->mod_op = LDAP_MOD_DELETE; ldap_current_mod->mod_values = NULL; } else { return(NULL); } } else { if (ldap_add_func == 1) { ldap_current_mod->mod_op = 0; } else { ldap_current_mod->mod_op = LDAP_MOD_REPLACE; } New(1,ldap_current_mod->mod_values,2,char *); ldap_current_mod->mod_values[0] = SvPV(ldap_value_ref,PL_na); ldap_current_mod->mod_values[1] = NULL; } } return(ldap_current_mod); } /* hash2mod - Cycle through all the keys in the hash and properly call */ /* the appropriate functions to build a NULL terminated list of */ /* LDAPMod pointers. */ static LDAPMod ** hash2mod(SV *ldap_change_ref, int ldap_add_func, const char *func) { LDAPMod **ldapmod = NULL; LDAPMod *ldap_current_mod; int ldap_attribute_count = 0; HE *ldap_change_element; char *ldap_current_attribute; SV *ldap_current_value_sv; I32 keylen; HV *ldap_change; if (!SvROK(ldap_change_ref) || SvTYPE(SvRV(ldap_change_ref)) != SVt_PVHV) croak("Net::LDAPapi::%s needs Hash reference as argument 3.",func); ldap_change = (HV *)SvRV(ldap_change_ref); hv_iterinit(ldap_change); while((ldap_change_element = hv_iternext(ldap_change)) != NULL) { ldap_current_attribute = hv_iterkey(ldap_change_element,&keylen); ldap_current_value_sv = hv_iterval(ldap_change,ldap_change_element); ldap_current_mod = parse1mod(ldap_current_value_sv, ldap_current_attribute,ldap_add_func,0); while (ldap_current_mod != NULL) { ldap_attribute_count++; (ldapmod ? Renew(ldapmod,1+ldap_attribute_count,LDAPMod *) : New(1,ldapmod,1+ldap_attribute_count,LDAPMod *)); New(1,ldapmod[ldap_attribute_count -1],sizeof(LDAPMod),LDAPMod); Copy(ldap_current_mod,ldapmod[ldap_attribute_count-1], sizeof(LDAPMod),LDAPMod *); ldap_current_mod = parse1mod(ldap_current_value_sv, ldap_current_attribute,ldap_add_func,1); } } ldapmod[ldap_attribute_count] = NULL; return ldapmod; } /* internal_rebind_proc - Wrapper to call a PERL rebind process */ /* ldap_set_rebind_proc is slightly different between Mozilla and OpenLDAP */ int #ifdef OPENLDAP internal_rebind_proc(LDAP *ld, LDAP_CONST char *url, ber_tag_t request, ber_int_t msgid, void *params) #endif { return(LDAP_SUCCESS); } typedef struct bictx { char *authcid; char *passwd; char *realm; char *authzid; } bictx; static int ldap_b2_interact(LDAP *ld, unsigned flags, void *def, void *inter) { sasl_interact_t *in = inter; const char *p; bictx *ctx = def; for (;in->id != SASL_CB_LIST_END;in++) { p = NULL; switch(in->id) { case SASL_CB_GETREALM: p = ctx->realm; break; case SASL_CB_AUTHNAME: p = ctx->authcid; break; case SASL_CB_USER: p = ctx->authzid; break; case SASL_CB_PASS: p = ctx->passwd; break; } if (p) { in->len = strlen(p); in->result = p; } } return LDAP_SUCCESS; } static void sv2timeval(SV *data, struct timeval *tv) { if (SvPOK(data)) { /* set the NV flag if it's readable as a double */ SvNV(data); } if (SvIOK(data) || SvNOK(data)) { tv->tv_sec = SvIV(data); tv->tv_usec = ((SvNV(data) - SvIV(data))*1000000); } } static SV * timeval2sv(struct timeval *data) { return newSVnv(data->tv_sec + ((double)data->tv_usec / 1000000)); } MODULE = Net::LDAPapi PACKAGE = Net::LDAPapi PROTOTYPES: ENABLE double constant(name,arg) char * name int arg char * constant_s(name) char * name int ldap_initialize(ldp, url) LDAP * ldp = NO_INIT LDAP_CHAR * url CODE: { RETVAL = ldap_initialize(&ldp, url); } OUTPUT: RETVAL ldp int ldap_create(ldp) LDAP ** ldp = NO_INIT CODE: { RETVAL = ldap_create(ldp); } OUTPUT: RETVAL ldp int ldap_bind_s(ldp, dn, passwd, authmethod) LDAP * ldp LDAP_CHAR * dn LDAP_CHAR * passwd int authmethod int ldap_set_option(ld,option,optdata) LDAP * ld int option SV * optdata CODE: { void *optptr = NULL; struct timeval tv; int sv_i; switch(option) { #ifdef OPENLDAP case LDAP_OPT_TIMEOUT: case LDAP_OPT_NETWORK_TIMEOUT: sv2timeval(optdata, &tv); optptr = (void *)&tv; break; #endif default: if (SvIOK(optdata)) { sv_i = SvIV(optdata); optptr = (void *) &sv_i; } break; } RETVAL = ldap_set_option(ld,option,optptr); } OUTPUT: RETVAL int ldap_get_option(ld,option,optdata) LDAP * ld int option SV * optdata CODE: { void *data = NULL; RETVAL = ldap_get_option(ld, option, &data); switch(option) { #ifdef OPENLDAP case LDAP_OPT_TIMEOUT: case LDAP_OPT_NETWORK_TIMEOUT: sv_setsv(SvRV(optdata), timeval2sv(data)); break; #endif default: sv_setiv(SvRV(optdata), (long)data); break; } } OUTPUT: RETVAL optdata int ldap_unbind_ext_s(ld,sctrls,cctrls) LDAP * ld LDAPControl ** sctrls LDAPControl ** cctrls int ldap_search_s(ldp, base, scope, filter, attrs, attrsonly, res) LDAP * ldp LDAP_CHAR * base int scope LDAP_CHAR * filter LDAP_CHAR ** attrs int attrsonly LDAPMessage * res = NO_INIT CODE: { RETVAL = ldap_search_s(ldp, base, scope, filter, attrs, attrsonly, &res); } OUTPUT: RETVAL res #ifdef MOZILLA_LDAP int ldap_version(ver) LDAPVersion *ver #endif int ldap_abandon_ext(ld,msgid,sctrls,cctrls) LDAP * ld int msgid LDAPControl ** sctrls LDAPControl ** cctrls int ldap_add_ext(ld, dn, ldap_change_ref, sctrls, cctrls, msgidp) LDAP * ld LDAP_CHAR * dn SV * ldap_change_ref LDAPControl ** sctrls LDAPControl ** cctrls int msgidp = NO_INIT CODE: { LDAPMod ** attrs = hash2mod(ldap_change_ref, 1, "ldap_add_ext"); RETVAL = ldap_add_ext(ld, dn, attrs, sctrls, cctrls, &msgidp); Safefree(attrs); } OUTPUT: RETVAL msgidp int ldap_add_ext_s(ld,dn,ldap_change_ref,sctrls,cctrls) LDAP * ld LDAP_CHAR * dn LDAPMod ** ldap_change_ref = hash2mod($arg, 1, "ldap_add_ext_s"); LDAPControl ** sctrls LDAPControl ** cctrls CLEANUP: Safefree(ldap_change_ref); int ldap_sasl_bind(ld, dn, passwd, serverctrls, clientctrls, msgidp) LDAP * ld LDAP_CHAR * dn LDAP_CHAR * passwd LDAPControl ** serverctrls LDAPControl ** clientctrls int msgidp = NO_INIT CODE: { struct berval cred; if( passwd == NULL ) cred.bv_val = ""; else cred.bv_val = passwd; cred.bv_len = strlen(cred.bv_val); RETVAL = ldap_sasl_bind(ld, dn, LDAP_SASL_SIMPLE, &cred, serverctrls, clientctrls, &msgidp); } OUTPUT: RETVAL msgidp int ldap_modify_ext(ld, dn, ldap_change_ref, sctrls, cctrls, msgidp) LDAP * ld LDAP_CHAR * dn SV * ldap_change_ref LDAPControl ** sctrls LDAPControl ** cctrls int msgidp = NO_INIT CODE: { LDAPMod ** mods = hash2mod(ldap_change_ref, 0, "ldap_modify_ext"); RETVAL = ldap_modify_ext(ld, dn, mods, sctrls, cctrls, &msgidp); Safefree(mods); } OUTPUT: RETVAL msgidp int ldap_modify_ext_s(ld,dn,ldap_change_ref,sctrl,cctrl) LDAP * ld LDAP_CHAR * dn LDAPMod ** ldap_change_ref = hash2mod($arg, 0, "$func_name"); LDAPControl ** sctrl LDAPControl ** cctrl int ldap_rename(ld, dn, newrdn, newSuperior, deleteoldrdn, sctrls, cctrls, msgidp) LDAP * ld LDAP_CHAR * dn LDAP_CHAR * newrdn LDAP_CHAR * newSuperior int deleteoldrdn LDAPControl ** sctrls LDAPControl ** cctrls int msgidp = NO_INIT CODE: { RETVAL = ldap_rename(ld, dn, newrdn, newSuperior, deleteoldrdn, sctrls, cctrls, &msgidp); } OUTPUT: RETVAL msgidp int ldap_rename_s(ld, dn, newrdn, newSuperior, deleteoldrdn, sctrls, cctrls) LDAP * ld LDAP_CHAR * dn LDAP_CHAR * newrdn LDAP_CHAR * newSuperior int deleteoldrdn LDAPControl ** sctrls LDAPControl ** cctrls int ldap_compare_ext(ld,dn,attr,value,sctrls,cctrls,msgidp) LDAP * ld LDAP_CHAR * dn LDAP_CHAR * attr LDAP_CHAR * value LDAPControl ** sctrls LDAPControl ** cctrls int msgidp = NO_INIT CODE: { struct berval bvalue; bvalue.bv_len = strlen(value); bvalue.bv_val = value; RETVAL = ldap_compare_ext(ld, dn, attr, &bvalue, sctrls, cctrls, &msgidp); } OUTPUT: RETVAL msgidp int ldap_compare_ext_s(ld, dn, attr, value, sctrls, cctrls) LDAP * ld LDAP_CHAR * dn LDAP_CHAR * attr LDAP_CHAR * value LDAPControl ** sctrls LDAPControl ** cctrls CODE: { struct berval bvalue; bvalue.bv_len = strlen(value); bvalue.bv_val = value; RETVAL = ldap_compare_ext_s(ld, dn, attr, &bvalue, sctrls, cctrls); } OUTPUT: RETVAL int ldap_delete_ext(ld,dn,sctrls,cctrls,msgidp) LDAP * ld LDAP_CHAR * dn LDAPControl ** sctrls LDAPControl ** cctrls int msgidp = NO_INIT CODE: { RETVAL = ldap_delete_ext(ld, dn, sctrls, cctrls, &msgidp); } OUTPUT: RETVAL msgidp int ldap_delete_ext_s(ld,dn,sctrls,cctrls) LDAP * ld LDAP_CHAR * dn LDAPControl ** sctrls LDAPControl ** cctrls int ldap_search_ext(ld, base, scope, filter, attrs, attrsonly, sctrls, cctrls, timeout, sizelimit, msgidp) LDAP * ld LDAP_CHAR * base int scope LDAP_CHAR * filter SV * attrs int attrsonly LDAPControl ** sctrls LDAPControl ** cctrls SV * timeout int sizelimit int msgidp = NO_INIT CODE: { char **attrs_char; SV **current; int arraylen,count; struct timeval tv_timeout; if (SvTYPE(SvRV(attrs)) != SVt_PVAV) { croak("Net::LDAPapi::ldap_search_ext needs ARRAY reference as argument 5."); XSRETURN(1); } if ((arraylen = av_len((AV *)SvRV(attrs))) < 0) { New(1,attrs_char,2,char *); attrs_char[0] = NULL; } else { New(1,attrs_char,arraylen+2,char *); for (count=0;count <= arraylen; count++) { current = av_fetch((AV *)SvRV(attrs),count,0); attrs_char[count] = SvPV(*current,PL_na); } attrs_char[arraylen+1] = NULL; } sv2timeval(timeout, &tv_timeout); RETVAL = ldap_search_ext(ld, base, scope, filter, attrs_char, attrsonly, sctrls, cctrls, &tv_timeout, sizelimit, &msgidp); Safefree(attrs_char); } OUTPUT: RETVAL msgidp int ldap_search_ext_s(ld, base, scope, filter, attrs, attrsonly, sctrls, cctrls, timeout, sizelimit, res) LDAP * ld LDAP_CHAR * base int scope LDAP_CHAR * filter SV * attrs int attrsonly LDAPControl ** sctrls LDAPControl ** cctrls SV * timeout int sizelimit LDAPMessage * res = NO_INIT CODE: { char **attrs_char; SV **current; int arraylen,count; struct timeval tv_timeout; if (SvTYPE(SvRV(attrs)) == SVt_PVAV) { if ((arraylen = av_len((AV *)SvRV(attrs))) < 0) { New(1, attrs_char, 2, char *); attrs_char[0] = NULL; } else { New(1, attrs_char, arraylen+2, char *); for (count=0;count <= arraylen; count++) { current = av_fetch((AV *)SvRV(attrs),count,0); attrs_char[count] = SvPV(*current,PL_na); } attrs_char[arraylen+1] = NULL; } } else { croak("Net::LDAPapi::ldap_search_ext_s needs ARRAY reference as argument 5."); XSRETURN(1); } sv2timeval(timeout, &tv_timeout); RETVAL = ldap_search_ext_s(ld,base,scope,filter,attrs_char,attrsonly,sctrls,cctrls,&tv_timeout,sizelimit,&res); Safefree(attrs_char); } OUTPUT: RETVAL res int ldap_extended_operation(ld, oid, bv_val, bv_len, sctrls, cctrls, msgidp) LDAP * ld LDAP_CHAR * oid LDAP_CHAR * bv_val int bv_len LDAPControl ** sctrls LDAPControl ** cctrls int msgidp = NO_INIT CODE: { struct berval indata; if (bv_len == 0) { RETVAL = ldap_extended_operation(ld, oid, NULL, sctrls, cctrls, &msgidp); } else { indata.bv_val = bv_val; indata.bv_len = bv_len; RETVAL = ldap_extended_operation(ld, oid, &indata, sctrls, cctrls, &msgidp); } } OUTPUT: RETVAL msgidp int ldap_extended_operation_s(ld, oid, bv_val, bv_len, sctrls, cctrls, retoidp, retdatap) LDAP * ld LDAP_CHAR * oid LDAP_CHAR * bv_val int bv_len LDAPControl ** sctrls LDAPControl ** cctrls char * retoidp = NO_INIT char * retdatap = NO_INIT CODE: { struct berval indata, *retdata; if (bv_len == 0) { RETVAL = ldap_extended_operation_s(ld, oid, NULL, sctrls, cctrls, &retoidp, &retdata); } else { indata.bv_val = bv_val; indata.bv_len = bv_len; RETVAL = ldap_extended_operation_s(ld, oid, &indata, sctrls, cctrls, &retoidp, &retdata); } if (retdata != NULL) retdatap = ldap_strdup(retdata->bv_val); ber_memfree(retdata); } OUTPUT: RETVAL retoidp retdatap int ldap_whoami(ld, sctrls, cctrls, msgidp) LDAP * ld LDAPControl ** sctrls LDAPControl ** cctrls int msgidp = NO_INIT CODE: { RETVAL = ldap_whoami(ld, sctrls, cctrls, &msgidp); } OUTPUT: RETVAL msgidp int ldap_whoami_s(ld, authzid, sctrls, cctrls) LDAP * ld LDAPControl ** sctrls LDAPControl ** cctrls char * authzid = NO_INIT CODE: { struct berval *retdata; RETVAL = ldap_whoami_s(ld, &retdata, sctrls, cctrls); if (retdata != NULL) authzid = ldap_strdup(retdata->bv_val); ber_memfree(retdata); } OUTPUT: RETVAL authzid int ldap_result(ld, msgid, all, timeout, result) LDAP * ld int msgid int all SV * timeout LDAPMessage * result = NO_INIT CODE: { struct timeval tv_timeout; sv2timeval(timeout, &tv_timeout); RETVAL = ldap_result(ld, msgid, all, &tv_timeout, &result); } OUTPUT: RETVAL result int ldap_msgfree(lm) LDAPMessage * lm void ber_free(ber, freebuf) BerElement * ber int freebuf #if defined(MOZILLA_LDAP) || defined(OPENLDAP) int ldap_msgid(lm) LDAPMessage * lm int ldap_msgtype(lm) LDAPMessage * lm #else int ldap_msgid(lm) LDAPMessage * lm CODE: { RETVAL = lm->lm_msgid; } OUTPUT: RETVAL int ldap_msgtype(lm) LDAPMessage * lm CODE: { RETVAL = lm->lm_msgtype; } OUTPUT: RETVAL #endif #if defined(MOZILLA_LDAP) int ldap_get_lderrno(ld,m,s) LDAP * ld char * m = NO_INIT char * s = NO_INIT CODE: { RETVAL = ldap_get_lderrno(ld,&m,&s); } OUTPUT: RETVAL m s int ldap_set_lderrno(ld,e,m,s) LDAP * ld int e char * m char * s #else int ldap_get_lderrno(ld,m,s) LDAP * ld char * m = NO_INIT char * s = NO_INIT CODE: { #ifdef OPENLDAP ldap_get_option(ld, LDAP_OPT_ERROR_NUMBER, &RETVAL); ldap_get_option(ld, LDAP_OPT_ERROR_STRING, &s); ldap_get_option(ld, LDAP_OPT_MATCHED_DN, &m); #else RETVAL = ld->ld_errno; m = ld->ld_matched; s = ld->ld_error; #endif } OUTPUT: RETVAL m s int ldap_set_lderrno(ld,e,m,s) LDAP * ld int e char * m char * s CODE: { RETVAL = 0; #ifdef OPENLDAP ldap_set_option(ld, LDAP_OPT_ERROR_NUMBER, &e); ldap_set_option(ld, LDAP_OPT_ERROR_STRING, s); ldap_set_option(ld, LDAP_OPT_MATCHED_DN, m); #else ld->ld_errno = e; ld->ld_matched = m; ld->ld_error = s; #endif } OUTPUT: RETVAL #endif int ldap_get_entry_controls(ld, entry, serverctrls_ref) LDAP * ld LDAPMessage * entry SV * serverctrls_ref CODE: { int i; if (SvTYPE(SvRV(serverctrls_ref)) != SVt_PVAV) { croak("Net::LDAPapi::ldap_get_entry_controls needs ARRAY reference as argument 3."); XSRETURN(-1); } AV *serverctrls_av = (AV *)SvRV(serverctrls_ref); LDAPControl **serverctrls = NULL; RETVAL = ldap_get_entry_controls( ld, entry, &serverctrls); // transfer returned controls to the perl code if( serverctrls != NULL ) { for( i = 0; serverctrls[i] != NULL; i++ ) av_push(serverctrls_av, newSViv((IV)serverctrls[i])); } free(serverctrls); SvRV( serverctrls_ref ) = (SV *)serverctrls_av; } OUTPUT: RETVAL int ldap_parse_result(ld, msg, errorcodep, matcheddnp, errmsgp, referrals_ref, serverctrls_ref, freeit) LDAP * ld LDAPMessage * msg int errorcodep = NO_INIT SV * matcheddnp SV * errmsgp SV * referrals_ref SV * serverctrls_ref int freeit CODE: { int i; if (SvTYPE(SvRV(referrals_ref)) != SVt_PVAV) { croak("Net::LDAPapi::ldap_parse_result needs ARRAY reference as argument 6."); XSRETURN(-1); } if (SvTYPE(SvRV(serverctrls_ref)) != SVt_PVAV) { croak("Net::LDAPapi::ldap_parse_result needs ARRAY reference as argument 7."); XSRETURN(-1); } AV *serverctrls_av = (AV *)SvRV(serverctrls_ref); AV *referrals_av = (AV *)SvRV(referrals_ref); char *matcheddn = NULL, *errmsg = NULL; LDAPControl **serverctrls = NULL; char **referrals = NULL; RETVAL = ldap_parse_result(ld, msg, &errorcodep, &matcheddn, &errmsg, &referrals, &serverctrls, freeit); // transfer returned referrals to the perl code if( referrals != NULL ) { for( i = 0; referrals[i] != NULL; i++ ) av_push(referrals_av, newSViv((IV)referrals[i])); } // transfer returned controls to the perl code if( serverctrls != NULL ) { for( i = 0; serverctrls[i] != NULL; i++ ) av_push(serverctrls_av, newSViv((IV)serverctrls[i])); } if (matcheddn) { sv_setpv(matcheddnp, matcheddn); free(matcheddn); } if (errmsg) { sv_setpv(errmsgp, errmsg); free(errmsg); } free(serverctrls); free(referrals); SvRV( referrals_ref ) = (SV *)referrals_av; SvRV( serverctrls_ref ) = (SV *)serverctrls_av; } OUTPUT: RETVAL errorcodep matcheddnp errmsgp int ldap_parse_extended_result(ld, msg, retoidp, retdatap, freeit) LDAP * ld LDAPMessage * msg SV * retoidp SV * retdatap int freeit CODE: { struct berval *retdata = NULL; char *retoid; RETVAL = ldap_parse_extended_result(ld, msg, &retoid, &retdata, freeit); sv_setpv(retoidp, retoid); if (retdata != NULL) { sv_setpvn(retdatap, retdata->bv_val, retdata->bv_len); ber_bvfree(retdata); } } OUTPUT: RETVAL retoidp retdatap int ldap_parse_intermediate(ld, msg, retoidp, retdatap, serverctrls_ref, freeit) LDAP * ld LDAPMessage * msg SV * retoidp SV * retdatap SV * serverctrls_ref int freeit CODE: { int i; struct berval *retdata = NULL; char *retoid; if (SvTYPE(SvRV(serverctrls_ref)) != SVt_PVAV) { croak("Net::LDAPapi::ldap_parse_intermediate needs ARRAY reference as argument 5."); XSRETURN(-1); } AV *serverctrls_av = (AV *)SvRV(serverctrls_ref); LDAPControl **serverctrls = NULL; RETVAL = ldap_parse_intermediate(ld, msg, &retoid, &retdata, &serverctrls, freeit); sv_setpv(retoidp, retoid); if( retdata != NULL ) { sv_setpvn(retdatap, retdata->bv_val, retdata->bv_len); ber_bvfree(retdata); } // transfer returned controls to the perl code if( serverctrls != NULL ) { for( i = 0; serverctrls[i] != NULL; i++ ) av_push(serverctrls_av, newSViv((IV)serverctrls[i])); } free(serverctrls); free(retoid); SvRV( serverctrls_ref ) = (SV *)serverctrls_av; } OUTPUT: RETVAL retoidp retdatap int ldap_parse_whoami(ld, msg, authzid) LDAP * ld LDAPMessage * msg SV * authzid CODE: { struct berval *retdata = NULL; RETVAL = ldap_parse_whoami(ld, msg, &retdata); if (retdata != NULL) { sv_setpvn(authzid, retdata->bv_val, retdata->bv_len); ber_bvfree(retdata); } } OUTPUT: RETVAL authzid char * ldap_control_oid(control) LDAPControl * control CODE: { RETVAL = control->ldctl_oid; } OUTPUT: RETVAL SV * ldap_control_berval(control) LDAPControl * control CODE: { RETVAL = newSVpv(control->ldctl_value.bv_val, control->ldctl_value.bv_len); } OUTPUT: RETVAL int ldap_control_critical(control) LDAPControl * control CODE: { RETVAL = control->ldctl_iscritical; } OUTPUT: RETVAL char * ldap_err2string(err) int err int ldap_count_references(ld, result) LDAP *ld LDAPMessage *result int ldap_count_entries(ld,result) LDAP * ld LDAPMessage * result LDAPMessage * ldap_first_entry(ld,result) LDAP * ld LDAPMessage * result LDAPMessage * ldap_next_entry(ld,preventry) LDAP * ld LDAPMessage * preventry LDAPMessage * ldap_first_message(ld, chain) LDAP *ld LDAPMessage *chain LDAPMessage * ldap_next_message(ld, chain) LDAP *ld LDAPMessage *chain SV * ldap_get_dn(ld,entry) LDAP * ld LDAPMessage * entry PREINIT: char * dn; CODE: { dn = ldap_get_dn(ld, entry); if (dn) { RETVAL = newSVpv(dn,0); ldap_memfree(dn); } else { RETVAL = &PL_sv_undef; } } OUTPUT: RETVAL void ldap_perror(ld,s) LDAP * ld LDAP_CHAR * s char * ldap_dn2ufn(dn) LDAP_CHAR * dn #if defined(OPENLDAP) int ldap_str2dn(str,dn,flags) LDAP_CHAR * str LDAPDN * dn unsigned flags int ldap_str2rdn(str,rdn,n_in,flags) LDAP_CHAR * str LDAPRDN * rdn char ** n_in unsigned flags #endif void ldap_explode_dn(dn,notypes) char * dn int notypes PPCODE: { char ** LDAPGETVAL; int i; if ((LDAPGETVAL = ldap_explode_dn(dn,notypes)) != NULL) { for (i = 0; LDAPGETVAL[i] != NULL; i++) { EXTEND(sp,1); PUSHs(sv_2mortal(newSVpv(LDAPGETVAL[i],strlen(LDAPGETVAL[i])))); } ldap_value_free(LDAPGETVAL); } } void ldap_explode_rdn(dn,notypes) char * dn int notypes PPCODE: { char ** LDAPGETVAL; int i; if ((LDAPGETVAL = ldap_explode_rdn(dn,notypes)) != NULL) { for (i = 0; LDAPGETVAL[i] != NULL; i++) { EXTEND(sp,1); PUSHs(sv_2mortal(newSVpv(LDAPGETVAL[i],strlen(LDAPGETVAL[i])))); } ldap_value_free(LDAPGETVAL); } } SV * ldap_first_attribute(ld,entry,ber) LDAP * ld LDAPMessage * entry BerElement * ber = NO_INIT PREINIT: char * attr; CODE: { attr = ldap_first_attribute(ld, entry, &ber); if (attr) { RETVAL = newSVpv(attr,0); ldap_memfree(attr); } else { RETVAL = &PL_sv_undef; } } OUTPUT: RETVAL ber SV * ldap_next_attribute(ld,entry,ber) LDAP * ld LDAPMessage * entry BerElement * ber PREINIT: char * attr; CODE: { attr = ldap_next_attribute(ld, entry, ber); if (attr) { RETVAL = newSVpv(attr,0); ldap_memfree(attr); } else { RETVAL = &PL_sv_undef; } } OUTPUT: RETVAL ber void ldap_get_values_len(ld,entry,target) LDAP * ld LDAPMessage * entry char * target PPCODE: { struct berval ** LDAPGETVAL; int i; if ((LDAPGETVAL = ldap_get_values_len(ld,entry,target)) != NULL) { for (i = 0; LDAPGETVAL[i] != NULL; i++) { EXTEND(sp,1); PUSHs(sv_2mortal(newSVpv(LDAPGETVAL[i]->bv_val,LDAPGETVAL[i]->bv_len))); } } } #ifdef MOZILLA_LDAP int ldapssl_client_init(certdbpath,certdbhandle) char * certdbpath void * certdbhandle LDAP * ldapssl_init(defhost,defport,defsecure) char * defhost int defport int defsecure int ldapssl_install_routines(ld) LDAP * ld #endif void ldap_set_rebind_proc(ld,rebind_function,args) LDAP * ld SV * rebind_function void * args CODE: { if (SvTYPE(SvRV(rebind_function)) != SVt_PVCV) { // rebind_function is not actually a function // and we set rebind function to NULL #if defined(MOZILLA_LDAP) || defined(OPENLDAP) ldap_set_rebind_proc(ld,NULL,NULL); #else ldap_set_rebind_proc(ld,NULL); #endif } else { if (ldap_perl_rebindproc == (SV*)NULL) ldap_perl_rebindproc = newSVsv(rebind_function); else SvSetSV(ldap_perl_rebindproc, rebind_function); #if defined(OPENLDAP) ldap_set_rebind_proc(ld, internal_rebind_proc, args); #endif } } HV * ldap_get_all_entries(ld,result) LDAP * ld LDAPMessage * result CODE: { LDAPMessage *entry = NULL; char *dn = NULL, *attr = NULL; struct berval **vals = NULL; BerElement *ber = NULL; int count = 0; HV* FullHash = newHV(); for ( entry = ldap_first_entry(ld, result); entry != NULL; entry = ldap_next_entry(ld, entry) ) { HV* ResultHash = newHV(); SV* HashRef = newRV((SV*) ResultHash); if ((dn = ldap_get_dn(ld, entry)) == NULL) continue; for ( attr = ldap_first_attribute(ld, entry, &ber); attr != NULL; attr = ldap_next_attribute(ld, entry, ber) ) { AV* AttributeValsArray = newAV(); SV* ArrayRef = newRV((SV*) AttributeValsArray); if ((vals = ldap_get_values_len(ld, entry, attr)) != NULL) { for (count=0; vals[count] != NULL; count++) { SV* SVval = newSVpvn(vals[count]->bv_val, vals[count]->bv_len); av_push(AttributeValsArray, SVval); } } hv_store(ResultHash, attr, strlen(attr), ArrayRef, 0); if (vals != NULL) ldap_value_free_len(vals); } if (attr != NULL) ldap_memfree(attr); hv_store(FullHash, dn, strlen(dn), HashRef, 0); if (dn != NULL) ldap_memfree(dn); #if defined(MOZILLA_LDAP) || defined(OPENLDAP) if (ber != NULL) ber_free(ber,0); #endif } RETVAL = FullHash; } OUTPUT: RETVAL int ldap_is_ldap_url(url) LDAP_CHAR * url SV * ldap_url_parse(url) LDAP_CHAR * url CODE: { LDAPURLDesc *realcomp; int count,ret; HV* FullHash = newHV(); RETVAL = newRV((SV*)FullHash); ret = ldap_url_parse(url,&realcomp); if (ret == 0) { static char *host_key = "host"; static char *port_key = "port"; static char *dn_key = "dn"; static char *attr_key = "attr"; static char *scope_key = "scope"; static char *filter_key = "filter"; #ifdef MOZILLA_LDAP static char *options_key = "options"; SV* options = newSViv(realcomp->lud_options); #endif #ifdef OPENLDAP static char *scheme_key = "scheme"; static char *exts_key = "exts"; AV* extsarray = newAV(); SV* extsibref = newRV((SV*) extsarray); SV* scheme = newSVpv(realcomp->lud_scheme,0); #endif SV* host = newSVpv(realcomp->lud_host,0); SV* port = newSViv(realcomp->lud_port); SV* dn; /* = newSVpv(realcomp->lud_dn,0); */ SV* scope = newSViv(realcomp->lud_scope); SV* filter = newSVpv(realcomp->lud_filter,0); AV* attrarray = newAV(); SV* attribref = newRV((SV*) attrarray); if (realcomp->lud_dn) dn = newSVpv(realcomp->lud_dn,0); else dn = newSVpv("",0); if (realcomp->lud_attrs != NULL) { for (count=0; realcomp->lud_attrs[count] != NULL; count++) { SV* SVval = newSVpv(realcomp->lud_attrs[count],0); av_push(attrarray, SVval); } } #ifdef OPENLDAP if (realcomp->lud_exts != NULL) { for (count=0; realcomp->lud_exts[count] != NULL; count++) { SV* SVval = newSVpv(realcomp->lud_exts[count],0); av_push(extsarray, SVval); } } hv_store(FullHash,exts_key,strlen(exts_key),extsibref,0); hv_store(FullHash,scheme_key,strlen(scheme_key),scheme,0); #endif hv_store(FullHash,host_key,strlen(host_key),host,0); hv_store(FullHash,port_key,strlen(port_key),port,0); hv_store(FullHash,dn_key,strlen(dn_key),dn,0); hv_store(FullHash,attr_key,strlen(attr_key),attribref,0); hv_store(FullHash,scope_key,strlen(scope_key),scope,0); hv_store(FullHash,filter_key,strlen(filter_key),filter,0); #ifdef MOZILLA_LDAP hv_store(FullHash,options_key,strlen(options_key),options,0); #endif ldap_free_urldesc(realcomp); } else { RETVAL = &PL_sv_undef; } } OUTPUT: RETVAL #ifndef OPENLDAP int ldap_url_search(ld,url,attrsonly) LDAP * ld char * url int attrsonly int ldap_url_search_s(ld,url,attrsonly,result) LDAP * ld char * url int attrsonly LDAPMessage * result = NO_INIT CODE: { RETVAL = ldap_url_search_s(ld,url,attrsonly,&result); } OUTPUT: RETVAL result int ldap_url_search_st(ld,url,attrsonly,timeout,result) LDAP * ld char * url int attrsonly SV * timeout LDAPMessage * result = NO_INIT CODE: { struct timeval tv_timeout; sv2timeval(timeout, &tv_timeout); RETVAL = ldap_url_search_st(ld,url,attrsonly,&tv_timeout,&result); } OUTPUT: RETVAL result #endif int ldap_sort_entries(ld,chain,attr) LDAP * ld LDAPMessage * chain char * attr CODE: { RETVAL = ldap_sort_entries(ld,&chain,attr,StrCaseCmp); } OUTPUT: RETVAL chain #ifdef MOZILLA_LDAP int ldap_multisort_entries(ld,chain,attrs) LDAP * ld LDAPMessage * chain SV * attrs CODE: { char **attrs_char; SV ** current; int count,arraylen; if (SvTYPE(SvRV(attrs)) == SVt_PVAV) { if ((arraylen = av_len((AV *)SvRV(attrs))) < 0) { New(1,attrs_char,2,char *); attrs_char[0] = NULL; } else { New(1,attrs_char,arraylen+2,char *); for (count=0;count <= arraylen; count++) { current = av_fetch((AV *)SvRV(attrs),count,0); attrs_char[count] = SvPV(*current,PL_na); } attrs_char[arraylen+1] = NULL; } } else { croak("Net::LDAPapi::ldap_multisort_entries needs ARRAY reference as argument 3."); XSRETURN(1); } RETVAL = ldap_multisort_entries(ld,&chain,attrs_char,StrCaseCmp); } OUTPUT: RETVAL chain #endif #ifdef OPENLDAP int ldap_start_tls(ld,serverctrls,clientctrls,msgidp) LDAP * ld LDAPControl ** serverctrls LDAPControl ** clientctrls int msgidp = NO_INIT CODE: { RETVAL = ldap_start_tls(ld, serverctrls, clientctrls, &msgidp); } OUTPUT: RETVAL msgidp int ldap_start_tls_s(ld,serverctrls,clientctrls) LDAP * ld LDAPControl ** serverctrls LDAPControl ** clientctrls int ldap_sasl_interactive_bind_s(ld, who, passwd, serverctrls, clientctrls, mech, realm, authzid, props, flags) LDAP * ld LDAP_CHAR * who LDAP_CHAR * passwd LDAPControl ** serverctrls LDAPControl ** clientctrls LDAP_CHAR * mech LDAP_CHAR * realm LDAP_CHAR * authzid LDAP_CHAR * props unsigned flags CODE: { bictx ctx = {who, passwd, realm, authzid}; if (props) ldap_set_option(ld, LDAP_OPT_X_SASL_SECPROPS, props); RETVAL = ldap_sasl_interactive_bind_s( ld, NULL, mech, serverctrls, clientctrls, flags, ldap_b2_interact, &ctx ); } OUTPUT: RETVAL int ldap_sasl_bind_s(ld, dn, passwd, serverctrls, clientctrls, servercredp) LDAP * ld LDAP_CHAR * dn LDAP_CHAR * passwd LDAPControl ** serverctrls LDAPControl ** clientctrls struct berval ** servercredp = NO_INIT CODE: { struct berval cred; if( passwd == NULL ) cred.bv_val = ""; else cred.bv_val = passwd; cred.bv_len = strlen(cred.bv_val); servercredp = 0; /* mdw 20070918 */ RETVAL = ldap_sasl_bind_s(ld, dn, LDAP_SASL_SIMPLE, &cred, serverctrls, clientctrls, servercredp); } OUTPUT: RETVAL servercredp #endif LDAPControl ** ldap_controls_array_init(total) int total CODE: { LDAPControl ** array; array = malloc(total * sizeof(LDAPControl *)); RETVAL = array; } OUTPUT: RETVAL void ldap_controls_array_free(ctrls) LDAPControl ** ctrls CODE: { //int i; //for( i = 0; ctrls[i] != NULL; i++ ) // free((LDAPControl *)ctrls[i]); free(ctrls); } void ldap_control_set(array, ctrl, location) LDAPControl **array LDAPControl *ctrl int location CODE: { array[location] = ctrl; } int ldap_create_control(oid, bv_val, bv_len, iscritical, ctrlp) LDAP_CHAR * oid LDAP_CHAR * bv_val int bv_len int iscritical LDAPControl * ctrlp = NO_INIT CODE: { LDAPControl *ctrl = malloc(sizeof(LDAPControl)); ctrl->ldctl_oid = ber_strdup(oid); ber_mem2bv(bv_val, bv_len, 1, &ctrl->ldctl_value); ctrl->ldctl_iscritical = iscritical; ctrlp = ctrl; RETVAL = 0; } OUTPUT: RETVAL ctrlp void ldap_control_free (ctrl) LDAPControl *ctrl BerElement * ber_alloc_t(options); int options net-ldapapi-3.0.7/MANIFEST000066400000000000000000000024341354766267100150740ustar00rootroot00000000000000Changes Credits LDAPapi.pm LDAPapi.xs MANIFEST Makefile.PL README Todo constant.gen ldap_compat.h test.pl typemap examples/ldap_mod_attr.pl examples/ldapwalk.pl examples/ldapwalk2.pl examples/testwrite.pl examples/updatepw.pl examples/web500.pl examples/www-ldap.pl META.yml Module meta-data (added by MakeMaker) t/features/whoami.feature t/features/search.feature t/features/options.feature t/features/step_definitions/rename_steps.pl t/features/step_definitions/modify_steps.pl t/features/step_definitions/extended_operation_steps.pl t/features/step_definitions/server_controls_steps.pl t/features/step_definitions/options_steps.pl t/features/step_definitions/delete_steps.pl t/features/step_definitions/search_steps.pl t/features/step_definitions/add_steps.pl t/features/step_definitions/whoami_steps.pl t/features/step_definitions/general_steps.pl t/features/step_definitions/bind_steps.pl t/features/step_definitions/syncrepl_steps.pl t/features/step_definitions/compare_steps.pl t/features/compare.feature t/features/modify.feature t/features/syncrepl.feature t/features/rename.feature t/features/add.feature t/features/server_controls.feature t/features/extended_operations.feature t/features/bind.feature t/features/delete.feature t/01-bdd-cucumber.t t/test-config.pl net-ldapapi-3.0.7/Makefile.PL000066400000000000000000000074731354766267100157250ustar00rootroot00000000000000use ExtUtils::MakeMaker qw(prompt WriteMakefile); use Config; print "\n\nNet::LDAPapi Perl5 Module - by Quanah Gibson-Mount \n\n"; print "OpenLDAP support by Symas Corporation -- http://www.symas.com\n"; print "Updated by Quanah Gibson-Mount to match modern products and vendors.\n"; print "Updated by Dmitri Priimak to use the v3 OpenLDAP API.\n"; print "\nOriginally by Clayton Donley \n\n"; $pl_path = $Config{'perlpath'}; unless (@ARGV) { warn < \$sdk, "lib_path=s" => \$lib_ldap, "include_path=s" => \$include_ldap, "sasl_include_path=s" => \$include_sasl, ); unless ($result) { print STDERR <constant.h "; } WriteMakefile( 'NAME' => 'Net::LDAPapi', 'VERSION_FROM' => 'LDAPapi.pm', 'PREREQ_PM' => { 'Convert::ASN1' => '0.19'}, ($include_sasl ne "" ? ( 'INC' => "-I$include_ldap -I$include_sasl -I/usr/include", ) : ( 'INC' => "-I$include_ldap -I/usr/include", )), ($version eq "MOZILLA" ? ( 'LIBS' => ["-L$lib_ldap -l$ldap_lib"], 'DEFINE' => '-DMOZILLA_LDAP', ) : ( 'LIBS' => ["-L$lib_ldap $ldap_lib"], 'DEFINE' => '-DOPENLDAP', )), 'depend' => { 'LDAPapi.c' => 'constant.h' }, 'clean' => { 'FILES' => 'constant.h' }, META_MERGE => { 'meta-spec' => { version => 2 }, resources => { repository => { type => 'git', url => 'https://github.com/quanah/net-ldapapi.git', web => 'https://github.com/quanah/net-ldapapi', }, }, }, ); net-ldapapi-3.0.7/README000066400000000000000000000170561354766267100146310ustar00rootroot00000000000000======================================================================= Net::LDAPapi Module v3.0.7 for Perl5 by Quanah Gibson-Mount @ Symas, Inc. based on version 2.00 by Quanah Gibson-Mount @ Stanford University based on version 1.50 by Howard Chu @ Symas Corporation based on version 1.43 by Clayton Donley, ======================================================================= COPYRIGHT ========= Copyright (c) 2017-2109 Quanah Gibson-Mount. All rights reserved Copyright (c) 2007 Quanah Gibson-Mount. All rights reserved Copyright (c) 2007 Board of Trustees, Leland Stanford Jr. University Copyright (c) 2003 Howard Chu. All rights reserved. Copyright (c) 1998 Clayton Donley. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. INTRODUCTION ============ This module acts as a Perl5 interface to the LDAP C Development Kits from OpenLDAP and Mozilla. The module itself is written completely in C. Full documentation is included, as are commented example scripts. The current version supports the LDAPv3 API as implemented in OpenLDAP. REQUIREMENTS ============ This module requires Perl5, a C compiler, and the LDAP libraries and include files from one of the following: OpenLDAP C SDK (support added by Symas): http://www.openldap.org Mozilla LDAP C SDK http://wiki.mozilla.org/LDAP_C_SDK A C Compiler is not required for the NT version if you download Perl5 and module binaries and the Mozilla SDK (you must copy the DLL into your system directory). PLATFORMS SUPPORTED =================== This version should be easily compiled on various platforms. It has been tested extensively under Solaris and Linux. As of 3.00, the module has not been tested on Windows. Please let me know if you compile it successfully on a new platform or have any problems. For problems, please include the compilation errors. Support for the Mozilla SDK has not been tested with the v3 rewrites. Testing welcomed. NEW PERL-OO INTERFACE ===================== As of version 1.40, a new Perl-OO layer has been added to allow more object oriented access into the API. All of the original commands are unchanged, but are no longer documented. You are encouraged to use the new OO style routines, which are documented in the man-page. Version 1.42 and above support passing named arguments to all methods. UNIX INSTALLATION ================= After extracting the archive, simply type the following: $ perl5 Makefile.PL $ make Edit the file test.pl to contain your LDAP server, BASEDN, and filter string. Next type: $ make test It should complete all of its tests with no problems. To install the module you will likely need to become root and type: # make install That's it. You can now 'use Net::LDAPapi' and make LDAP calls within your PERL5 scripts with ease. NT SOURCE INSTALLATION ====================== I use Microsoft Visual C++ 5.0. I am not certain what procedures you will need to follow with other compilers. C:\> perl Makefile.PL Answer the questions appropriately. Supply the path to PERL.EXE and the Mozilla library and include files from their SDK. C:\> nmake The module will now be built. c:\> edit test.pl Change the LDAP server name and other attributes as necessary. C:\> nmake test If it passes most of the tests, it probably works, so you'll want to install. For this, just type: C:\> nmake install You can now do a 'use Net::LDAPapi' from your NT Perl modules. You will also want be be sure to copy the nsldap32v11.dll file into your system32 folder. NT BINARY INSTALLATION ====================== First, obtain Perl 5.004 binaries for Windows NT. You can get it at the following URL: http://www.perl.com/CPAN-local/authors/id/GSAR/. Simply get one of the files starting with 'perl5.004'. You will also need the Mozilla LDAP SDK mentioned previously. Copy the nsldap32v11.dll file from that archive into your system32 folder. Finally, unzip the archive into the C:\ directory if you installed PERL in C:\PERL. Otherwise, extract to the parent directory of your PERL installation directory. EXAMPLES ======== There exists six examples in the 'examples' directory. The current examples are: o ldapwalk.pl - This script demonstrates the use of Asynchronous LDAP calls to return all the attributes and values for entries matching a filter specified on the command line. Simply change the variables at the start of the file to match your environment. o ldapwalk2.pl - This is the same as ldapwalk.pl, only it shows how to replace the portion that retrieves results and packages them in the hash of hashes with the new get_all_entries function. o testwrite.pl - This script demonstrates using synchronous Add, Modify, and Delete calls to manage an LDAP server. You need update access to an LDAP server to run this example. Once again, simply change the variables at the top of the file. o www-ldap.pl - This script uses both this module and the CGI.pm module available on the Internet (and included in 5.004). It allows users to authenticate and modify their own information. You can easily customize this program, or learn from it and write your own CGIs. The BIND and WEB_AUTHENTICATE subroutines would be especially useful in incorporating LDAP authentication into your own CGI scripts, even if the script has nothing to do with LDAP otherwise. o web500.pl - This script is a complete Web->LDAP gateway. It uses CGI.pm and this module. It can be easily customized, supports searching, modifications, and even things like jpegphoto uploads and displaying. The original design used frames, but switched to a WebPH style interface for the search part on the advice of Douglas Gray Stephens. o updatepw.pl - Updates a password entry for a user from Unix into the LDAP server. You'll likely have to tinker with this program to get it to do exactly what you want, but it exists as an idea as to how you can do this. o ldap_mod_attr.pl - Matches a filter or UID and makes specified changes to each entry. Contributed by Andrew J Cosgriff. In addition, the test.pl program in the top level directory shows some of the basic synchronous search functionality. LDAP C API SUPPORT ================== This module supports direct perl access to all C API calls with the exception of filter generation calls (since you can do this better in Perl anyway). While direct access is available, it is suggested that you use the Perl-OO style interface if you have never used the C API. FEEDBACK ======== Any feedback should be directed to quanah.gibsonmount@gmail.com BUGS ==== The non-OO stuff should work well. Please let me know if I've introduced any bugs in the OO stuff or the changed examples. Please report bugs at github - https://github.com/quanah/net-ldapapi/issues/ -- Clayton Donley Rolling Meadows, IL, USA email: donley@wwa.com web: http://www.wwa.com/~donley CPAN: /authors/id/CDONLEY Howard Chu Chief Architect, Symas Corporation http://www.symas.com Core Team, OpenLDAP Project http://www.openldap.org Quanah Gibson-Mount email: quanah.gibsonmount@gmail.com CPAN: /by-authors/id/M/MI/MISHIKAL Platform Architect Synacor, Inc http://www.zimbra.com http://synacor.com/ Core Team, OpenLDAP Project http://www.openldap.org net-ldapapi-3.0.7/README.md000066400000000000000000000002031354766267100152120ustar00rootroot00000000000000The Net::LDAPapi Perl Module uses the OpenLDAP and Mozilla C api's to directly access and manipulate an LDAP v2 or LDAP v3 server. net-ldapapi-3.0.7/Todo000066400000000000000000000006501354766267100145710ustar00rootroot00000000000000############################################# # Net::LDAPapi - TODO List # # # # Last Modified # # Date: Wed Aug 20 15:27:19 PST 2007 # ############################################# Platforms: - Test on windows LDAPv3 API Support: - Test against Mozilla C SDK Package: - Update examples to be compliant with version 3.0 builds net-ldapapi-3.0.7/constant.gen000066400000000000000000000235361354766267100162750ustar00rootroot00000000000000#!/usr/misc/bin/perl5 -w # # constants.gen - h.b.furuseth@usit.uio.no # some OpenLDAP constants added by hyc@symas.com # some OpenLDAP constants added by priimak@stanford.edu sub SYM { my($name,$ret) = @_; $ret = $name unless defined $ret; return qq(if (strEQ(name, "$name")) #ifdef $name return $ret; #else goto not_there; #endif); } while () { s%\b(SYM)\(([^()]*)\)%&SYM(split(/,\s*/,$2))%ge; print; } __END__ /* This file is generated from constants.gen. Changes here will be lost! */ #ifndef LDAP_CONTROL_SYNC #define LDAP_CONTROL_SYNC "1.3.6.1.4.1.4203.1.9.1.1" #endif #ifndef LDAP_CONTROL_SYNC_STATE #define LDAP_CONTROL_SYNC_STATE "1.3.6.1.4.1.4203.1.9.1.2" #endif #ifndef LDAP_CONTROL_SYNC_DONE #define LDAP_CONTROL_SYNC_DONE "1.3.6.1.4.1.4203.1.9.1.3" #endif #ifndef LDAP_SYNC_INFO #define LDAP_SYNC_INFO "1.3.6.1.4.1.4203.1.9.1.2" #endif #ifndef LDAP_RES_INTERMEDIATE #define LDAP_RES_INTERMEDIATE ((ber_tag_t) 0x79U) /* V3+: application + constructed */ #endif static char * constant_s(name) char *name; { errno = 0; if (name[0] == 'L' && name[1] == 'D' && name[2] == 'A' && name[3] == 'P' && name[4] == '_' ) switch (name[5]) { case 'S': SYM(LDAP_SASL_NULL) SYM(LDAP_SASL_SIMPLE) SYM(LDAP_SYNC_INFO) break; case 'C': SYM(LDAP_CONTROL_MANAGEDSAIT) SYM(LDAP_CONTROL_PROXY_AUTHZ) SYM(LDAP_CONTROL_SUBENTRIES) SYM(LDAP_CONTROL_VALUESRETURNFILTER) SYM(LDAP_CONTROL_X_VALUESRETURNFILTER) SYM(LDAP_CONTROL_ASSERT) SYM(LDAP_CONTROL_PRE_READ) SYM(LDAP_CONTROL_POST_READ) SYM(LDAP_CONTROL_SORTREQUEST) SYM(LDAP_CONTROL_SORTRESPONSE) SYM(LDAP_CONTROL_PAGEDRESULTS) SYM(LDAP_CONTROL_PASSWORDPOLICYREQUEST) SYM(LDAP_CONTROL_PASSWORDPOLICYRESPONSE) SYM(LDAP_CONTROL_NOOP) SYM(LDAP_CONTROL_NO_SUBORDINATES) SYM(LDAP_CONTROL_MANAGEDIT) SYM(LDAP_CONTROL_SLURP) SYM(LDAP_CONTROL_VALSORT) SYM(LDAP_CONTROL_SYNC) SYM(LDAP_CONTROL_SYNC_STATE) SYM(LDAP_CONTROL_SYNC_DONE) SYM(LDAP_CONTROL_X_CHAINING_BEHAVIOR) SYM(LDAP_CONTROL_X_INCREMENTAL_VALUES) SYM(LDAP_CONTROL_X_DOMAIN_SCOPE) SYM(LDAP_CONTROL_X_PERMISSIVE_MODIFY) SYM(LDAP_CONTROL_X_SEARCH_OPTIONS) SYM(LDAP_CONTROL_X_TREE_DELETE) SYM(LDAP_CONTROL_X_EXTENDED_DN) SYM(LDAP_CONTROL_DUPENT_REQUEST) SYM(LDAP_CONTROL_DUPENT_RESPONSE) SYM(LDAP_CONTROL_DUPENT_ENTRY) SYM(LDAP_CONTROL_DUPENT) SYM(LDAP_CONTROL_PERSIST_REQUEST) SYM(LDAP_CONTROL_PERSIST_ENTRY_CHANGE_NOTICE) SYM(LDAP_CONTROL_VLVREQUEST) SYM(LDAP_CONTROL_VLVRESPONSE) SYM(LDAP_CONTROL_GROUPING) break; } errno = EINVAL; return NULL; not_there: errno = ENOENT; return NULL; } static double constant(name, arg) char *name; int arg; { errno = 0; if (name[0] != 'L') { SYM(FD_SETSIZE) SYM(NBBY) SYM(NFDBITS) } else if (name[1] && name[2] && name[3] && name[4]) switch (name[5]) { case 'A': SYM(LDAP_ADMIN_LIMIT_EXCEEDED) SYM(LDAP_AFFECTS_MULTIPLE_DSAS) SYM(LDAP_ALIAS_DEREF_PROBLEM) SYM(LDAP_ALIAS_PROBLEM) SYM(LDAP_ALREADY_EXISTS) SYM(LDAP_AUTH_KRBV4) SYM(LDAP_AUTH_KRBV41) SYM(LDAP_AUTH_KRBV42) SYM(LDAP_AUTH_KRBV41_30) SYM(LDAP_AUTH_KRBV42_30) SYM(LDAP_AUTH_NONE) SYM(LDAP_AUTH_SASL) SYM(LDAP_AUTH_SIMPLE) SYM(LDAP_AUTH_UNKNOWN) break; case 'B': SYM(LDAP_BUSY) break; case 'C': SYM(LDAP_CACHE_CHECK) SYM(LDAP_CACHE_LOCALDB) SYM(LDAP_CACHE_POPULATE) SYM(LDAP_COMPARE_FALSE) SYM(LDAP_COMPARE_TRUE) SYM(LDAP_CONNECT_ERROR) SYM(LDAP_CONSTRAINT_VIOLATION) break; case 'D': SYM(LDAP_DECODING_ERROR) SYM(LDAP_DEREF_ALWAYS) SYM(LDAP_DEREF_FINDING) SYM(LDAP_DEREF_NEVER) SYM(LDAP_DEREF_SEARCHING) break; case 'E': SYM(LDAP_ENCODING_ERROR) break; case 'F': SYM(LDAP_FILTER_ERROR) SYM(LDAP_FILT_MAXSIZ) break; case 'I': SYM(LDAP_INAPPROPRIATE_AUTH) SYM(LDAP_INAPPROPRIATE_MATCHING) SYM(LDAP_INSUFFICIENT_ACCESS) SYM(LDAP_INVALID_CREDENTIALS) SYM(LDAP_INVALID_DN_SYNTAX) SYM(LDAP_INVALID_SYNTAX) SYM(LDAP_IS_LEAF) break; case 'L': SYM(LDAP_LOCAL_ERROR) SYM(LDAP_LOOP_DETECT) break; case 'M': SYM(LDAP_MOD_ADD) SYM(LDAP_MOD_BVALUES) SYM(LDAP_MOD_DELETE) SYM(LDAP_MOD_REPLACE) break; case 'N': SYM(LDAP_NAMING_VIOLATION) SYM(LDAP_NOT_ALLOWED_ON_NONLEAF) SYM(LDAP_NOT_ALLOWED_ON_RDN) SYM(LDAP_NO_LIMIT) SYM(LDAP_NO_MEMORY) SYM(LDAP_NO_OBJECT_CLASS_MODS) SYM(LDAP_NO_SUCH_ATTRIBUTE) SYM(LDAP_NO_SUCH_OBJECT) break; case 'O': SYM(LDAP_OBJECT_CLASS_VIOLATION) SYM(LDAP_OPERATIONS_ERROR) SYM(LDAP_OPT_API_INFO) SYM(LDAP_OPT_API_FEATURE_INFO) SYM(LDAP_OPT_CACHE_ENABLE) SYM(LDAP_OPT_CACHE_FN_PTRS) SYM(LDAP_OPT_CACHE_STRATEGY) SYM(LDAP_OPT_CLIENT_CONTROLS) SYM(LDAP_OPT_DEBUG_LEVEL) SYM(LDAP_OPT_DEREF) SYM(LDAP_OPT_DESC) SYM(LDAP_OPT_DNS) SYM(LDAP_OPT_HOST_NAME) SYM(LDAP_OPT_IO_FN_PTRS) SYM(LDAP_OPT_NETWORK_TIMEOUT) SYM(LDAP_OPT_OFF, 0) SYM(LDAP_OPT_ON, 1) SYM(LDAP_OPT_PROTOCOL_VERSION) SYM(LDAP_OPT_REBIND_ARG) SYM(LDAP_OPT_REBIND_FN) SYM(LDAP_OPT_REFERRALS) SYM(LDAP_OPT_REFERRAL_HOP_LIMIT) SYM(LDAP_OPT_REFERRAL_URLS) SYM(LDAP_OPT_REFHOPLIMIT) SYM(LDAP_OPT_RESTART) SYM(LDAP_OPT_SIZELIMIT) SYM(LDAP_OPT_SERVER_CONTROLS) SYM(LDAP_OPT_SSL) SYM(LDAP_OPT_THREAD_FN_PTRS) SYM(LDAP_OPT_TIMELIMIT) SYM(LDAP_OPT_TIMEOUT) SYM(LDAP_OPT_URI) SYM(LDAP_OPT_X_SASL) SYM(LDAP_OPT_X_SASL_AUTHCID) SYM(LDAP_OPT_X_SASL_AUTHZID) SYM(LDAP_OPT_X_SASL_MAXBUFSIZE) SYM(LDAP_OPT_X_SASL_MECH) SYM(LDAP_OPT_X_SASL_REALM) SYM(LDAP_OPT_X_SASL_SECPROPS) SYM(LDAP_OPT_X_SASL_SSF) SYM(LDAP_OPT_X_SASL_SSF_EXTERNAL) SYM(LDAP_OPT_X_SASL_SSF_MIN) SYM(LDAP_OPT_X_SASL_SSF_MAX) SYM(LDAP_OPT_X_TLS) SYM(LDAP_OPT_X_TLS_CTX) SYM(LDAP_OPT_X_TLS_CACERTFILE) SYM(LDAP_OPT_X_TLS_CACERTDIR) SYM(LDAP_OPT_X_TLS_CERTFILE) SYM(LDAP_OPT_X_TLS_KEYFILE) SYM(LDAP_OPT_X_TLS_REQUIRE_CERT) SYM(LDAP_OPT_X_TLS_CIPHER_SUITE) SYM(LDAP_OPT_X_TLS_RANDOM_FILE) SYM(LDAP_OPT_X_TLS_SSL_CTX) SYM(LDAP_OPT_X_TLS_NEVER) SYM(LDAP_OPT_X_TLS_HARD) SYM(LDAP_OPT_X_TLS_DEMAND) SYM(LDAP_OPT_X_TLS_ALLOW) SYM(LDAP_OPT_X_TLS_TRY) SYM(LDAP_OTHER) break; case 'P': SYM(LDAP_PARAM_ERROR) SYM(LDAP_PARTIAL_RESULTS) SYM(LDAP_PORT) SYM(LDAP_PORT_MAX) SYM(LDAP_PROTOCOL_ERROR) break; case 'R': SYM(LDAP_REFERRAL) SYM(LDAP_RESULTS_TOO_LARGE) SYM(LDAP_RES_BIND) SYM(LDAP_RES_SEARCH_ENTRY) SYM(LDAP_RES_SEARCH_REFERENCE) SYM(LDAP_RES_SEARCH_RESULT) SYM(LDAP_RES_MODIFY) SYM(LDAP_RES_ADD) SYM(LDAP_RES_DELETE) SYM(LDAP_RES_MODDN) SYM(LDAP_RES_COMPARE) SYM(LDAP_RES_EXTENDED) SYM(LDAP_RES_INTERMEDIATE) SYM(LDAP_RES_ANY) SYM(LDAP_RES_UNSOLICITED) break; case 'S': SYM(LDAP_SASL_AUTOMATIC) SYM(LDAP_SASL_INTERACTIVE) SYM(LDAP_SASL_QUIET) SYM(LDAP_SCOPE_BASE) SYM(LDAP_SCOPE_ONELEVEL) SYM(LDAP_SCOPE_SUBTREE) SYM(LDAP_SECURITY_NONE) SYM(LDAP_SERVER_DOWN) SYM(LDAP_SIZELIMIT_EXCEEDED) SYM(LDAP_STRONG_AUTH_NOT_SUPPORTED) SYM(LDAP_STRONG_AUTH_REQUIRED) SYM(LDAP_SUCCESS) break; case 'T': SYM(LDAP_TAG_SYNC_NEW_COOKIE) SYM(LDAP_TAG_SYNC_REFRESH_DELETE) SYM(LDAP_TAG_SYNC_REFRESH_PRESENT) SYM(LDAP_TAG_SYNC_ID_SET) SYM(LDAP_TAG_SYNC_COOKIE) SYM(LDAP_TAG_REFRESHDELETES) SYM(LDAP_TAG_REFRESHDONE) SYM(LDAP_TAG_RELOAD_HINT) SYM(LDAP_TAG_EXOP_MODIFY_PASSWD_ID) SYM(LDAP_TAG_EXOP_MODIFY_PASSWD_OLD) SYM(LDAP_TAG_EXOP_MODIFY_PASSWD_NEW) SYM(LDAP_TAG_EXOP_MODIFY_PASSWD_GEN) SYM(LDAP_TAG_MESSAGE) SYM(LDAP_TAG_MSGID) SYM(LDAP_TAG_LDAPDN) SYM(LDAP_TAG_LDAPCRED) SYM(LDAP_TAG_CONTROLS) SYM(LDAP_TAG_REFERRAL) SYM(LDAP_TAG_NEWSUPERIOR) SYM(LDAP_TAG_EXOP_REQ_OID) SYM(LDAP_TAG_EXOP_REQ_VALUE) SYM(LDAP_TAG_EXOP_RES_OID) SYM(LDAP_TAG_EXOP_RES_VALUE) SYM(LDAP_TAG_IM_RES_OID) SYM(LDAP_TAG_IM_RES_VALUE) SYM(LDAP_TAG_SASL_RES_CREDS) SYM(LDAP_TIMELIMIT_EXCEEDED) SYM(LDAP_TIMEOUT) SYM(LDAP_TYPE_OR_VALUE_EXISTS) break; case 'U': SYM(LDAP_UNAVAILABLE) SYM(LDAP_UNAVAILABLE_CRITICAL_EXTN) SYM(LDAP_UNDEFINED_TYPE) SYM(LDAP_UNWILLING_TO_PERFORM) SYM(LDAP_URL_ERR_BADSCOPE) SYM(LDAP_URL_ERR_MEM) SYM(LDAP_URL_ERR_NODN) SYM(LDAP_URL_ERR_NOTLDAP) SYM(LDAP_URL_ERR_PARAM) SYM(LDAP_URL_OPT_SECURE) SYM(LDAP_USER_CANCELLED) break; case 'V': SYM(LDAP_VERSION) SYM(LDAP_VERSION1) SYM(LDAP_VERSION2) SYM(LDAP_VERSION3) break; case '_': SYM(LDAPS_PORT) break; } errno = EINVAL; return 0; not_there: errno = ENOENT; return 0; } net-ldapapi-3.0.7/examples/000077500000000000000000000000001354766267100155565ustar00rootroot00000000000000net-ldapapi-3.0.7/examples/ldap_mod_attr.pl000077500000000000000000000152161354766267100207340ustar00rootroot00000000000000#! /usr/bin/perl -w # # ldap_mod_attr - change an attribute in someone's LDAP entry # # Author: Andrew J Cosgriff # Created: Thu Dec 4 19:48:03 1997 # Version: $Id: ldap_mod_attr.pl,v 1.1.1.1 1998/01/30 19:10:06 jonl Exp $ # Keywords: ldap modify add remove attribute commmand-line useful really # ######################################## # ### Commentary: # # Sick of typing in lines of ldapmodify stuff just to change one or # two attributes ? This is for you... # ### TO DO: # # - take note when dealing with multiple values for an attribute # ######################################## # ### Code: # use Net::LDAPapi; use Getopt::Std; use File::Basename; my $version = substr q$Revision: 1.1.1.1 $, 10; chop $version; ########## # # Defaults # $ldap_server = "ldap.org.au"; $BASEDN = $ENV{'LDAP_BASEDN'} || "o=Org, c=AU"; $ROOTDN = "cn=admin, o=Org, c=AU"; $ROOTPW = ""; $batchmode = 0; $verbosemode = 0; $modify_all = 0; $do_nothing = 0; $UIDATTR = "uid"; # # Parse command line options, explained here : # $usage_msg = "ldap_mod_attr version " . $version . " by Andrew J Cosgriff Usage : " . basename($0) . " [options] ... [options] being one or more of : -a : modify all matching entries (rather than prompting for one) -b : base DN for searches [ default - $BASEDN ] -D : bind as this DN to do the modifications [ default - $ROOTDN ] -h : ldap server to talk to [ default - $ldap_server ] -n : do nothing, just show what would happen (implies -v) -q : batch/quiet mode - no prompting for password - no prompting if there are multiple matches -v : verbose mode - print \" changed from to \" -w : the password for the DN we bind as with -D being either : - a uid, eg. \"nate\" - an RFC 1558-style LDAP search filter, eg. \"cn=Nathan Bailey\" exitcodes are : 1 - general error 2 - no matches returned by ldap_search_s 3 - too many matches (for -q) "; if (getopts('ab:D:h:nqvw:?', \%opt) == 0) { print $usage_msg; exit 1; } $modify_all = 1 if (defined $opt{'a'}); $BASEDN = $opt{'b'} if (defined $opt{'b'}); $ROOTDN = $opt{'D'} if (defined $opt{'D'}); $ldap_server = $opt{'h'} if (defined $opt{'h'}); $batchmode = 1 if (defined $opt{'q'}); $verbosemode = 1 if (defined $opt{'v'}); $do_nothing = 1 if (defined $opt{'n'}); $verbosemode = $do_nothing || $verbosemode; $ROOTPW = $opt{'w'} if (defined $opt{'w'}); # # Print help if they want/need it # if ($opt{'?'}) { print $usage_msg; exit 1; } if ($#ARGV == -1) { print "Need to specify a search filter and attr=value pairs\n"; print $usage_msg; exit 1; } if ($#ARGV <= 0) { print "Need to specify attr=value pairs as well\n"; print $usage_msg; exit 1; } print "Well hey, we\'re in DoNothing mode...\n" if $do_nothing; # # Ask for the Root DN's password if they didn't specify it # if ($ROOTPW eq "") { print "Attempting to bind as $ROOTDN\nPassword : "; system "stty -echo"; $ROOTPW = ; chomp $ROOTPW; system "stty echo"; print "\n"; } # # Initialize Connection to LDAP Server # if (($ld = ldap_open($ldap_server,LDAP_PORT)) eq "") { die "ldap_init failed"; } # # Bind as the specified DN # if ((ldap_simple_bind_s($ld,$ROOTDN,$ROOTPW)) != LDAP_SUCCESS) { ldap_perror($ld,"ldap_simple_bind_s"); die "Failed to bind as $ROOTDN"; } # # Perform search # $filter = shift @ARGV; if ($filter !~ /[\(\)\&\|=]/) { $filter = "($UIDATTR=$filter)"; } print "\nSearching for $filter\n" if ($verbosemode); @attrs = (); if (ldap_search_s($ld,$BASEDN,LDAP_SCOPE_SUBTREE,$filter,\@attrs,0,$result) != LDAP_SUCCESS) { $err = ldap_get_lderrno($ld,$errdn,$extramsg); print &ldap_err2string($err),"\n"; print "DN $errdn\n" if defined $errdn; print "extramsg $extramsg\n" if defined $extramsg; ldap_unbind($ld); die "Search for $filter failed\n"; } $num_entries = ldap_count_entries($ld,$result); # # Die if we got no matches, or if we're in batch mode and got more # than one match # exit 2 if ($num_entries == 0); exit 3 if ($batchmode && ($num_entries > 1)); print "$num_entries matches\n" if ($verbosemode && ($num_entries > 1)); $entry = ldap_first_entry($ld, $result); if ($num_entries == 1) { # # If we got just one match, just do it. # &do_mod_entry($entry); } else { # # If we're modifying all entries, loop through and do each one in # turn. Otherwise, make a list of entries so we can present a menu # and ask the user which entry to modify. # while ($entry != 0) { if ($modify_all) { &do_mod_entry($entry); } else { push @entries, $entry; } $entry = ldap_next_entry($ld, $entry); } # # Present a menu of matching entries, and ask which of them the user # wants to modify. # if (! $modify_all) { for $cnt (0 .. $#entries) { print "$cnt : ", ldap_get_dn($ld, $entries[$cnt]), "\n"; } $num = -1; while (($num < 0) || ($num > $#entries)) { print "Which entry ? : "; $num = ; chomp $num; } &do_mod_entry($entries[$num]); } } ######################################## # # do_mod_entry - Given an entry (as returned by # ldap_first_entry/ldap_next_entry), apply all the modifications as # specified in @ARGV # sub do_mod_entry { my $entry = shift @_; my $dn = ldap_get_dn($ld, $entry); print "\nModifying ", ldap_get_dn($ld, $entry), " :\n" if $verbosemode; foreach $mod (@ARGV) { my ($attr, $val) = split('=',$mod); @values = ldap_get_values($ld,$entry,$attr); my (%mods) = ( $attr, $val ); if (($#values > -1) && ($val eq $values[0])) { print "* (no change) $attr=$val\n" if $verbosemode; next; } elsif (($#values == -1) && ($val eq "")) { print "* (no change) $attr not present\n"; next; } # # Print out nice verbose info on what's going on # if ($verbosemode) { if ($val eq "") { if ($#values > -1) { print "- $attr=", $values[0], "\n"; } } elsif ($#values > -1) { print "- $attr=", $values[0], "\n"; print "+ $attr=", $val, "\n"; } else { print "+ $attr=$val\n"; } } # # Apply this modification - it'd be groovier to assemble a list of # modifications so we only call ldap_modify_s once per entry, but # it's a bit fiddly to assemble said list properly, so i'm being # lazy :) # if (! $do_nothing) { if (ldap_modify_s($ld,$dn,\%mods) != LDAP_SUCCESS) { ldap_perror($ld,"ldap_modify_s"); die "Failed to modify $dn\n"; } else { print "* modifications successful.\n" if $verbosemode; } } } } ### ldap_mod_attr ends here net-ldapapi-3.0.7/examples/ldapwalk-dieter.pl000077500000000000000000000074441354766267100212000ustar00rootroot00000000000000#!/usr/bin/perl # # $Id: ldapwalk.pl,v 1.1 2007/07/01 20:14:40 dieter Exp dieter $ # ldapwalk.pl - Walks through Records Matching a Given Filter # Author: Clayton Donley, Motorola, # # Demonstration of Synchronous Searching in PERL5. # # Rather than printing attribute and values directly, they are # stored in a Hash, where further manipulation would be very simple. # The output could then be printed to a file or standard output, or # simply run through the modify or add commands. # # Usage: ldapwalk.pl FILTER # Example: ldapwalk.pl "sn=Donley" # use strict; use Net::LDAPapi; # Define these values my $ldap_server = "localhost"; my $BASEDN = "dc=example, dc=com"; my $sizelimit = 100; # Set to Maximum Number of Entries to Return # Can set small to test error routines my $deref = "search"; # Various Variable Declarations... my $ld; my $dn; my $attr; my $ent; my $ber; my @vals; my %record; my $rc; my $result; # # Initialize Connection to LDAP Server if (($ld = new Net::LDAPapi($ldap_server)) == -1) { die "Connection Failed!"; } #ldap_set_option(0,LDAP_OPT_DEBUG_LEVEL,-1); # # Bind as NULL User to LDAP connection $ld $ld->sasl_parms(-mech=>"DIGEST-MD5",-flags=>LDAP_SASL_AUTOMATIC); if ($ld->bind_s("benchmark","xxx",LDAP_AUTH_SASL) != LDAP_SUCCESS) # if ($ld->bind_s != LDAP_SUCCESS) { $ld->unbind; die "bind: ", $ld->errstring, ": ", $ld->extramsg; } # # This will set the size limit to $sizelimit from above. The command # is a Netscape addition, but I've programmed replacement versions for # other APIs. $ld->set_option(LDAP_OPT_SIZELIMIT,$sizelimit); # $ld->set_option(LDAP_OPT_DEREF,$deref); # This routine is COMPLETELY unnecessary in this application, since # the rebind procedure at the end of this program simply rebinds as # a NULL user. #$ld->set_rebind_proc(&rebindproc); # # Specify Search Filter and List of Attributes to Return my $filter = $ARGV[0]; my @attrs = ("cn","mail","telephonenumber"); # # Perform Search my $msgid = $ld->search($BASEDN,LDAP_SCOPE_ONELEVEL,$filter,\@attrs,0); if ($msgid < 0) { $ld->unbind; die "search: ", $ld->errstring, ": ", $ld->extramsg; } # Reset Number of Entries Counter my $nentries = 0; # Set no timeout. my $timeout = -1; # # Cycle Through Entries while (($rc = $ld->result($msgid,0,$timeout)) == LDAP_RES_SEARCH_ENTRY) { $nentries++; for ($ent = $ld->first_entry; $ent != 0; $ent = $ld->next_entry) { # # Get Full DN if (($dn = $ld->get_dn) eq "") { $ld->unbind; die "get_dn: ", $ld->errstring, ": ", $ld->extramsg; } # # Cycle Through Each Attribute for ($attr = $ld->first_attribute; $attr ne ""; $attr = $ld->next_attribute) { # # Notice that we're using get_values_len. This will retrieve binary # as well as text data. You can change to get_values to only get text # data. # @vals = $ld->get_values ($attr); $record{$dn}->{$attr} = [@vals]; } } $ld->msgfree; } if ($rc == LDAP_RES_SEARCH_RESULT && $ld->err != LDAP_SUCCESS) { $ld->unbind; die "result: ", $ld->errstring, ": ", $ld->extramsg; } print "Found $nentries records\n"; $ld->unbind; foreach $dn (keys %record) { my $item; print "dn: $dn\n"; foreach $attr (keys %{$record{$dn}}) { for $item ( @{$record{$dn}{$attr}}) { if ($attr =~ /binary/ ) { print "$attr: \n"; } elsif ($attr eq "jpegphoto") { # # Notice how easy it is to take a binary attribute and dump it to a file # or such. Gotta love PERL. # print "$attr: JpegPhoto (length: " . length($item). ")\n"; open (TEST,">$dn.jpg"); print TEST $item; close (TEST); } else { print "$attr: $item\n"; } } } } exit; sub rebindproc { return("","",LDAP_AUTH_SIMPLE); } net-ldapapi-3.0.7/examples/ldapwalk.pl000077500000000000000000000077501354766267100177260ustar00rootroot00000000000000#!/usr/bin/perl # # # ldapwalk.pl - Walks through Records Matching a Given Filter # Author: Clayton Donley, Motorola, # # Demonstration of Synchronous Searching in PERL5. # # Rather than printing attribute and values directly, they are # stored in a Hash, where further manipulation would be very simple. # The output could then be printed to a file or standard output, or # simply run through the modify or add commands. # # Usage: ldapwalk.pl FILTER # Example: ldapwalk.pl "sn=Donley" # use strict; use Net::LDAPapi; # Define these values my $ldap_server = "localhost"; my $BASEDN = "o=Org, c=US"; my $sizelimit = 100; # Set to Maximum Number of Entries to Return # Can set small to test error routines # Various Variable Declarations... my $ld; my $dn; my $attr; my $ent; my $ber; my @vals; my %record; my $result; # # Initialize Connection to LDAP Server if (($ld = new Net::LDAPapi($ldap_server)) == -1) { die "Unable to initialize!"; } #ldap_set_option(0,LDAP_OPT_DEBUG_LEVEL,-1); # # Bind as NULL User to LDAP connection $ld #$ld->sasl_parms(-mech=>"CRAM-MD5",-flags=>LDAP_SASL_AUTOMATIC); #if ($ld->bind_s("tester","tester",LDAP_AUTH_SASL) != LDAP_SUCCESS) if ($ld->bind_s != LDAP_SUCCESS) { my $errstr=$ld->errstring; $ld->unbind; die "bind: ", $errstr; } # This will set the size limit to $sizelimit from above. The command # is a Netscape addition, but I've programmed replacement versions for # other APIs. $ld->set_option(LDAP_OPT_SIZELIMIT,$sizelimit); # This routine is COMPLETELY unnecessary in this application, since # the rebind procedure at the end of this program simply rebinds as # a NULL user. #$ld->set_rebind_proc(&rebindproc); # # Specify Search Filter and List of Attributes to Return my $filter = $ARGV[0]; my @attrs = (); # # Perform Search my $msgid = $ld->search($BASEDN,LDAP_SCOPE_SUBTREE,$filter,\@attrs,0); if ($msgid < 0) { $ld->unbind; die "search: ", $ld->errstring, ": ", $ld->extramsg; } # Reset Number of Entries Counter my $nentries = 0; # Set no timeout. my $timeout = -1; # # Cycle Through Entries while (1) { $result = $ld->result($msgid, 0, $timeout); last unless $result; last if( $ld->{"status"} == $ld->LDAP_RES_SEARCH_RESULT ); next if( $ld->{"status"} != $ld->LDAP_RES_SEARCH_ENTRY ); $nentries++; for ($ent = $ld->first_entry; $ent != 0; $ent = $ld->next_entry) { # # Get Full DN if (($dn = $ld->get_dn) eq "") { $ld->unbind; die "get_dn: ", $ld->errstring, ": ", $ld->extramsg; } # # Cycle Through Each Attribute for ($attr = $ld->first_attribute; defined($attr); $attr = $ld->next_attribute) { # # Notice that we're using get_values_len. This will retrieve binary # as well as text data. You can change to get_values to only get text # data. # @vals = $ld->get_values_len($attr); $record{$dn}->{$attr} = [@vals]; } } $ld->msgfree; } if ( !defined($result) && $ld->err != LDAP_SUCCESS) { $ld->unbind; die "result: ", $ld->errstring, ": ", $ld->extramsg; } print "Found $nentries records\n"; $ld->unbind; foreach $dn (keys %record) { my $item; print "dn: $dn\n"; foreach $attr (keys %{$record{$dn}}) { for $item ( @{$record{$dn}{$attr}}) { if ($attr =~ /binary/ ) { print "$attr: \n"; } elsif ($attr eq "jpegphoto") { # # Notice how easy it is to take a binary attribute and dump it to a file # or such. Gotta love PERL. # print "$attr: JpegPhoto (length: " . length($item). ")\n"; open (TEST,">$dn.jpg"); print TEST $item; close (TEST); } else { print "$attr: $item\n"; } } } print "\n"; } exit; sub rebindproc { return("","",LDAP_AUTH_SIMPLE); } net-ldapapi-3.0.7/examples/ldapwalk2.pl000077500000000000000000000044521354766267100200040ustar00rootroot00000000000000#!/usr/bin/perl -w # # testwalk.pl - Walks through Records Matching a Given Filter # Author: Clayton Donley, Motorola, # # Demonstration of OO Style LDAP Calls Using Net::LDAPapi # # Similar to ldapwalk2.pl, only it uses the OO versions of the synchronous # functions to retrieve a hash containing the matching entries. # # Usage: testwalk.pl FILTER # Example: testwalk.pl "sn=Donley" # use strict; use Net::LDAPapi; # Define these values my $ldap_server = "localhost"; my $BASEDN = "o=Org, c=US"; my $sizelimit = 100; # Set to Maximum Number of Entries to Return # Can set small to test error routines # Various Variable Declarations my $ldcon; my $ld; my $filter; my $result; my %record; my $dn; my $item; my $attr; # Initialize Connection to LDAP Server if (($ldcon = new Net::LDAPapi($ldap_server)) == -1) { die "Unable to initialize!"; } if ($ldcon->bind_s != LDAP_SUCCESS) { die $ldcon->errstring; } $ldcon->set_option(LDAP_OPT_SIZELIMIT,$sizelimit); $ldcon->set_rebind_proc(\&rebindproc); # Specify what to Search For $filter = $ARGV[0]; # Perform Search if ($ldcon->search_s($BASEDN,LDAP_SCOPE_SUBTREE,$filter,[],0) != LDAP_SUCCESS) { print $ldcon->errstring . "\n"; die; } # Here we get a HASH of HASHes... All entries, keyed by DN and ATTRIBUTE. # # Since a reference is returned, we simply make %record contain the HASH # that the reference points to. %record = %{$ldcon->get_all_entries}; $ldcon->unbind; # We can sort our resulting DNs quite easily... my @dns = (sort keys %record); # Print the number of entries returned. print $#dns+1 . " entries returned.\n"; foreach $dn (@dns) { print "dn: $dn\n"; foreach $attr (keys %{$record{$dn}}) { for $item ( @{$record{$dn}{$attr}}) { if ($attr =~ /binary/) { print "$attr: binary - length=" . length($item) . "\n"; } elsif ($attr eq "jpegphoto") { # # Notice how easy it is to take a binary attribute and dump it to a file # or such. Gotta love PERL. # print "$attr: binary - length=" . length($item). "\n"; open (TEST,">$dn.jpg"); print TEST $item; close (TEST); } else { print "$attr: $item\n"; } } } } exit; sub rebindproc { return("","",LDAP_AUTH_SIMPLE); } net-ldapapi-3.0.7/examples/testurl.pl000077500000000000000000000034521354766267100176240ustar00rootroot00000000000000#!/usr/bin/perl -w # # testwrite.pl - Test of LDAP URL Operations in Perl5 # Author: Clayton Donley # # This script tests some of the basic LDAP URL functions. # Call the script with an LDAP URL to perform a search. use strict; use Net::LDAPapi; my $urlhref; my $url = $ARGV[0] || "ldap://ldap.four11.com/??sub?(cn=Clayton Donley)"; if (ldap_is_ldap_url($url)) { $urlhref = ldap_url_parse($url); } else { die "$url: Not an LDAP Url."; } if ($urlhref) { print "host: " . $urlhref->{'host'} . "\n"; print "port: " . $urlhref->{'port'} . "\n"; print "base: " . $urlhref->{'dn'} . "\n"; my $attr; foreach $attr (@{$urlhref->{'attr'}}) { print "attr: " . $attr . "\n"; } print "filter: " . $urlhref->{'filter'} . "\n"; print "scope: " . $urlhref->{'scope'} . "\n"; # If using Netscape, there is an options key specifying the use of SSL, etc... if ($urlhref->{'options'}) { print "options: " . $urlhref->{'options'} . "\n" } print "Connecting...\n"; my $port = $urlhref->{"port"} || 389; my $ld = new Net::LDAPapi(-host=>$urlhref->{"host"},-port=>$port); if ($ld == -1) { die "Connection failed..."; } $ld->bind_s; $ld->url_search_s($url,0); my %record = %{$ld->get_all_entries}; $ld->unbind; my @dns = (sort keys %record); print $#dns+1 . " entries returned.\n"; foreach my $dn (@dns) { print "dn: $dn\n"; foreach my $attr (keys %{$record{$dn}}) { foreach my $item (@{$record{$dn}{$attr}}) { if ($attr =~ /binary/) { print "$attr: binary - length=" . length($item) . "\n"; } else { print "$attr: $item\n"; } } } } } else { print "Invalid LDAP URL: $url\n"; } net-ldapapi-3.0.7/examples/testwrite.pl000077500000000000000000000027211354766267100201520ustar00rootroot00000000000000#!/usr/bin/perl -w # # testwrite.pl - Test of LDAP Modify Operations in Perl5 # Author: Clayton Donley # # This utility is mostly to demonstrate all the write operations # that can be done with LDAP through this PERL5 module. # use strict; use Net::LDAPapi; # This is the entry we will be adding. Do not use a pre-existing entry. my $ENTRYDN = "cn=New Guy, o=Org, c=US"; # This is the DN and password for an Administrator my $ROOTDN = "cn=root, o=Org, c=US"; my $ROOTPW = "abc123"; my $ldap_server = "localhost"; my $ld = new Net::LDAPapi($ldap_server); if ($ld == -1) { die "Connection to LDAP Server Failed"; } if ($ld->bind_s($ROOTDN,$ROOTPW) != LDAP_SUCCESS) { die $ld->errstring; } my %testwrite = ( "cn" => "Test User", "sn" => "User", "givenName" => "Test", "telephoneNumber" => "8475551212", "objectClass" => ["top","person","organizationalPerson", "inetOrgPerson"], "mail" => "tuser\@my.org", ); if ($ld->add_s($ENTRYDN,\%testwrite) != LDAP_SUCCESS) { die $ld->errstring; } print "Entry Added.\n"; %testwrite = ( "telephoneNumber" => "7085551212", "mail" => {"a",["Test_User\@my.org"]}, ); if ($ld->modify_s($ENTRYDN,\%testwrite) != LDAP_SUCCESS) { die $ld->errstring; } print "Entry Modified.\n"; exit; # # Delete the entry for $ENTRYDN # if ($ld->delete_s($ENTRYDN) != LDAP_SUCCESS) { die $ld->errstring; } print "Entry Deleted.\n"; # Unbind to LDAP server $ld->unbind; exit; net-ldapapi-3.0.7/examples/updatepw.pl000077500000000000000000000042371354766267100177550ustar00rootroot00000000000000#!/usr/bin/perl # # # updatepw.pl - Synchronize Passwords from Unix to LDAP # Author: Clayton Donley, Motorola, # # Reads in a password file, checks for existing entries matching # username@domain.com in the mail attribute and populates the CRYPTed # password from Unix into the userPassword attribute for that DN. # # Usage: updatepw.pl username username ... username # Example: updatepw.pl "donley" # use Net::LDAPapi; # Define these values $ldap_server = "localhost"; $PWFILE = "/etc/passwd"; $BASEDN = "o=Org, c=US"; $ROOTDN = "cn=Directory Manager, o=Org, c=US"; $ROOTPW = "abc123"; $MAILATTR = "mail"; $MYDOMAIN = "mycompany.com"; open(PASSWD,$PWFILE); while($line = ) { chop $line; ($user,$pass) = split(/:/,$line); $pwuser{$user} = $pass; } close(PASSWD); # Initialize Connection to LDAP Server if (($ld = new Net::LDAPapi($ldap_server)) == -1) { die "Cannot Open Connection to Server!"; } # Bind as the ROOT DIRECTORY USER to LDAP connection $ld if ($ld->bind_s($ROOTDN,$ROOTPW) != LDAP_SUCCESS) { die $ld->errstring; } # Specify what to Search For foreach $username (@ARGV) { # Perform Search $filter = "($MAILATTR=$username\@$MYDOMAIN)"; if ($ld->search_s($BASEDN,LDAP_SCOPE_SUBTREE,$filter,["uid","userpassword","mail"],0) != LDAP_SUCCESS) { $ld->unbind; die $ld->errstring; } # Here we get a HASH of HASHes... All entries, keyed by DN and ATTRIBUTE. # # Since a reference is returned, we simply make %record contain the HASH # that the reference points to. if ($ld->first_entry == 0) { print "Not Found: $username\@$MYDOMAIN\n"; } else { $dn = $ld->get_dn; @pass = $ld->get_values('userpassword'); if ($pass[0] ne "{CRYPT}$pwuser{$username}") { $modifyrec{"userpassword"} = [ "{CRYPT}$pwuser{$username}" ]; if ($ld->modify_s($dn,\%modifyrec) != LDAP_SUCCESS) { print "Error: $dn Unsuccessful.\n"; print "modify_s: $ld->errstring\n"; } print "Updated: $username\@$MYDOMAIN\n"; } else { print "Matched: $username\@$MYDOMAIN\n"; } } } $ld->unbind; exit; net-ldapapi-3.0.7/examples/web500.pl000077500000000000000000000733071354766267100171320ustar00rootroot00000000000000#!/usr/bin/perl # # web500.pl - Full featured LDAP directory SEARCH, MODIFY, DELETE, ADD # Web Interface, with Authentication. # # Author: Clayton Donley, Motorola # # Other Credits: # - textarea feature - Douglas Gray Stevens # Requires the CGI and Net::LDAPapi Modules use CGI qw(:standard :html3); use Net::LDAPapi; # Set to Local LDAP Server and Base DN $LDAP_SERVER = "localhost"; $LDAP_BASEDN = "o=Org,c=US"; # Set this to the name of the CGI on your web server $LDAPCGI_NAME = "/cgi-bin/web500.pl"; # This is the displayed title... $LDAPCGI_TITLE = "Directory Search and Update"; # If set to 0, new passwords will be stored PLAIN TEXT $LDAPCGI_CRYPT_PASS = 1; # This is the address that supports your LDAP server $LDAPCGI_HELP_MAIL = "help\@myorg.com"; # Do you allow users to change their own password? $LDAPCGI_ALLOW_CHPASS = 1; # Do you allow users to upload JPEG photos? $LDAPCGI_ALLOW_JPEGUL = 1; # Do you want to display Netscape VCARD Entries? $LDAPCGI_DISPLAY_VCARD = 0; # This is the default DN and PASSWORD to bind to the LDAP server when # a user hasn't authenticated. %ldap_default_auth = ( "dn", "", "pass", "", ); # %fields - Attribute Table used by all forms # Format: "Field Name" => ["Description",length,max_length,multiple,rows] # Field Name - Lower Case Attribute Name # Description - Name to display to the User # length - Length of Field on Screen # max_length - Maximum Length of Input # multiple - 1 to allow multiple values, 0 for single value # rows - Number of Rows to allow for entry. %fields = ( "cn" => ["Name",20,40,1,1], "givenname" => ["First Name",20,40,0,1], "sn" => ["Last Name",20,40,0,1], "uid" => ["UniqueID",10,15,0,1], "departmentnumber" => ["Department Number",10,25,0,1], "telephonenumber" => ["Telephone Number",30,50,1,1], "facsimiletelephonenumber" => ["Fax Number", 30,50,0,1], "pager" => ["Pager Number", 30,50,0,1], "mobile" => ["Mobile Number", 30,50,0,1], "labeleduri" => ["WWW Home Page", 40,100,0,1], "title" => ["Title", 40,100,0,1], "employeenumber" => ["Employee Number",10,25,0,1], "l" => ["City",30,50,0,1], "mail" => ["Email Address", 25,70,0,1], "postaladdress" => ["Postal Address", 30,200,0,5], ); # When searching for users, only obtain the following fields @searchuser_attributes = ("cn","givenname","sn","uid","telephonenumber", "facsimiletelephonenumber","mobile","pager","labeleduri","title","mail", "postaladdress","employeenumber","l","departmentnumber","jpegphoto"); @searchuser_onattr = ("cn","telephonenumber","uid", "postaladdress","mail", "title","departmentnumber","l"); # When adding users, the following attributes may be specified @adduser_attributes = ("givenname","sn","uid","departmentnumber","mail", "telephonenumber","facsimiletelephonenumber","pager","mobile","labeleduri", "title","employeenumber"); # When adding users, the following attributes MUST be given @adduser_required = ("sn","mail"); # When modifying users, the following attributes can be modified. @modifyuser_attributes = ("departmentnumber","telephonenumber","mail", "facsimiletelephonenumber","pager","mobile","labeleduri","title", "employeenumber","l","postaladdress"); # When displaying Organizations and Localities below the current point, use # this search filter. $DOWN_FILTER = "(|(objectclass=organization)(objectclass=organizationalunit)(objectclass=locality))"; # A List of Location or Organization Names that can be used to map people to # Certain parts of the Directory Tree. # Also used by the 'assign_next_uid' routine to assign UserIDs when doing # directory additions. You can replace that function with your own method # of assigning UIDs. %location = ( "Finance" => ["ou=Finance,o=Org,c=US","a","/usr/web/logs/nextid.fin"], "HR" => ["ou=HR, o=Org, c=US","b","/usr/web/logs/nextid.hr"], "IS" => ["ou=IS, o=Org, c=US","c","/usr/web/logs/nextid.is"], ); # @default_person_objectclass is the objectclasses assigned to new users @default_person_objectclass = ("top","person","organizationalperson","inetorgperson"); # $op will contain our current operation $op = param('op'); # $searchfor will contain YES if we've performed a search... $searchfor = param('searchfor'); # # Operations Requiring no LDAP Access, Binding, or Access Control # # Show the Authentication Screen &authenticate if $op =~ /authenticate/; # # Retrieve our Authentication Cookie and put it into our ldap_auth # hash. If there is no cookie, we use the default. # if (!cookie('ldap_auth_cookie')) { %ldap_auth = %ldap_default_auth; } else { %ldap_auth = cookie('ldap_auth_cookie'); } # # Open Our Connection to the LDAP Server...Only place in the whole program. # We use this $ld as the handle for all LDAP access. # $ld = ldap_open($LDAP_SERVER,LDAP_PORT); # # If these were passed, we have sent new authorization credentials. # Put these into our ldap_auth structure, or reset the structure to # the defaults if the word CLEAR is the UID. # if (param('ldap_myuid') && param('ldap_mypass')) { $ldap_myuid = param('ldap_myuid'); if ($ldap_myuid eq "CLEAR") { $ldap_auth{'pass'} = $ldap_default_auth{'pass'}; $ldap_auth{'dn'} = $ldap_default_auth{'dn'}; } else { $ldap_auth{'pass'} = param('ldap_mypass'); # Since the person supplied a UID, not the DN, we lookup the DN $ldap_auth{'dn'} = &get_my_dn($ldap_myuid); } } # # We now bind to the server using the specified DN and Password # if (ldap_simple_bind_s($ld,$ldap_auth{'dn'},$ldap_auth{'pass'}) != LDAP_SUCCESS) { &print_bad_auth; ldap_unbind($ld); exit; } # # Lets now build a cookie with our authentication information. The # cookie will expire if the browser does not reconnect (and thus resubmit # a new cookie) within the hour. # $ldap_auth_cookie = cookie( -name => 'ldap_auth_cookie', -value => \%ldap_auth, -path => $LDAPCGI_NAME, -expires => '+4h'); # # These two functions return NON-HTML mime-types, so we will go there # directly if necessary rather than send headers and such. # &view_jpegphoto if $op =~ /viewjpeg/; &view_vcard if $op =~ /viewvcard/; # # Print the headers and jump to the necessary operation # &print_html_headers; &print_options; &adduser_entry if $op =~ /adduser/; &moduser_entry if $op =~ /moduser/; &deluser_entry if $op =~ /deluser/; &viewuser_entry if $op =~ /viewuser/ || $op =~ /View Selected/; &searchuser_results if $op =~ /searchresult/ || $searchfor =~ /yes/; &help_screen if $op =~ /help/; # By default, display the search screen... &searchuser_entry; # We should NEVER get here, but I've left an unbind and an exit just # in case. All of the above subroutines should do EXITs, not RETURNs. ldap_unbind($ld); exit; #### # get_my_dn - Takes UID as argument and returns a matching DN #### sub get_my_dn { my ($uid) = @_; my $dn; if (ldap_simple_bind_s($ld,"","") != LDAP_SUCCESS) { &print_bad_auth; ldap_unbind($ld); exit; } $filter = "(uid=$uid)"; if (ldap_search_s($ld,$LDAP_BASEDN,LDAP_SCOPE_SUBTREE,$filter, ["uid"],1,$result) != LDAP_SUCCESS) { &print_error; ldap_unbind($ld); exit; } $ent = ldap_first_entry($ld,$result); if ($ent == 0) { &print_bad_auth; ldap_unbind($ld); exit; } $dn = ldap_get_dn($ld,$ent); } #### # print_bottom - Print bottom information #### sub print_bottom { print "Comments and Suggestions to:", "
$LDAPCGI_HELP_MAIL
\n",p; print "
$LDAPCGI_TITLE\n",br, "Written by Clayton Donley <", "donley\@cig.mot.com>\n",br, "Copyright © 1998 by Clayton Donley\n",br, "All Rights Reserved.
\n"; return; } #### # print_options - Print Top Options #### sub print_options { local $Flag; $Flag=0; print "
[SEARCH]"; if ($ldap_auth{'dn'} eq $ldap_default_auth{'dn'}) { print "[LOGIN] "; $Flag=1; } else { print "[LOGOUT] "; print "[CHANGE PASSWORD/INFO] "; print "[ADD] "; } print "[HELP]
",p; if ($Flag) { print "NOTE: Please LOGIN before you change password and other information.

"; } return; } #### # searchuser_entry - The main search screen #### sub searchuser_entry { # If 'my_base_dn' is passed, use it, otherwise use the default if (param('my_base_dn')) { $my_base_dn = param('my_base_dn'); } else { $my_base_dn = $LDAP_BASEDN; } # Get rid of extra spaces after commas. This probably isn't the # safest way to do this, but should be okay for now. $my_base_dn =~ s/,\s/,/g; # Now make sure that anything passed contains our default BASEDN, otherwise # 'my_base_dn' may not be useful. if ($my_base_dn !~ /$LDAP_BASEDN$/) { $my_base_dn = $LDAP_BASEDN; } # Splits the DN into segments. Netscape makes this easy with ldap_explode_dn, # but I have to do it manually because none of the other SDKs support it. # We're building a hash with all the levels above our own for use in the # popup_menu. @splitbase = split(/,/,$my_base_dn); @splitdefault = split(/,/,$LDAP_BASEDN); for ($count = 0; $count <= $#splitbase; $count++) { for ($base_count = $count; $base_count <= $#splitbase; $base_count++) { if ($count != $base_count) { $base_vals[$count] = $base_vals[$count] . ","; } $base_vals[$count] = $base_vals[$count] . $splitbase[$base_count]; } $shortname = $splitbase[$count]; $shortname =~ s/^.*=//; $basename{$base_vals[$count]} = $shortname; } # We don't want people to be able to go higher than the default level. $#base_vals = $#base_vals - $#splitdefault; # Now print the form with the query and the popup containing higher # levels within the LDAP tree. print "Current Search Base: $my_base_dn", start_form, hidden('op','searchresult'), hidden('searchfor','yes'), "Move Up To: ",popup_menu('my_base_dn',\@base_vals,$base_vals[0],\%basename),p; foreach $searchattr (@searchuser_onattr) { print textfield(-name=>"searchfor_$searchattr",-size=>50), $fields{$searchattr}[0],"\n",br; } print p,submit('Search'),reset('Reset'), end_form,p,"\n"; # This search will find all the organizations and localities one level below # our current level. This allows people to navigate downwards. if (ldap_search_s($ld,$my_base_dn,LDAP_SCOPE_ONELEVEL,$DOWN_FILTER,[],1,$result) != LDAP_SUCCESS) { &print_error; ldap_unbind($ld); exit; } print h3("Move Down To:\n"); print "
    \n"; $entrycount = 0; for ($ent=ldap_first_entry($ld,$result);$ent!=0;$ent=ldap_next_entry($ld,$ent)) { $entrycount = $entrycount + 1; $newbase = ldap_get_dn($ld,$ent); $subbase = $newbase; # We need to escape certain special characters. I'm sure there are more # than these, but this was all I could think of for now. $subbase =~ s/ /%20/g; $subbase =~ s/=/%3D/g; # We simply pass parameters that would change my_base_dn and continue searching print "
  • $newbase\n"; } if ($entrycount == 0) { print "
  • Nothing Below\n"; } print "
\n",hr; &print_bottom; ldap_unbind($ld); exit; } sub searchuser_results { $filter = ""; $noattrs = 0; foreach $searchattr (@searchuser_onattr) { if (param("searchfor_$searchattr")) { $noattrs++; $filter = $filter . "($searchattr=*" . param("searchfor_$searchattr") . "*)"; } } if ($filter ne "") { if ($noattrs > 1) { $fullfilter = "(&$filter)"; } else { $fullfilter = $filter; } } else { &searchuser_entry; } $my_base_dn = param('my_base_dn'); if (ldap_search_s($ld,$my_base_dn,LDAP_SCOPE_SUBTREE,$fullfilter,[],0,$result) != LDAP_SUCCESS) { ldap_perror($ld,"Search"); &print_error; ldap_unbind($ld); exit; } print h3("Results: Search of $my_base_dn for $fullfilter"); # We're going to display the results in a table so that they line-up # nicely. print start_form,"\n"; print "\n"; $entrycount = 0; # This for loop cycles through all the entries. for ($ent = ldap_first_entry($ld,$result); $ent != 0; $ent = ldap_next_entry($ld,$ent)) { $entrycount = $entrycount + 1; $fulldn = ldap_get_dn($ld,$ent); $realdn = $fulldn; # Once again, we're going to escape special characters $fulldn =~ s/ /%20/g; $fulldn =~ s/=/%3D/g; # In a later version I'll make these defined at the beginning, but # these are the fields for the short listing. @cn = ldap_get_values($ld,$ent,"cn"); @l = ldap_get_values($ld,$ent,"l"); @mail = ldap_get_values($ld,$ent,"mail"); @labeleduri = ldap_get_values($ld,$ent,"labeleduri"); @jpegphoto = ldap_get_values($ld,$ent,"jpegphoto"); # Each listing has a checkbox with the value of the person's DN print ""; # If the person has a 'labeleduri' field, make the person's CN a hyperlink # to their WWW page. if ($#labeleduri >= 0) { print ""; } else { print ""; } print ""; # If the person has a registered EMAIL address, display it and make it # a 'mailto' URL. if ($#mail >= 0) { print ""; } else { print ""; } # Allow full details of the user to be viewed. print ""; # Only display Modify and Delete options if we have authenticated. if ($ldap_auth{'dn'} ne $ldap_default_auth{'dn'}) { print ""; print ""; } # If we are displaying Netscape VCARDs, display that option. if ($LDAPCGI_DISPLAY_VCARD) { print ""; } # If the person has a Jpeg Photo, give an option to display it. if ($#jpegphoto >= 0) { print ""; } print "\n"; } print "
No.NameLocationEmail
",checkbox('selectdn',0,$realdn,$entrycount),"$cn[0]$cn[0]$l[0]$mail[0]View AllModifyDeleteView VcardView Photo
\n",p; if ($entrycount == 0) { print "No Matches\n",end_form,hr; } else { print submit("op","View Selected"),end_form,hr; } &print_bottom; ldap_unbind($ld); exit; } #### # Modify User #### sub moduser_entry { if ($ldap_auth{'dn'} eq $ldap_default_auth{'dn'}) { print "Please Authenticate."; ldap_unbind($ld); exit; } if (param('selectdn')) { $selectdn = param('selectdn'); } else { $selectdn = $ldap_auth{'dn'}; } print "Modifying: $selectdn",br; if (param('gomodifyit')) { &gomodifyit; } if (ldap_search_s($ld,$selectdn,LDAP_SCOPE_BASE,"objectclass=*",[],0,$result) != LDAP_SUCCESS) { &print_error; ldap_unbind($ld); exit; } $ent = ldap_first_entry($ld,$result); if ($ent == 0) { print "User Not Found...\n",p; ldap_unbind($ld); exit; } # Cycle through all attributes and place their values in a hash. for ($attr = ldap_first_attribute($ld,$ent,$ber); $attr; $attr = ldap_next_attribute($ld,$ent,$ber)) { @vals = ldap_get_values($ld,$ent,$attr); $record{$attr} = [ @vals ]; } # Draw up the Web Form print start_multipart_form, hidden('op','moduser'), hidden('selectdn',$selectdn), hidden('gomodifyit','yes'); print hr,""; # Password is a Special Case. Since it needs special processing, we # do not include it in %fields and thus request it separately. print " \n"; print " \n"; print "
New Password:",password_field('pass'),"
New Password (again):",password_field('pass2'),"
\n"; # Now cycle through all keys in %fields and construct the form for each # attribute to be modified through this page. foreach $key (@modifyuser_attributes) { $count = 0; for $value ( @{$record{$key}} ) { if ($count == 0) { print " "; } else { print " "; } # Sun 24-Aug-1997; Douglas Gray Stephens # Add option for textarea if ($fields{$key}[4]>1) { print " \n"; } else { print " \n"; } print hidden("$key.$count.orig",$value); $count++; } if ($fields{$key}[3] == 1 || $count == 0) { # Sun 24-Aug-1997; Douglas Gray Stephens # Add option for textarea if ($count == 0) { print " "; } else { print " "; } if ($fields{$key}[4]>1) { print " \n"; } else { print " \n"; } } print hidden($key,$count); } if ($LDAPCGI_ALLOW_JPEGUL) { print " \n"; print " "; } print "
" . $fields{$key}[0] . ":
",textarea("$key.$count",$value,$fields{$key}[4],$fields{$key}[1],"","wrap=virtual"),"
",textfield("$key.$count",$value,$fields{$key}[1],$fields{$key}[2]),"
" . $fields{$key}[0] . ":
",textarea("$key.$count",$value,$fields{$key}[4],$fields{$key}[1],"","wrap=virtual"),"
",textfield("$key.$count",$value,$fields{$key}[1],$fields{$key}[2]),"
Upload Photo (JPEG)", filefield('jpegphoto','',35,256),"
(Enter 'REMOVE' to delete current image)
",hr,submit('Modify Entry'), end_form,hr; &print_bottom; ldap_unbind($ld); exit; } #### # gomodifyit - Routine to actually do the User Modification #### sub gomodifyit { print hr; foreach $key (@modifyuser_attributes) { $change = 0; @vals = (); $realcount = 0; for ($count = 0; $count <= param($key); $count++) { if (param("$key.$count") ne "") { $vals[$realcount] = param("$key.$count"); $realcount++; } if (param("$key.$count.orig") ne param("$key.$count")) { $change = 1; } } if ($change == 1) { if ($#vals < 0) { $ldapmod{$key} = ""; } else { $ldapmod{$key} = [ @vals ]; } } } if ($LDAPCGI_ALLOW_CHPASS) { $pass = param("pass"); $pass2 = param("pass2"); if ($pass ne "") { if ($pass eq $pass2) { if ($LDAPCGI_CRYPT_PASS) { $chars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"; srand( time() ^ ($$ + ($$ << 15))); $salt = ""; for ($i = 0; $i <2; $i++) { $saltno = int rand length($chars); $mychar = substr($chars,$saltno,1); $salt = $salt . $mychar; } $encpass = crypt $pass, $salt; $ldapmod{'userpassword'} = "{CRYPT}" . $encpass; } else { $ldapmod{'userpassword'} = $pass; } if ($ldap_auth{'dn'} eq $selectdn) { print "NOTICE: You must Re-Authenticate to", " make other modifications.",p; } } else { print "WARNING: Passwords did NOT match (not changed)!",p; } } } if ($LDAPCGI_ALLOW_JPEGUL) { if (($filename = param('jpegphoto'))) { if ($filename =~ /^remove$/i) { $ldapmod{'jpegphoto'} = ""; } else { $jpegimg = ""; while (read($filename,$buffer,1024)) { $jpegimg = $jpegimg . $buffer; } $ldapmod{'jpegphoto'} = {"rb",[$jpegimg]}; } } } if (ldap_modify_s($ld,$selectdn,\%ldapmod) != LDAP_SUCCESS) { &print_error; ldap_unbind($ld); exit; } &post_modify_routine; print "Entry Modified...\n"; return; } #### # Add User #### sub adduser_entry { if ($ldap_auth{'dn'} eq $ldap_default_auth{'dn'}) { print "Please Authenticate."; ldap_unbind($ld); exit; } if (param('addit')) { &add_one_user; ldap_unbind($ld); exit; } @locations = sort keys %location; print start_form, hidden('op','adduser'), hidden('addit','yes'), hr, "", "\n", "\n", "
Password:",password_field('pass'),"
Password (again):",password_field('pass2'),"
",hr,""; foreach $key (@adduser_attributes) { print " "; if ($fields{$key}[4] > 1) { print " \n"; } else { print " \n"; } } print "
" . $fields{$key}[0] . ":",textarea("$key","",$fields{$key}[4],$fields{$key}[1],"","wrap=virtual"),"
",textfield("$key","",$fields{$key}[1],$fields{$key}[2]),"
Location:",radio_group('l',[@locations],$locations[0],'true'); print "
",hr,submit('Add'),reset('Reset'),end_form,hr; ldap_unbind($ld); exit; } #### # Routine to Add One User #### sub add_one_user { if (length(param('pass')) < 6) { print "Password must be at least 6 characters in length.\n"; return; } if (param('pass') ne param('pass2')) { print "Passwords did not match, please try again.\n"; return; } $pass = param('pass'); if ($LDAPCGI_CRYPT_PASS) { $chars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"; srand(time()^($$+($$<<15))); $salt = ""; for ($i = 0; $i <2; $i++) { $saltno = int rand length($chars); $mychar = substr($chars,$saltno,1); $salt = $salt . $mychar; } $encpass = crypt $pass, $salt; $ldapmod{'userpassword'} = "{CRYPT}" . $encpass; } else { $ldapmod{'userpassword'} = $pass; } foreach $key (@adduser_attributes) { if (param($key) ne "") { $ldapmod{$key} = param($key); } } foreach $key (@adduser_required) { if ($ldapmod{$key} eq "") { print "Missing Required Field: $key\n",p; ldap_unbind($ld); exit; } } $ldapmod{'objectclass'} = [ @default_person_objectclass ]; $l = param('l'); $ldapmod{'l'} = $l; if ($ldapmod{'uid'} eq "") { $ldapmod{'uid'} = &assign_next_uid($l); } &verify_unique; $cn = $ldapmod{'givenname'} . " " . $ldapmod{'sn'}; $uid = $ldapmod{'uid'}; $long_cn = $cn . "-" . $uid; $ldapmod{'cn'} = [ ($long_cn, $cn) ]; $add_dn = "cn=" . $long_cn . "," . $location{$l}[0]; if (ldap_add_s($ld,$add_dn,\%ldapmod) != LDAP_SUCCESS) { &print_error; ldap_unbind($ld); exit; } &post_add_routine; print "Entry Added...\n",p; print "DN: $add_dn\n",br; print "UID: $uid\n",p; return; } sub assign_next_uid { my ($loc) = $_; open(READNEXTID,$location{$l}[2]); $nextid = ; close (READNEXTID); chop $nextid; $uid = $location{$l}[1] . $nextid; open(WRITENEXTID,">$location{$l}[2]"); print WRITENEXTID $nextid+1 . "\n"; close(WRITENEXTID); return $uid; } #### # Delete User #### sub deluser_entry { $selectdn = param('selectdn'); if ($selectdn eq "") { print "Nothing to Delete.\n"; return; } print h3("Delete User: $selectdn"); if (!param('confirm')) { print start_form, hidden('op','deluser'), hidden('confirm','yes'), hidden('selectdn',$selectdn), "WARNING! This will PERMANENTLY remove the entry for:\n",p, $selectdn,p, "Please confirm or click BACK on your browser to cancel.\n",p, submit('Confirm'), end_form; ldap_unbind($ld); exit; } if (ldap_delete_s($ld,$selectdn) != LDAP_SUCCESS) { &print_error; ldap_unbind($ld); exit; } &post_delete_routine; print "DELETED!\n",p,hr; &print_bottom; ldap_unbind($ld); exit; } #### # Display Full User Entry #### sub viewuser_entry { @selectdn = param('selectdn'); foreach $currentdn (@selectdn) { if (ldap_search_s($ld,$currentdn,LDAP_SCOPE_BASE,"(objectclass=*)", \@searchuser_attributes,0,$results) != LDAP_SUCCESS) { &print_error; ldap_unbind($ld); exit; } $ent = ldap_first_entry($ld,$results); print h3("$currentdn"); print "\n"; for ($attr = ldap_first_attribute($ld,$ent,$ber); $attr ne ""; $attr = ldap_next_attribute($ld,$ent,$ber)) { if ($attr eq "jpegphoto") { $fulldn = $currentdn; $fulldn =~ s/ /%20/g; $fulldn =~ s/=/%3D/g; print "\n"; } else { @vals = ldap_get_values($ld,$ent,$attr); print ""; if ($fields{$attr}) { print ""; } else { print ""; } for ($count = 0; $count <= $#vals; $count++) { if ($attr eq "mail") { print ""; } elsif ($attr eq "labeleduri") { print ""; } else { $vals[$count] =~ s/\n/
/g; print ""; } } print "\n"; } } print "
$fields{$attr}[0]:$attr:$vals[$count]$vals[$count]$vals[$count]
\n",hr; } &print_bottom; ldap_unbind($ld); exit; } #### # Display jpegPhoto #### sub view_jpegphoto { # Print the image/jpeg Header print header('image/jpeg'); # $selectdn is our currently selected DN. $selectdn = param('selectdn'); # We perform a search for the 'jpegphoto' attribute. if (ldap_search_s($ld,$selectdn,LDAP_SCOPE_BASE,"objectclass=*", ['jpegphoto'],0,$result) != LDAP_SUCCESS) { &print_error; ldap_unbind($ld); exit; } # Only one entry should match. $ent = ldap_first_entry($ld,$result); # We use ldap_get_values_len, since jpegphoto is binary. @pics = ldap_get_values_len($ld,$ent,"jpegphoto"); # Print the picture data to STDOUT if it exists. if ($#pics >= 0) { print $pics[0]; } ldap_unbind($ld); exit; } #### # Print Authentication Form #### sub authenticate { print header; print start_html; print h2("Directory Authentication"); # Print the Authentication Form print start_form(-action=>"$LDAPCGI_NAME"), "Login: ",textfield('ldap_myuid'),p, "Password: ",password_field('ldap_mypass'),p, submit('Login'), end_form,hr; &print_bottom; exit; } #### # Print Basic HTML Headers, including Authentication Cookie #### sub print_html_headers { # Notice that we print the Cookie containing the authentication information. print header(-cookie=> $ldap_auth_cookie); print start_html($LDAPCGI_TITLE),h1($LDAPCGI_TITLE); # If the person has authenticated, let them know we know who they are. if ($ldap_auth{'dn'} ne $ldap_default_auth{'dn'}) { @splitdn = split(/,/,$ldap_auth{'dn'}); $name = $splitdn[0]; $name =~ s/.*=//; print "Welcome, $name!",hr; } } #### # Print the LDAP Error Message #### sub print_error { # ldap_get_lderrno is a Netscape SDK call, but I've made a dummy version # for the PERL module, as we need some way to get the numerical error code. $lderr = ldap_get_lderrno($ld,$blah1,$blah2); $errmsg = ldap_err2string($lderr); print p,"\nError: $errmsg\n",p,hr; &print_bottom; return; } sub help_screen { print "Online Help is Net Yet Implemented.",p,hr; &print_bottom; exit; } sub print_bad_auth { print header; print start_html("Login/Password Incorrect"); print h1("Login/Password Incorrect"); print "Please Authenticate again.\n",p,hr; &print_bottom; return; } ###### # post_*_routine is used for any actions you want to perform after doing # any of these functions. Useful for email/logging and synchronization # purposes that you may have. ###### sub post_add_routine { return; } sub post_modify_routine { return; } sub post_delete_routine { return; } net-ldapapi-3.0.7/examples/www-ldap.pl000077500000000000000000000214061354766267100176630ustar00rootroot00000000000000#!/usr/bin/perl # # www-ldap.pl - CGI script to allow users with passwords to authenticate # and modify their own accounts on an LDAP server. # # Requires: PERL5 LDAP Module # CGI.pm Module # # Author: Clayton Donley # use CGI qw(:standard); use Net::LDAPapi; # # These are the only lines you should need to change for normal # operation. You'll need to change part of the &bind subroutine if # you don't use 'uid' as your unique identifier. # $BASEDN = "o=Org, c=US"; # Set to your top level $ldap_server = "localhost"; # Set to your LDAP server $problem_mail = "root\@localhost"; # Set to a help desk mail address $program_url = "/cgi-bin/www-ldap.pl"; # URL for this program # The layout for the %field hash is as followed: # # "attribute",["Description", display_length, max_length, multiple], # # attribute -> Lower Case Attribute Name # Description -> Description of Field for End User # display_length -> Number of Columns to Display for Attribute # max_length -> Most Characters to Accept for Attribute # multiple -> 1 = Multiple Value Attribute, 0 = Single Value Attributes %field = ( "departmentnumber",["Department Number", 10,25,0], "telephonenumber",["Telephone Number", 30, 50,1], "facsimiletelephonenumber",["Fax Number", 30, 50,0], "pager",["Pager Number", 30, 50,0], "mobile",["Mobile Number", 30, 50,0], "labeleduri",["WWW Home Page", 50, 100,1], "title",["Title",50,100,0], "employeenumber",["Employee Number",10,25,0], "l",["City",30,50,0], ); # END OF SUGGESTED MODIFICATION AREA print header; if (!param()) { &web_authenticate; &byline; exit; } else { $ldap_bind_uid = param('login'); $ldap_bind_password = param('password'); if ($ldap_bind_uid ne "" && $ldap_bind_password ne "") { if (&bind < 0) { &incorrect_login; } } else { &incorrect_login; } &modify_screen; $ld->unbind; &byline; exit; } sub byline { print hr,"LDAP Account Management Tool by Clayton Donley\n",p; return; } sub incorrect_login { print start_html('Invalid Username or Password'), h1('Invalid Username or Password'), "The Login or Password you supplied was incorrect. Please ", "click HERE and try again.\n"; exit; } sub web_authenticate { print start_html('LDAP Account Maintenance'), h1('LDAP Account Maintenance'), "For Problems with this service, please email $problem_email.",hr, start_form, "Login: ",textfield('login'), p, "Password: ",password_field('password'), p, submit('Login'), end_form; } sub bind { # First initialize our connection to the LDAP Server and bind anonymously. $ld = new Net::LDAPapi($ldap_server); if ($ld->bind_s != LDAP_SUCCESS) { print "Error: Unable to Bind Anonymously to the Directory.",p; print "bind_s: $ld->errstring\n"; $ld->unbind; return; } # Since we've entered our UID, not our CN, we must first find the DN of a # person who matches the UID in $ldap_bind_uid @attrs = ("cn"); $filter = "(uid=$ldap_bind_uid)"; if ($ld->search_s($BASEDN,LDAP_SCOPE_SUBTREE,$filter,\@attrs,1) != LDAP_SUCCESS) { print "Error: Unable to Search Directory.",p; print "search_s: $ld->errstring\n"; $ld->unbind; exit -1; } # Obtain a pointer to the first entry matching our query. We are making the # assumption that since UID means Unique ID that this is the only time we # need to do this. $ld->first_entry; if ($ent != 0) { # We only need the DN from the entry we matched. $dn = $ld->get_dn; # Attempt to bind with the DN and Password supplied previously. if ($ld->bind_s($dn,$ldap_bind_password) != LDAP_SUCCESS) { $ld->unbind; return -1; # Return Failure } return 0; # Return Success } $ld->unbind; return -1; # Return Failure } sub modify_screen { # Print WWW Header print start_html("LDAP Account Management for '$ldap_bind_uid'"), h1("LDAP Account Management for: '$ldap_bind_uid'"); # If we've just made changes, jump to the Modify routine. if (param('gomodifyit')) { &gomodifyit; } # Find values for all attributes. Should probably change this. @attrs = (); # Set the query filter to be the userid specified previously $filter = "(uid=$ldap_bind_uid)"; # Perform Synchronous LDAP Search if ($ld->search_s($dn,LDAP_SCOPE_BASE,$filter,\@attrs,0) != LDAP_SUCCESS) { print "search_s: $ld->errstring\n",p; print "Error: Unable to Search.\n"; exit; } # Since we queried within a specific DN, we will get only 1 match...Put # a pointer to that match in $ent $ld->first_entry; # This should never happen in normal use... if ($ent == 0) { print "User Not Found...\n",p; return; } # Cycle through all attributes and place their values in a hash. for ($attr = $ld->first_attribute; $attr; $attr = $ld->next_attribute) { @vals = $ld->get_values($attr); $record{$attr} = [ @vals ]; } # Draw up the Web Form print start_form, hidden('login',param('login')), hidden('password',param('password')), hidden('gomodifyit','yes'); print hr,""; # Password is a Special Case. Since it needs special processing, we # do not include it in %fields and thus request it separately. print " \n"; print " \n"; print "
New Password:",password_field('pass'),"
New Password (again):",password_field('pass2'),"
\n"; # Now cycle through all keys in %field and construct the form for each # attribute to be modified through this page. foreach $key (sort keys %field) { $count = 0; for $value ( @{$record{$key}} ) { if ($count == 0) { print " "; } else { print " "; } print " \n"; print hidden("$key.$count.orig",$value); $count++; } if ($field{$key}[3] == 1 || $count == 0) { if ($count == 0) { print " "; } else { print " "; } print "\n"; } print hidden($key,$count); } print "
" . $field{$key}[0] . ":
",textfield("$key.$count",$value,$field{$key}[1],$field{$key}[2]),"
" . $field{$key}[0] . ":
",textfield("$key.$count","",$field{$key}[1],$field{$key}[2]),"
",hr, submit('Modify Entry'), end_form; return; } # # Routine to actually modify an LDAP entry. Must have already used the # &bind subroutine to bind to the server. # sub gomodifyit { print hr; # Build a hash of arrays for the LDAP Modification foreach $key (sort keys %field) { $change = 0; @vals = (); $realcount = 0; for ($count = 0; $count <= param($key); $count++) { if (param("$key.$count") ne "") { $vals[$realcount] = param("$key.$count"); $realcount++; } if (param("$key.$count.orig") ne param("$key.$count")) { $change = 1; } } # If there is no values, pass an empty scalar. if ($change == 1) { if ($#vals < 0) { $ldapmod{$key} = ""; } else { $ldapmod{$key} = [ @vals ]; } } } # Lets Check the Password... If non-empty, encrypt and add to %ldapmod $pass = param("pass"); $pass2 = param("pass2"); if ($pass eq "") { } else { if ($pass eq $pass2) { # Encrypt as necessary... if ($ENCRYPT_PASS == 1) { $chars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"; # Seeding with time and proccess id is not normally recommended, but we're # only generating the salt, not the password. srand( time() ^ ($$ + ($$ << 15)) ); $salt = ""; for ($i = 0; $i <2; $i++) { $saltno = int rand length($chars); $mychar = substr($chars,$saltno,1); $salt = $salt . $mychar; } $pass = crypt $pass, $salt; } $ldapmod{'userPassword'} = "{CRYPT}" . $pass; print "Warning: Click HERE and login using your new password if you plan to make other changes...\n",p; } else { print "Warning: Passwords Did Not Match...Not Changed...\n",p; } } # Perform a synchronous MODIFY operation on our $dn @change_keys = keys %ldapmod; if ($#change_keys >= 0) { if ($ld->modify_s($dn,\%ldapmod) != LDAP_SUCCESS) { print "\n",p,"Error: Unable to Modify Entry...\n",p; print "modify_s: $ld->errstring\n"; exit; } # Success! print "Entry Modified...\n"; return; } else { print "No Changes Made...\n"; } } net-ldapapi-3.0.7/ldap_compat.h000066400000000000000000000013501354766267100163730ustar00rootroot00000000000000/****************************************************************************/ /* ldap_compat.h - Header file to add ldap_*_option support and other */ /* Functions to NON-Mozilla Development Kits. */ /* Author: Clayton Donley - donley@wwa.com */ /* Date: Tue Aug 26 13:13:32 CDT 1997 */ /****************************************************************************/ #define ldap_memfree(x) Safefree(x) /* * OpenLDAP already defines these macros */ #ifndef OPENLDAP #define LDAP_OPT_DEREF 2 #define LDAP_OPT_SIZELIMIT 3 #define LDAP_OPT_TIMELIMIT 4 #define LDAP_OPT_REFERRALS 8 #define LDAP_OPT_ON 1 #define LDAP_OPT_OFF 0 #endif net-ldapapi-3.0.7/t/000077500000000000000000000000001354766267100142035ustar00rootroot00000000000000net-ldapapi-3.0.7/t/01-bdd-cucumber.t000066400000000000000000000020651354766267100171450ustar00rootroot00000000000000#!/usr/bin/perl BEGIN { require './t/test-config.pl'; if (!$RunDeveloperTests) { print "1..0 # Skipped: Developer tests are not enabled"; exit; } }; use strict; use warnings; use Devel::Cover; use Test::More; # This will find step definitions and feature files in the directory you point # it at below use Test::BDD::Cucumber::Loader; # This harness prints out nice TAP use Test::BDD::Cucumber::Harness::TestBuilder; # Load a directory with Cucumber files in it. It will recursively execute any # file matching .*_steps.pl as a Step file, and .*\.feature as a feature file. # The features are returned in @features, and the executor is created with the # step definitions loaded. my ( $executor, @features ) = Test::BDD::Cucumber::Loader->load( 't/features/' ); # Create a Harness to execute against. TestBuilder harness prints TAP my $harness = Test::BDD::Cucumber::Harness::TestBuilder->new({}); # For each feature found, execute it, using the Harness to print results $executor->execute( $_, $harness ) for @features; done_testing(); net-ldapapi-3.0.7/t/features/000077500000000000000000000000001354766267100160215ustar00rootroot00000000000000net-ldapapi-3.0.7/t/features/add.feature000066400000000000000000000021011354766267100201200ustar00rootroot00000000000000Feature: Adding entries to the directory As a directory consumer I want to ensure that I can add entries to the directory In order to store information Background: Given a usable Net::LDAPapi class Scenario: Can add a new entry to the directory Given a Net::LDAPapi object that has been connected to the LDAP server When I've bound with default authentication to the directory And a test container has been created And I've added a new entry to the directory Then the new entry result is LDAP_SUCCESS And the test container has been deleted Scenario: Can asynchronously add a new entry to the directory Given a Net::LDAPapi object that has been connected to the LDAP server When I've asynchronously bound with default authentication to the directory And a test container has been created And I've asynchronously added a new entry to the directory Then after waiting for all results, the new entry result message type is LDAP_RES_ADD And the new entry result is LDAP_SUCCESS And the test container has been deleted net-ldapapi-3.0.7/t/features/bind.feature000066400000000000000000000033731354766267100203200ustar00rootroot00000000000000Feature: Binding to the directory As a directory consumer I want to ensure that I can bind properly to directories In order to establish my identity Background: Given a usable Net::LDAPapi class Scenario: Can bind anonymously Given a Net::LDAPapi object that has been connected to the LDAP server When I've bound with anonymous authentication to the directory Then the bind result is LDAP_SUCCESS Scenario: Can bind with simple authentication Given a Net::LDAPapi object that has been connected to the LDAP server When I've bound with simple authentication to the directory Then the bind result is LDAP_SUCCESS Scenario: Can bind with sasl authentication Given a Net::LDAPapi object that has been connected to the ldapi LDAP server When I've bound with sasl authentication to the directory Then the bind result is LDAP_SUCCESS Scenario: Can asynchronously bind anonymously Given a Net::LDAPapi object that has been connected to the LDAP server When I've asynchronously bound with anonymous authentication to the directory Then the bind result message type is LDAP_RES_BIND And the bind result is LDAP_SUCCESS Scenario: Can asynchronously bind with simple authentication Given a Net::LDAPapi object that has been connected to the LDAP server When I've asynchronously bound with simple authentication to the directory Then the bind result message type is LDAP_RES_BIND And the bind result is LDAP_SUCCESS # Scenario: Can asynchronously bind with sasl authentication # Given a Net::LDAPapi object that has been connected to the ldapi LDAP server # When I've asynchronously bound with sasl authentication to the directory # Then the bind result message type is LDAP_RES_BIND # And the bind result is LDAP_SUCCESS net-ldapapi-3.0.7/t/features/compare.feature000066400000000000000000000030371354766267100210270ustar00rootroot00000000000000Feature: Comparing values to values of attributes of entries within the directory As a directory consumer I want to ensure that I can test the value of an attribute on an entry within the directory In order to perform simple comparisons Background: Given a usable Net::LDAPapi class Scenario: Can compare an attribute on an entry within the directory Given a Net::LDAPapi object that has been connected to the LDAP server When I've bound with default authentication to the directory And a test container has been created And I've added a new entry to the directory And I've compared to an attribute on the new entry Then the new entry result is LDAP_SUCCESS And the new entry comparison result is LDAP_COMPARE_TRUE And the test container has been deleted Scenario: Can asynchronously compare an attribute on an entry within the directory Given a Net::LDAPapi object that has been connected to the LDAP server When I've asynchronously bound with default authentication to the directory And a test container has been created And I've asynchronously added a new entry to the directory And I've asynchronously compared to an attribute on the new entry Then after waiting for all results, the new entry result message type is LDAP_RES_ADD And the new entry result is LDAP_SUCCESS And after waiting for all results, the new entry comparison result message type is LDAP_RES_COMPARE And the new entry comparison result is LDAP_COMPARE_TRUE And the test container has been deleted net-ldapapi-3.0.7/t/features/delete.feature000066400000000000000000000026111354766267100206400ustar00rootroot00000000000000Feature: Deleting entries from the directory As a directory consumer I want to ensure that I can delete entries from the directory In order to remove information Background: Given a usable Net::LDAPapi class Scenario: Can remove an entry from the directory Given a Net::LDAPapi object that has been connected to the LDAP server When I've bound with default authentication to the directory And a test container has been created And I've added a new entry to the directory And I've deleted the new entry from the directory Then the new entry result is LDAP_SUCCESS And the delete entry result is LDAP_SUCCESS And the test container has been deleted Scenario: Can asynchronously remove an entry from the directory Given a Net::LDAPapi object that has been connected to the LDAP server When I've asynchronously bound with default authentication to the directory And a test container has been created And I've asynchronously added a new entry to the directory And I've asynchronously deleted the new entry from the directory Then after waiting for all results, the new entry result message type is LDAP_RES_ADD And the new entry result is LDAP_SUCCESS And after waiting for all results, the delete entry result message type is LDAP_RES_DELETE And the delete entry result is LDAP_SUCCESS And the test container has been deleted net-ldapapi-3.0.7/t/features/extended_operations.feature000066400000000000000000000056471354766267100234550ustar00rootroot00000000000000Feature: Executing extended operations against the directory As a directory consumer I want to ensure that I can execute extended operations against the directory In order to use arbitrary LDAPv3 extensions Background: Given a usable Net::LDAPapi class Scenario: Can match identities retrieved with native whoami and using extended operations with anonymous authentication Given a Net::LDAPapi object that has been connected to the LDAP server When I've bound with anonymous authentication to the directory And I've queried the directory for my identity And I've issued a whoami extended operation to the directory Then the identity result is LDAP_SUCCESS And the whoami extended operation result is LDAP_SUCCESS And the identity matches And the whoami extended operation matches Scenario: Can match identities retrieved with native whoami and using extended operations with simple authentication Given a Net::LDAPapi object that has been connected to the LDAP server When I've bound with simple authentication to the directory And I've queried the directory for my identity And I've issued a whoami extended operation to the directory Then the identity result is LDAP_SUCCESS And the whoami extended operation result is LDAP_SUCCESS And the identity matches And the whoami extended operation matches Scenario: Can asynchronously match identities retrieved with native whoami and using extended operations with anonymous authentication Given a Net::LDAPapi object that has been connected to the LDAP server When I've asynchronously bound with anonymous authentication to the directory And I've asynchronously queried the directory for my identity And I've asynchronously issued a whoami extended operation to the directory Then after waiting for all results, the identity result message type is LDAP_RES_EXTENDED And the identity result is LDAP_SUCCESS And after waiting for all results, the whoami extended operation result message type is LDAP_RES_EXTENDED And the whoami extended operation result is LDAP_SUCCESS And the identity matches And the whoami extended operation matches Scenario: Can asynchronously match identities retrieved with native whoami and using extended operations with simple authentication Given a Net::LDAPapi object that has been connected to the LDAP server When I've asynchronously bound with simple authentication to the directory And I've asynchronously queried the directory for my identity And I've asynchronously issued a whoami extended operation to the directory Then after waiting for all results, the identity result message type is LDAP_RES_EXTENDED And the identity result is LDAP_SUCCESS And after waiting for all results, the whoami extended operation result message type is LDAP_RES_EXTENDED And the whoami extended operation result is LDAP_SUCCESS And the identity matches And the whoami extended operation matches net-ldapapi-3.0.7/t/features/modify.feature000066400000000000000000000110571354766267100206710ustar00rootroot00000000000000Feature: Updating attributes of entries within the directory As a directory consumer I want to ensure that I can adjust attributes on entries within the directory In order to extend or update entries with new or updated information Background: Given a usable Net::LDAPapi class Scenario: Can add a new attribute to an entry within the directory Given a Net::LDAPapi object that has been connected to the LDAP server When I've bound with default authentication to the directory And a test container has been created And I've added a new entry to the directory And I've added a new attribute to the new entry Then the new entry result is LDAP_SUCCESS And the new attribute result is LDAP_SUCCESS And the test container has been deleted Scenario: Can modify an attribute on an entry within the directory Given a Net::LDAPapi object that has been connected to the LDAP server When I've bound with default authentication to the directory And a test container has been created And I've added a new entry to the directory And I've added a new attribute to the new entry And I've modified the new attribute on the new entry Then the new entry result is LDAP_SUCCESS And the new attribute result is LDAP_SUCCESS And the modified attribute result is LDAP_SUCCESS And the test container has been deleted Scenario: Can remove an attribute on an entry within the directory Given a Net::LDAPapi object that has been connected to the LDAP server When I've bound with default authentication to the directory And a test container has been created And I've added a new entry to the directory And I've added a new attribute to the new entry And I've removed the new attribute from the new entry Then the new entry result is LDAP_SUCCESS And the new attribute result is LDAP_SUCCESS And the removed attribute result is LDAP_SUCCESS And the test container has been deleted Scenario: Can asynchronously add a new attribute to an entry within the directory Given a Net::LDAPapi object that has been connected to the LDAP server When I've asynchronously bound with default authentication to the directory And a test container has been created And I've asynchronously added a new entry to the directory And I've asynchronously added a new attribute to the new entry Then after waiting for all results, the new entry result message type is LDAP_RES_ADD And the new entry result is LDAP_SUCCESS And after waiting for all results, the new attribute result message type is LDAP_RES_MODIFY And the new attribute result is LDAP_SUCCESS And the test container has been deleted Scenario: Can asynchronously modify an attribute on an entry within the directory Given a Net::LDAPapi object that has been connected to the LDAP server When I've asynchronously bound with default authentication to the directory And a test container has been created And I've asynchronously added a new entry to the directory And I've asynchronously added a new attribute to the new entry And I've asynchronously modified the new attribute on the new entry Then after waiting for all results, the new entry result message type is LDAP_RES_ADD And the new entry result is LDAP_SUCCESS And after waiting for all results, the new attribute result message type is LDAP_RES_MODIFY And the new attribute result is LDAP_SUCCESS And after waiting for all results, the modified attribute result message type is LDAP_RES_MODIFY And the modified attribute result is LDAP_SUCCESS And the test container has been deleted Scenario: Can asynchronously remove an attribute on an entry within the directory Given a Net::LDAPapi object that has been connected to the LDAP server When I've asynchronously bound with default authentication to the directory And a test container has been created And I've asynchronously added a new entry to the directory And I've asynchronously added a new attribute to the new entry And I've asynchronously removed the new attribute from the new entry Then after waiting for all results, the new entry result message type is LDAP_RES_ADD And the new entry result is LDAP_SUCCESS And after waiting for all results, the new attribute result message type is LDAP_RES_MODIFY And the new attribute result is LDAP_SUCCESS And after waiting for all results, the removed attribute result message type is LDAP_RES_MODIFY And the removed attribute result is LDAP_SUCCESS And the test container has been deleted net-ldapapi-3.0.7/t/features/options.feature000066400000000000000000000010141354766267100210650ustar00rootroot00000000000000Feature: Control of options used to configure the LDAP library As a directory consumer I want to ensure that I can control the options that are used to configure the LDAP client library In order to alter behaviour according to my needs Background: Given a usable Net::LDAPapi class Scenario: Can set and read back options Given a Net::LDAPapi object that has been connected to the LDAP server When I've set option LDAP_OPT_SIZELIMIT with value 200 Then option LDAP_OPT_SIZELIMIT has value 200 net-ldapapi-3.0.7/t/features/rename.feature000066400000000000000000000033121354766267100206440ustar00rootroot00000000000000Feature: Renaming entries within the directory As a directory consumer I want to ensure that I can rename entries within the directory In order to reorganise information Background: Given a usable Net::LDAPapi class Scenario: Can rename an entry within the directory Given a Net::LDAPapi object that has been connected to the LDAP server When I've bound with default authentication to the directory And a test container has been created And I've added a new entry to the directory And I've added a new container to the directory And I've moved the new entry to the new container Then the new entry result is LDAP_SUCCESS And the new container result is LDAP_SUCCESS And the rename entry result is LDAP_SUCCESS And the test container has been deleted Scenario: Can asynchronously rename an entry within the directory Given a Net::LDAPapi object that has been connected to the LDAP server When I've asynchronously bound with default authentication to the directory And a test container has been created And I've asynchronously added a new entry to the directory And I've asynchronously added a new container to the directory And I've asynchronously moved the new entry to the new container Then after waiting for all results, the new entry result message type is LDAP_RES_ADD And the new entry result is LDAP_SUCCESS And after waiting for all results, the new container result message type is LDAP_RES_ADD And the new container result is LDAP_SUCCESS And after waiting for all results, the rename entry result message type is LDAP_RES_MODDN And the rename entry result is LDAP_SUCCESS And the test container has been deleted net-ldapapi-3.0.7/t/features/search.feature000066400000000000000000000103251354766267100206440ustar00rootroot00000000000000Feature: Searching the directory As a directory consumer I want to ensure that I can search the directory In order to find relevant entries Background: Given a usable Net::LDAPapi class Scenario: Can find objects that exist within the directory Given a Net::LDAPapi object that has been connected to the LDAP server When I've bound with default authentication to the directory And I've searched for records with scope LDAP_SCOPE_SUBTREE Then the search result is LDAP_SUCCESS And the search count matches Scenario: Can asynchronously find objects that exist within the directory Given a Net::LDAPapi object that has been connected to the LDAP server When I've asynchronously bound with default authentication to the directory And I've asynchronously searched for records with scope LDAP_SCOPE_SUBTREE Then after waiting for all results, the search result message type is LDAP_RES_SEARCH_RESULT And the search result is LDAP_SUCCESS And the search count matches Scenario: Can find objects that exist within the directory with a timeout Given a Net::LDAPapi object that has been connected to the LDAP server When I've bound with default authentication to the directory And I've searched for records with scope LDAP_SCOPE_SUBTREE, with timeout 1 Then the search result is LDAP_SUCCESS And the search count matches Scenario: Can asynchronously find objects that exist within the directory with a timeout Given a Net::LDAPapi object that has been connected to the LDAP server When I've asynchronously bound with default authentication to the directory And I've asynchronously searched for records with scope LDAP_SCOPE_SUBTREE, with timeout 1 Then after waiting for all results, the search result message type is LDAP_RES_SEARCH_RESULT And the search result is LDAP_SUCCESS And the search count matches Scenario: Can find objects that exist with the directory and iterate them with next_entry and next_attribute Given a Net::LDAPapi object that has been connected to the LDAP server When I've bound with default authentication to the directory And I've searched for records with scope LDAP_SCOPE_SUBTREE Then the search result is LDAP_SUCCESS And the search count matches And using next_entry for each entry returned the dn and all attributes using next_attribute are valid Scenario: Can find objects that exist with the directory and iterate them with next_entry and entry_attribute Given a Net::LDAPapi object that has been connected to the LDAP server When I've bound with default authentication to the directory And I've searched for records with scope LDAP_SCOPE_SUBTREE Then the search result is LDAP_SUCCESS And the search count matches And using next_entry for each entry returned the dn and all attributes using entry_attribute are valid Scenario: Can find objects that exist with the directory and iterate them with result_entry and next_attribute Given a Net::LDAPapi object that has been connected to the LDAP server When I've bound with default authentication to the directory And I've searched for records with scope LDAP_SCOPE_SUBTREE Then the search result is LDAP_SUCCESS And the search count matches And using result_entry for each entry returned the dn and all attributes using next_attribute are valid Scenario: Can find objects that exist with the directory and iterate them with result_entry and entry_attribute Given a Net::LDAPapi object that has been connected to the LDAP server When I've bound with default authentication to the directory And I've searched for records with scope LDAP_SCOPE_SUBTREE Then the search result is LDAP_SUCCESS And the search count matches And using result_entry for each entry returned the dn and all attributes using entry_attribute are valid Scenario: Can find objects that exist with the directory and read them all at once Given a Net::LDAPapi object that has been connected to the LDAP server When I've bound with default authentication to the directory And I've searched for records with scope LDAP_SCOPE_SUBTREE Then the search result is LDAP_SUCCESS And the search count matches And using get_all_entries for each entry returned the dn and all attributes are valid net-ldapapi-3.0.7/t/features/server_controls.feature000066400000000000000000000021411354766267100226250ustar00rootroot00000000000000Feature: Using server controls to control results As a directory consumer I want to ensure that I can use server controls when querying the directory In order to be able to utilise the extended features of my directory Background: Given a usable Net::LDAPapi class Scenario: Can use the Server Side Sort control and Virtual List View Control Given a Net::LDAPapi object that has been connected to the LDAP server And the server side sort control definition And the virtual list view control definition When I've bound with default authentication to the directory And I've created a server side sort control And I've created a virtual list view control And I've searched for records with scope LDAP_SCOPE_SUBTREE, with server controls server side sort and virtual list view Then the search result is LDAP_SUCCESS And the search count matches And using next_entry for each entry returned the dn and all attributes using next_attribute are valid And the server side sort control was successfully used And the virtual list view control was successfully used net-ldapapi-3.0.7/t/features/step_definitions/000077500000000000000000000000001354766267100213675ustar00rootroot00000000000000net-ldapapi-3.0.7/t/features/step_definitions/add_steps.pl000066400000000000000000000015101354766267100236670ustar00rootroot00000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::BDD::Cucumber::StepFile; our %TestConfig = %main::TestConfig; use Data::Dumper; When qr/I've (asynchronously )?added a new (entry|container) to the directory/i, sub { my $async = $1 ? 1 : 0; my $type = lc($2); S->{'new ' . $type . '_result'} = 'skipped'; return if S->{'bind_result'} eq 'skipped'; my $func = 'add_ext_s'; my %args = (); if ($async) { $func = 'add_ext'; } S->{'new ' . $type . '_async'} = $async; $args{'-dn'} = sprintf('%s,%s,%s', $TestConfig{'data'}{$type . '_dn'}, $TestConfig{'data'}{'test_container_dn'}, $TestConfig{'ldap'}{'base_dn'}); $args{'-mod'} = $TestConfig{'data'}{$type . '_attributes'}; S->{'new ' . $type . '_result'} = S->{'object'}->$func(%args); }; 1; net-ldapapi-3.0.7/t/features/step_definitions/bind_steps.pl000066400000000000000000000024051354766267100240570ustar00rootroot00000000000000#!/usr/bin/perl use strict; use warnings; #use Net::LDAPapi; use Test::More; use Test::BDD::Cucumber::StepFile; our %TestConfig = %main::TestConfig; When qr/I've (asynchronously )?bound with (.+?) authentication to the directory/, sub { my $async = $1 ? 1 : 0; my $type = lc($2); my $func = "bind_s"; my %args = (); if ($async) { $func = "bind"; } S->{'bind_async'} = $async; if ($type eq "default") { $type = lc($TestConfig{'ldap'}{'default_bind_type'}); } S->{'bind_type'} = $type; S->{'bind_result'} = "skipped"; if ($type eq "anonymous") { return if $TestConfig{'ldap'}{'bind_types'}{'anonymous'}{'enabled'} != 1; } elsif ($type eq "simple") { return if $TestConfig{'ldap'}{'bind_types'}{'simple'}{'enabled'} != 1; %args = ( -dn => $TestConfig{'ldap'}{'bind_types'}{'simple'}{'bind_dn'}, -password => $TestConfig{'ldap'}{'bind_types'}{'simple'}{'bind_pw'} ); } elsif ($type eq "sasl") { return if $TestConfig{'ldap'}{'bind_types'}{'sasl'}{'enabled'} != 1; S->{'object'}->sasl_parms(%{$TestConfig{'ldap'}{'bind_types'}{'sasl'}{'sasl_parms'}}); %args = ( -type => S->{'object'}->LDAP_AUTH_SASL ); } S->{'bind_result'} = S->{'object'}->$func(%args); }; 1; net-ldapapi-3.0.7/t/features/step_definitions/compare_steps.pl000066400000000000000000000017151354766267100245740ustar00rootroot00000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::BDD::Cucumber::StepFile; our %TestConfig = %main::TestConfig; use Data::Dumper; When qr/I've (asynchronously )?compared to an attribute on the new (entry|container)/i, sub { my $async = $1 ? 1 : 0; my $type = lc($2); S->{'new ' . $type . ' comparison_result'} = 'skipped'; return if S->{'bind_result'} eq 'skipped'; my $func = 'compare_ext_s'; my %args = (); if ($async) { $func = 'compare_ext'; } S->{'new ' . $type . ' comparison_async'} = $async; $args{'-dn'} = sprintf('%s,%s,%s', $TestConfig{'data'}{$type . '_dn'}, $TestConfig{'data'}{'test_container_dn'}, $TestConfig{'ldap'}{'base_dn'}); $args{'-attr'} = $TestConfig{'compare'}{$type . '_attribute'}; $args{'-value'} = $TestConfig{'data'}{$type . '_attributes'}{$args{'-attr'}}; S->{'new ' . $type . ' comparison_result'} = S->{'object'}->$func(%args); }; 1; net-ldapapi-3.0.7/t/features/step_definitions/delete_steps.pl000066400000000000000000000014261354766267100244070ustar00rootroot00000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::BDD::Cucumber::StepFile; our %TestConfig = %main::TestConfig; use Data::Dumper; When qr/I've (asynchronously )?deleted the new (entry|container) from the directory/i, sub { my $async = $1 ? 1 : 0; my $type = lc($2); S->{'delete ' . $type . '_result'} = 'skipped'; return if S->{'bind_result'} eq 'skipped'; my $func = 'delete_s'; my %args = (); if ($async) { $func = 'delete'; } S->{'delete ' . $type . '_async'} = $async; $args{'-dn'} = sprintf('%s,%s,%s', $TestConfig{'data'}{$type . '_dn'}, $TestConfig{'data'}{'test_container_dn'}, $TestConfig{'ldap'}{'base_dn'}); S->{'delete ' . $type . '_result'} = S->{'object'}->$func(%args); }; 1; net-ldapapi-3.0.7/t/features/step_definitions/extended_operation_steps.pl000066400000000000000000000030411354766267100270200ustar00rootroot00000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::BDD::Cucumber::StepFile; our %TestConfig = %main::TestConfig; When qr/I've (asynchronously )?issued a (.+?) extended operation to the directory/i, sub { my $async = $1 ? 1 : 0; my $extended_operation = lc($2); S->{$extended_operation . ' extended operation_result'} = "skipped"; return if S->{"bind_result"} eq "skipped"; my $func = "extended_operation_s"; my %args = (); if ($async) { $func = "extended_operation"; } S->{$extended_operation . ' extended operation_async'} = $async; if ($extended_operation eq "whoami") { $args{'-oid'} = '1.3.6.1.4.1.4203.1.11.3'; $args{'-result'} = \%{S->{'whoami extended operation_authzid'}}; } S->{$extended_operation . ' extended operation_result'} = S->{'object'}->$func(%args); }; Then qr/the (.+?) extended operation matches/i, sub { my $extended_operation = lc($1); my $async = S->{$extended_operation . ' extended operation_async'}; my $got = undef; if ($async) { $got = {S->{'object'}->parse_extended_result(S->{$extended_operation . ' extended operation_result_id'})}; } if ($extended_operation eq "whoami") { if (!$async) { $got = S->{$extended_operation . ' extended operation_authzid'}; } is($got->{'retdatap'}, S->{'identity_got'}, 'Does ' . ($async ? 'asynchronous ' : '' ) . ' whoami extended_operation match native whoami?'); } else { TODO: { todo_skip "$extended_operation matching unimplemented", 1; } } }; 1; net-ldapapi-3.0.7/t/features/step_definitions/general_steps.pl000066400000000000000000000066271354766267100245720ustar00rootroot00000000000000#!/usr/bin/perl use strict; use warnings; use Net::LDAPapi; use Test::More; use Test::BDD::Cucumber::StepFile; our %TestConfig = %main::TestConfig; Given qr/a usable (\S+) class/, sub { use_ok($1); }; Given qr/a Net::LDAPapi object that has been connected to the (.+?)?\s?LDAP server/, sub { my $type = $1; if (!defined($type)) { $type = $TestConfig{'ldap'}{'default_server'}; } my $object = Net::LDAPapi->new(%{$TestConfig{'ldap'}{'server'}{$type}}); ok( $object, 'Net::LDAPapi object created'); S->{'object'} = $object; }; When qr/a test container has been created/, sub { my %args = (); $args{'-dn'} = sprintf('%s,%s', $TestConfig{'data'}{'test_container_dn'}, $TestConfig{'ldap'}{'base_dn'}); $args{'-mod'} = $TestConfig{'data'}{'test_container_attributes'}; my $status = S->{'object'}->add_s(%args); is(ldap_err2string($status), ldap_err2string(LDAP_SUCCESS), 'Was adding the test container successful?'); }; Then qr/the test container has been deleted/, sub { my %search_args = (); my @delete_dns = (); $search_args{'-basedn'} = sprintf('%s,%s', $TestConfig{'data'}{'test_container_dn'}, $TestConfig{'ldap'}{'base_dn'}); $search_args{'-scope'} = LDAP_SCOPE_SUBTREE; $search_args{'-filter'} = '(objectClass=*)'; $search_args{'-attrs'} = ['objectClass']; my $search_status = S->{'object'}->search_s(%search_args); is(ldap_err2string($search_status), ldap_err2string(LDAP_SUCCESS), 'Was searching for the test container to delete successful?'); while( my $ent = S->{'object'}->result_entry) { push(@delete_dns, S->{'object'}->get_dn()); } foreach my $dn (sort { length($b) <=> length($a) } @delete_dns) { my %delete_args = ('-dn' => $dn); my $status = S->{'object'}->delete_s(%delete_args); is(ldap_err2string($status), ldap_err2string(LDAP_SUCCESS), 'Was deleting test container contents "' . $dn . '" successful?'); } }; Then qr/(after waiting for all results, )?the (.+) result message type is (.+)/, sub { my $wait_for_all = $1 ? 1 : 0; my $test_function = $2; my $desired_result = $3; SKIP: { skip(C->{'scenario'}->{'name'} . " skipped", 1) if S->{$test_function . '_result'} eq "skipped"; isnt( S->{$test_function . '_result'}, undef, "Do we have result from $test_function?"); if (is( S->{$test_function . '_async'}, 1, "Was $test_function asynchronous?")) { S->{$test_function . '_result_id'} = S->{'object'}->result(S->{$test_function . '_result'}, $wait_for_all, 1); is(S->{'object'}->msgtype2str(S->{'object'}->{"status"}), $desired_result, "Does expected result message type match?"); } } }; Then qr/the (.+) result is (.+)/, sub { my $test_function = $1; my $desired_result = $2; SKIP: { skip(C->{'scenario'}->{'name'} . " skipped", 1) if S->{$test_function . '_result'} eq "skipped"; if (isnt( S->{$test_function . '_result'}, undef, "Do we have result from $test_function?")) { if (S->{$test_function . '_async'}) { my $ref = {S->{'object'}->parse_result(S->{$test_function . '_result_id'})}; is(ldap_err2string($ref->{'errcode'}), ldap_err2string(S->{'object'}->$desired_result), "Does expected async result code match?"); } else { is(ldap_err2string(S->{$test_function . '_result'}), ldap_err2string(S->{'object'}->$desired_result), "Does expected result code match?"); } } } }; 1; net-ldapapi-3.0.7/t/features/step_definitions/modify_steps.pl000066400000000000000000000040351354766267100244330ustar00rootroot00000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::BDD::Cucumber::StepFile; our %TestConfig = %main::TestConfig; use Data::Dumper; When qr/I've (asynchronously )?added a new attribute to the new entry/i, sub { my $async = $1 ? 1 : 0; S->{'new attribute_result'} = 'skipped'; return if S->{'bind_result'} eq 'skipped'; my $func = 'modify_ext_s'; my %args = (); if ($async) { $func = 'modify_ext'; } S->{'new attribute_async'} = $async; $args{'-dn'} = sprintf('%s,%s,%s', $TestConfig{'data'}{'entry_dn'}, $TestConfig{'data'}{'test_container_dn'}, $TestConfig{'ldap'}{'base_dn'}); $args{'-mod'} = $TestConfig{'modify'}{'new_attribute'}; S->{'new attribute_result'} = S->{'object'}->$func(%args); }; When qr/I've (asynchronously )?modified the new attribute on the new entry/i, sub { my $async = $1 ? 1 : 0; S->{'modified attribute_result'} = 'skipped'; return if S->{'bind_result'} eq 'skipped'; my $func = 'modify_s'; my %args = (); if ($async) { $func = 'modify'; } S->{'modified attribute_async'} = $async; $args{'-dn'} = sprintf('%s,%s,%s', $TestConfig{'data'}{'entry_dn'}, $TestConfig{'data'}{'test_container_dn'}, $TestConfig{'ldap'}{'base_dn'}); $args{'-mod'} = $TestConfig{'modify'}{'modify_attribute'}; S->{'modified attribute_result'} = S->{'object'}->$func(%args); }; When qr/I've (asynchronously )?removed the new attribute from the new entry/i, sub { my $async = $1 ? 1 : 0; S->{'removed attribute_result'} = 'skipped'; return if S->{'bind_result'} eq 'skipped'; my $func = 'modify_s'; my %args = (); if ($async) { $func = 'modify'; } S->{'removed attribute_async'} = $async; $args{'-dn'} = sprintf('%s,%s,%s', $TestConfig{'data'}{'entry_dn'}, $TestConfig{'data'}{'test_container_dn'}, $TestConfig{'ldap'}{'base_dn'}); $args{'-mod'} = $TestConfig{'modify'}{'remove_attribute'}; S->{'removed attribute_result'} = S->{'object'}->$func(%args); }; 1; net-ldapapi-3.0.7/t/features/step_definitions/options_steps.pl000066400000000000000000000014571354766267100246440ustar00rootroot00000000000000#!/usr/bin/perl use strict; use warnings; use Net::LDAPapi; use Test::More; use Test::BDD::Cucumber::StepFile; our %TestConfig = %main::TestConfig; When qr/I've set option (.+?) with value (.+)/i, sub { my $option = $1; my $value = int($2); my $status = S->{'object'}->set_option(S->{'object'}->$option, $value); is(ldap_err2string($status), ldap_err2string(LDAP_SUCCESS), "Was option successfully set?"); }; Then qr/option (.+?) has value (.+)/i, sub { my $option = $1; my $value = $2; my $data; my $status = S->{'object'}->get_option(S->{'object'}->$option, \$data); is(ldap_err2string($status), ldap_err2string(LDAP_SUCCESS), "Was option successfully retrieved?"); is($data, $value, "Is the option set to the expected value?"); }; 1; net-ldapapi-3.0.7/t/features/step_definitions/rename_steps.pl000066400000000000000000000016541354766267100244170ustar00rootroot00000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::BDD::Cucumber::StepFile; our %TestConfig = %main::TestConfig; use Data::Dumper; When qr/I've (asynchronously )?moved the new entry to the new container/i, sub { my $async = $1 ? 1 : 0; S->{'rename entry_result'} = 'skipped'; return if S->{'bind_result'} eq 'skipped'; my $func = 'rename_s'; my %args = (); if ($async) { $func = 'rename'; } S->{'rename entry_async'} = $async; $args{'-dn'} = sprintf('%s,%s,%s', $TestConfig{'data'}{'entry_dn'}, $TestConfig{'data'}{'test_container_dn'}, $TestConfig{'ldap'}{'base_dn'}); $args{'-newsuper'} = sprintf('%s,%s,%s', $TestConfig{'rename'}{'new_super'}, $TestConfig{'data'}{'test_container_dn'}, $TestConfig{'ldap'}{'base_dn'}); $args{'-newrdn'} = $TestConfig{'rename'}{'new_rdn'}; S->{'rename entry_result'} = S->{'object'}->$func(%args); }; 1; net-ldapapi-3.0.7/t/features/step_definitions/search_steps.pl000066400000000000000000000055161354766267100244160ustar00rootroot00000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::BDD::Cucumber::StepFile; our %TestConfig = %main::TestConfig; use Data::Dumper; When qr/I've (asynchronously )?searched for records with scope ([^, ]+)(?:, with server control(?:s)? (.+((?:(,|and) .+)*)))?(?:, with timeout (\d+))?/, sub { my $async = $1 ? 1 : 0; my $scope = $2; my $timeout = $6; my @server_ctrls = $3 ? map { S->{'server_controls'}{$_} } split(/\s*(?:,|and)\s*/, $3) : undef; my $func = "search_ext_s"; if ($async) { $func = "search_ext"; } S->{'search_async'} = $async; my %args = (); S->{'search_result'} = S->{'object'}->$func( -basedn => $TestConfig{'ldap'}{'base_dn'}, -scope => S->{'object'}->$scope, -filter => $TestConfig{'search'}{'filter'}, -attrs => \@{['cn']}, -attrsonly => 0, -sctrls => [@server_ctrls], -timeout => $timeout); }; Then qr/the search count matches/, sub { is(S->{'object'}->count_entries, $TestConfig{'search'}{'count'}, "Does the search count match?"); }; Then qr/using get_all_entries for each entry returned the dn and all attributes are valid/, sub { my $entries = S->{'object'}->get_all_entries(); foreach my $entry_dn (keys %{$entries}) { isnt($entry_dn, "", "Is the dn for the entry empty?"); foreach my $attribute (keys %{$entries->{$entry_dn}}) { my @vals = $entries->{$entry_dn}{$attribute}; ok(($#vals >= 0), "Are values returned?"); } } }; Then qr/using (.+) for each entry returned the dn and all attributes using (.+?) are valid/, sub { my $entry_iterate_mode = lc($1); my $attribute_iterate_mode = lc($2); my $attribute_tests = sub { my $attr = shift; my @vals = S->{'object'}->get_values($attr); ok(($#vals >= 0), "Are values returned?"); }; my $attribute_block = sub { if ($attribute_iterate_mode eq "next_attribute") { for (my $attr = S->{'object'}->first_attribute; $attr; $attr = S->{'object'}->next_attribute) { $attribute_tests->($attr); } } elsif ($attribute_iterate_mode eq "entry_attribute") { foreach my $attr (S->{'object'}->entry_attribute) { $attribute_tests->($attr); } } }; my $entry_tests = sub { isnt(S->{'object'}->get_dn(), "", "Is the dn for the entry empty?"); }; if ($entry_iterate_mode eq "next_entry") { my $ent = S->{'object'}->first_entry; my %ent_result = S->{'object'}->parse_result(); S->{'cache'}{'serverctrls'} = $ent_result{'serverctrls'}; for (; $ent; $ent = S->{'object'}->next_entry) { $entry_tests->($ent); $attribute_block->($ent); } } elsif ($entry_iterate_mode eq "result_entry") { foreach my $ent (S->{'object'}->result_entry) { $entry_tests->($ent); $attribute_block->($ent); } } }; 1; net-ldapapi-3.0.7/t/features/step_definitions/server_controls_steps.pl000066400000000000000000000075571354766267100264110ustar00rootroot00000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::BDD::Cucumber::StepFile; use Net::LDAPapi; use Convert::ASN1; our %TestConfig = %main::TestConfig; use Data::Dumper; Given qr/the server side sort control definition/i, sub { if (!defined(S->{'asn'}{'server side sort'})) { S->{'asn'}{'server side sort'} = Convert::ASN1->new; S->{'asn'}{'server side sort'}->prepare(<{'asn'}{'server side sort'}->error; SortKey ::= SEQUENCE { attributeType OCTET STRING, orderingRule [0] OCTET STRING OPTIONAL, reverseOrder [1] BOOLEAN } SortKeyList ::= SEQUENCE OF SortKey SortResult ::= SEQUENCE { sortResult ENUMERATED, attributeType [0] OCTET STRING OPTIONAL } ASN } }; Given qr/the virtual list view control definition/i, sub { if (!defined(S->{'asn'}{'virtual list view'})) { S->{'asn'}{'virtual list view'} = Convert::ASN1->new; S->{'asn'}{'virtual list view'}->prepare(<{'asn'}{'virtual list view'}->error; VirtualListViewRequest ::= SEQUENCE { beforeCount INTEGER, afterCount INTEGER, target CHOICE { byOffset [0] SEQUENCE { offset INTEGER, contentCount INTEGER }, greaterThanOrEqual [1] OCTET STRING }, contextID OCTET STRING OPTIONAL } VirtualListViewResponse ::= SEQUENCE { targetPosition INTEGER, contentCount INTEGER, virtualListViewResult ENUMERATED, contextID OCTET STRING OPTIONAL } ASN } }; When qr/I've created a server side sort control/i, sub { my $sss = S->{'asn'}{'server side sort'}->find('SortKeyList'); my $sss_berval = $sss->encode($TestConfig{'server_controls'}{'sss'}) or die S->{'asn'}{'server side sort'}->error; my $sss_ctrl = S->{'object'}->create_control( -oid => '1.2.840.113556.1.4.473', -berval => $sss_berval, ); S->{'server_controls'}{'server side sort'} = $sss_ctrl; }; When qr/I've created a virtual list view control/i, sub { my $vlv = S->{'asn'}{'virtual list view'}->find('VirtualListViewRequest'); my $vlv_berval = $vlv->encode($TestConfig{'server_controls'}{'vlv'}) or die S->{'asn'}{'virtual list view'}->error; my $vlv_ctrl = S->{'object'}->create_control( -oid => '2.16.840.1.113730.3.4.9', -berval => $vlv_berval, ); S->{'server_controls'}{'virtual list view'} = $vlv_ctrl; }; Then qr/the server side sort control was successfully used/i, sub { my $sss_response = S->{'asn'}{'server side sort'}->find('SortResult'); my $berval = undef; foreach my $ctrl (@{S->{'cache'}{'serverctrls'}}) { my $ctrl_oid = S->{'object'}->get_control_oid($ctrl); if ($ctrl_oid eq '1.2.840.113556.1.4.474') { $berval = S->{'object'}->get_control_berval($ctrl); last; } } isnt($berval, undef, "Was a berval returned?"); my $result = $sss_response->decode($berval) || ok(0, $sss_response->error); is(ldap_err2string($result->{'sortResult'}), ldap_err2string(LDAP_SUCCESS), "Does server side sort result code match?"); }; Then qr/the virtual list view control was successfully used/i, sub { my $vlv_response = S->{'asn'}{'virtual list view'}->find('VirtualListViewResponse'); my $berval = undef; foreach my $ctrl (@{S->{'cache'}{'serverctrls'}}) { my $ctrl_oid = S->{'object'}->get_control_oid($ctrl); if ($ctrl_oid eq '2.16.840.1.113730.3.4.10') { $berval = S->{'object'}->get_control_berval($ctrl); last; } } isnt($berval, undef, "Was a berval returned?"); my $result = $vlv_response->decode($berval) || ok(0, $vlv_response->error); is(ldap_err2string($result->{'virtualListViewResult'}), ldap_err2string(LDAP_SUCCESS), "Does virtual list view result code match?"); }; 1; net-ldapapi-3.0.7/t/features/step_definitions/syncrepl_steps.pl000066400000000000000000000047201354766267100250040ustar00rootroot00000000000000#!/usr/bin/perl use strict; use warnings; use Net::LDAPapi; use Test::More; use Test::BDD::Cucumber::StepFile; our %TestConfig = %main::TestConfig; use Data::Dumper; When qr/I've started listening for changes within the directory/i, sub { S->{'listen changes_result'} = 'skipped'; return if S->{'bind_result'} eq 'skipped'; my $func = 'listen_for_changes'; my %args = (); $args{'-basedn'} = sprintf('%s,%s', $TestConfig{'data'}{'test_container_dn'}, $TestConfig{'ldap'}{'base_dn'}); $args{'-scope'} = LDAP_SCOPE_SUBTREE; $args{'-filter'} = '(objectClass=*)'; $args{'-cookie'} = $TestConfig{'syncrepl'}{'cookie_dir'} . "syncrepl.$$.cookie"; # open(COOKIE, ">" . $args{'-cookie'}); # close(COOKIE); S->{'listen changes_result'} = S->{'object'}->$func(%args); S->{'object'}->next_changed_entries(S->{'listen changes_result'}, 0, 1); }; Then qr/the changes were successfully notified/i, sub { my $expected_container_dn = sprintf('%s,%s,%s', $TestConfig{'data'}{'container_dn'}, $TestConfig{'data'}{'test_container_dn'}, $TestConfig{'ldap'}{'base_dn'}); my $expected_entry_dn = sprintf('%s,%s,%s', $TestConfig{'data'}{'entry_dn'}, $TestConfig{'data'}{'test_container_dn'}, $TestConfig{'ldap'}{'base_dn'}); my $seen_expected = 0; my $timeout_start = time(); my $timeout_length = 5; while(!$seen_expected) { if ((time() - $timeout_start) > $timeout_length) { last; } while(my @entries = S->{'object'}->next_changed_entries(S->{'listen changes_result'}, 0, 1)) { foreach my $entry (@entries) { my $entry_dn = S->{'object'}->get_dn($entry->{'entry'}); if (lc($entry_dn) eq lc($expected_container_dn) || lc($entry_dn) eq lc($expected_entry_dn)) { $seen_expected = 1; last; } } } } ok($seen_expected, 'Have we seen a notification for an expected DN?'); my %args; my $asn = Convert::ASN1->new(); $asn->prepare(<{'cancel_result code'}}; $args{'-berval'} = $asn->encode(cancelID => S->{'listen changes_result'}); my $cancel_status = S->{'object'}->extended_operation_s(%args); is(ldap_err2string($cancel_status), ldap_err2string(LDAP_SUCCESS), 'Was cancelling the sync successful?'); S->{'object'}->{'entry'} = 0; }; 1; net-ldapapi-3.0.7/t/features/step_definitions/whoami_steps.pl000066400000000000000000000030461354766267100244310ustar00rootroot00000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::BDD::Cucumber::StepFile; our %TestConfig = %main::TestConfig; When qr/I\'ve (asynchronously )?queried the directory for my identity/, sub { my $async = $1 ? 1 : 0; S->{'identity_authzid'} = undef; S->{'identity_result'} = "skipped"; return if S->{"bind_result"} eq "skipped"; my $func = "whoami_s"; my %args = (); if ($async) { $func = "whoami"; } else { %args = ('-authzid' => \S->{'identity_authzid'}); } S->{'identity_async'} = $async; S->{'identity_result'} = S->{'object'}->$func(%args); }; Then qr/the identity matches/, sub { SKIP: { skip(S->{'bind_type'} . " authentication disabled in t/test-config.pl", 1) if S->{"bind_result"} eq "skipped"; my ($got, $expected); if (S->{'identity_async'}) { $got = S->{'object'}->parse_whoami(S->{'identity_result_id'}); } else { $got = S->{'identity_authzid'}; } S->{'identity_got'} = $got; if (S->{'bind_type'} eq "anonymous") { $expected = ""; } elsif (S->{'bind_type'} eq "simple") { my ($attr, $value) = split(/:/, $got); $got = $value; $expected = $TestConfig{'ldap'}{'bind_types'}{'simple'}{'bind_dn'}; } elsif (S->{'bind_type'} eq "sasl") { my ($attr, $value) = split(/:/, $got); $got = $value; $expected = $TestConfig{'ldap'}{'bind_types'}{'sasl'}{'identity'}; } is(lc($got), lc($expected), "Does expected identity match received identity?"); } }; 1; net-ldapapi-3.0.7/t/features/syncrepl.feature000066400000000000000000000017141354766267100212400ustar00rootroot00000000000000Feature: Listening for changes within the directory with syncrepl As a OpenLDAP directory consumer I want to ensure that I can be notified of changes to entries within the directory In order to act quickly on changes Background: Given a usable Net::LDAPapi class Scenario: Can listen for changes within the directory Given a Net::LDAPapi object that has been connected to the LDAP server When I've bound with default authentication to the directory And a test container has been created And I've started listening for changes within the directory And I've added a new entry to the directory And I've added a new container to the directory And I've deleted the new entry from the directory Then the new entry result is LDAP_SUCCESS And the new container result is LDAP_SUCCESS And the delete entry result is LDAP_SUCCESS And the changes were successfully notified And the test container has been deleted net-ldapapi-3.0.7/t/features/whoami.feature000066400000000000000000000056351354766267100206730ustar00rootroot00000000000000Feature: Querying the directory for my identity As a directory consumer I want to ensure that I can retrieve my identity In order to determine my DN when using a non-simple authentication Background: Given a usable Net::LDAPapi class Scenario: Can query identity with anonymous authentication Given a Net::LDAPapi object that has been connected to the LDAP server When I've bound with anonymous authentication to the directory And I've queried the directory for my identity Then the bind result is LDAP_SUCCESS And the identity result is LDAP_SUCCESS And the identity matches Scenario: Can query identity with simple authentication Given a Net::LDAPapi object that has been connected to the LDAP server When I've bound with simple authentication to the directory And I've queried the directory for my identity Then the bind result is LDAP_SUCCESS And the identity result is LDAP_SUCCESS And the identity matches Scenario: Can query identity with sasl authentication Given a Net::LDAPapi object that has been connected to the ldapi LDAP server When I've bound with sasl authentication to the directory And I've queried the directory for my identity Then the bind result is LDAP_SUCCESS And the identity result is LDAP_SUCCESS And the identity matches Scenario: Can asynchronously query identity with anonymous authentication Given a Net::LDAPapi object that has been connected to the LDAP server When I've asynchronously bound with anonymous authentication to the directory And I've asynchronously queried the directory for my identity Then the bind result message type is LDAP_RES_BIND And the bind result is LDAP_SUCCESS And after waiting for all results, the identity result message type is LDAP_RES_EXTENDED And the identity result is LDAP_SUCCESS And the identity matches Scenario: Can asynchronously query identity with simple authentication Given a Net::LDAPapi object that has been connected to the LDAP server When I've asynchronously bound with simple authentication to the directory And I've asynchronously queried the directory for my identity Then the bind result message type is LDAP_RES_BIND And the bind result is LDAP_SUCCESS And after waiting for all results, the identity result message type is LDAP_RES_EXTENDED And the identity result is LDAP_SUCCESS And the identity matches # Scenario: Can asynchronously query identity with sasl authentication # Given a Net::LDAPapi object that has been connected to the ldapi LDAP server # When I've asynchronously bound with sasl authentication to the directory # And I've asynchronously queried the directory for my identity # Then the bind result message type is LDAP_RES_BIND # And the bind result is LDAP_SUCCESS # And after waiting for all results, the identity result message type is LDAP_RES_EXTENDED # And the identity result is LDAP_SUCCESS # And the identity matches net-ldapapi-3.0.7/t/test-config.pl000066400000000000000000000062101354766267100167610ustar00rootroot00000000000000# Developer tests require: # Test::More # Test::BDD::Cucumber our $RunDeveloperTests = 0; # Default config. # If you're a developer of Net::LDAPapi or are likely to have multiple trees that share common test config, # then you should override in ~/.net-ldapapi-test-config.conf (See below) our %TestConfig = ( 'ldap' => { 'server' => { 'tcp' => { '-host' => 'localhost', '-port' => 389, }, 'ldapi' => { '-url' => 'ldapi:///', '-debug' => 1 } }, 'base_dn' => 'dc=example,dc=com', 'bind_types' => { 'anonymous' => { 'enabled' => 1, }, 'simple' => { 'enabled' => 1, 'bind_dn' => 'cn=admin,dc=example,dc=com', 'bind_pw' => 'password', }, 'sasl' => { 'enabled' => 1, 'sasl_parms' => { '-mech' => 'EXTERNAL', }, 'identity' => "gidNumber=" . $< . "+uidNumber=" . (split(/ /, "$("))[0] . ",cn=peercred,cn=external,cn=auth" } }, 'default_server' => 'tcp', 'default_bind_type' => 'simple', }, 'search' => { 'filter' => "sn=Last", 'count' => 1, }, 'data' => { 'test_container_attributes' => { 'objectClass' => ['top', 'organizationalUnit'], 'ou' => 'Test Container', }, 'container_attributes' => { 'objectClass' => ['top', 'organizationalUnit'], 'ou' => 'Test - Add Container', }, 'entry_attributes' => { 'objectClass' => ['top', 'person' ,'organizationalPerson', 'inetOrgPerson'], 'cn' => 'Test - Add Entry', 'sn' => 'Entry', 'givenName' => 'Test - Add', }, 'test_container_dn' => 'ou=Test Container', 'container_dn' => 'ou=Test - Add Container', 'entry_dn' => 'cn=Test - Add Entry', }, 'rename' => { 'dn' => 'cn=Test - Add Entry', 'new_rdn' => 'cn=Test - Add Entry', 'new_super' => 'ou=Test - Add Container' }, 'modify' => { 'new_attribute' => { 'title' => { 'a' => ['New Test Title'] } }, 'modify_attribute' => { 'title' => { 'r' => ['Modified Test Title'] } }, 'remove_attribute' => { 'title' => '' }, }, 'syncrepl' => { 'enabled' => 1, 'cookie_dir' => '/tmp/' }, 'server_controls' => { 'sss' => [ { 'attributeType' => 'sn', 'orderingRule' => '2.5.13.3', 'reverseOrder' => 1 }, ], 'vlv' => { 'beforeCount' => 0, 'afterCount' => 3, 'target' => { 'byOffset' => { 'offset' => 1, 'contentCount' => 0 } } }, }, 'compare' => { 'entry_attribute' => 'cn', 'compare_attribute' => 'ou' } ); # Allow overrides from outside the source tree. # This is a standard Perl file. Example below. if ( -e $ENV{'HOME'} . '/.net-ldapapi-test-config.conf') { require $ENV{'HOME'} . '/.net-ldapapi-test-config.conf'; } 1; __END__ $RunDeveloperTests = 1; $TestConfig{'ldap'}{'base_dn'} = "o=Test Data,c=NZ"; $TestConfig{'ldap'}{'bind_types'}{'simple'}{'bind_dn'} = "cn=admin,o=Test Data,c=NZ"; $TestConfig{'ldap'}{'bind_types'}{'simple'}{'bind_pw'} = "password"; $TestConfig{'search'}{'filter'} = "sn=O'Donnell"; 1; net-ldapapi-3.0.7/test.pl000066400000000000000000000057051354766267100152630ustar00rootroot00000000000000# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..10\n"; } END {print "modinit - not ok\n" unless $loaded;} use Net::LDAPapi; $loaded = 1; print "modinit - ok\n"; ######################### End of black magic. ## ## Change these values for test to work... ## print "\nEnter LDAP Server: "; chomp($ldap_host = <>); print "Enter port: "; chomp($ldap_port = <>); print "Enter Search Filter (ex. uid=abc123): "; chomp($filter = <>); print "Enter LDAP Search Base (ex. o=Org, c=US): "; chomp($BASEDN = <>); print "\n"; if (!$ldap_host) { die "Please edit \$BASEDN, \$filter and \$ldap_host in test.pl.\n"; } ## ## Initialize LDAP Connection ## if (($ld = new Net::LDAPapi(-host=>$ldap_host,-port=>$ldap_port)) == -1) { print "open - not ok\n"; exit -1; } print "open - ok\n"; ## ## Bind as DN, PASSWORD (NULL,NULL) on LDAP connection $ld ## if ($ld->bind_s != LDAP_SUCCESS) { $ld->perror("bind_s"); print "bind - not ok\n"; exit -1; } print "bind - ok\n"; ## ## ldap_whoami_s ## $id = ''; if ($ld->whoami_s(\$id) != LDAP_SUCCESS) { $ld->perror("whoami_s"); print "whoami - not ok\n"; exit -1; } print "whoami - ok\n"; ## ## ldap_extended_operation_s ## %result = (); if ($ld->extended_operation_s(-oid => "1.3.6.1.4.1.4203.1.11.3", -result => \%result) != LDAP_SUCCESS) { $ld->perror("ldap_extended_operation_s"); print "ldap_extended_operation - not ok\n"; exit -1; } print "ldap_extended_operation - ok\n"; ## ## ldap_search_s - Synchronous Search ## @attrs = (); if ($ld->search_s($BASEDN,LDAP_SCOPE_SUBTREE,$filter,\@attrs,0) != LDAP_SUCCESS) { $ld->perror("search_s"); print "search - not ok\n"; } print "search - ok\n"; ## ## ldap_count_entries - Count Matched Entries ## if ($ld->count_entries == -1) { ldap_perror($ld,"count_entry"); print "count - not ok\n"; } print "count - ok\n"; ## ## first_entry - Get First Matched Entry ## next_entry - Get Next Matched Entry ## for ($ent = $ld->first_entry; $ent; $ent = $ld->next_entry) { ## ## ldap_get_dn - Get DN for Matched Entries ## if ($ld->get_dn ne "") { print "getdn - ok\n"; } else { $ld->perror("get_dn"); print "getdn - not ok\n"; } if (($attr = $ld->first_attribute) ne "") { print "firstatt - ok\n"; ## ## ldap_get_values ## @vals = $ld->get_values($attr); if ($#vals >= 0) { print "getvals - ok\n"; } else { print "getvals - not ok\n"; } } else { print "firstattr - not ok\n"; } } ## ## Unbind LDAP Connection ## $ld->unbind(); net-ldapapi-3.0.7/typemap000066400000000000000000000012341354766267100153420ustar00rootroot00000000000000int * T_PTR char * T_PV char ** T_PTR char *** T_PTR const char * T_PV LDAP_CHAR * T_PV LDAP_CHAR ** T_PTR LDAP * T_PTR LDAP ** T_PTR LDAPControl * T_PTR LDAPControl ** T_PTR LDAPControl *** T_PTR LDAPMessage * T_PTR LDAPMessage ** T_PTR BerElement * T_PTR BerElement ** T_PTR LDAPVersion * T_PTR LDAPMod * T_PTR LDAPMod ** T_PTR struct berval * T_PTR struct berval ** T_PTR struct timeval * T_PTR LDAPDN * T_PTR LDAPRDN * T_PTR LDAPSortKey ** T_PTR LDAPSortKey *** T_PTR