use
vars
qw($VERSION @ISA @EXPORT $AUTOLOAD)
;
no
warnings
"uninitialized"
;
@ISA
=
qw(Exporter DynaLoader)
;
@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 {
my
$constname
;
(
$constname
=
$AUTOLOAD
) =~ s/.*:://;
my
$val
= constant(
$constname
,
@_
?
$_
[0] : 0);
if
($! != 0) {
if
($! =~ /Invalid/) {
$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
;
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);
}
my
$asn
= Convert::ASN1->new;
$asn
->prepare(
<<ASN) or die "prepare: ", $asn->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
;
}
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
;
}
sub
abandon_ext {
my
(
$self
,
@args
) =
@_
;
return
$self
->abandon(
@args
);
}
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
;
}
sub
add_ext
{
my
(
$self
,
@args
) =
@_
;
return
$self
->add(
@args
);
}
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
;
}
sub
add_ext_s
{
my
(
$self
,
@args
) =
@_
;
return
$self
->add_s(
@args
);
}
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
;
}
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
{
$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
;
}
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
;
}
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
;
}
sub
compare_ext {
my
(
$self
,
@args
) =
@_
;
return
$self
->compare(
@args
);
}
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
;
}
sub
compare_ext_s {
my
(
$self
,
@args
) =
@_
;
return
$self
->compare_s(
@args
);
}
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
;
}
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
;
}
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
);
}
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
;
}
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
;
}
sub
dn2ufn
{
my
(
$self
,
@args
) =
@_
;
my
(
$dn
) =
$self
->rearrange([
'DN'
],
@args
);
return
ldap_dn2ufn(
$dn
);
}
sub
explode_dn
{
my
(
$self
,
@args
) =
@_
;
my
(
$dn
,
$notypes
) =
$self
->rearrange([
'DN'
,
'NOTYPES'
],
@args
);
return
ldap_explode_dn(
$dn
,
$notypes
);
}
sub
explode_rdn
{
my
(
$self
,
@args
) =
@_
;
my
(
@components
);
my
(
$rdn
,
$notypes
) =
$self
->rearrange([
'RDN'
,
'NOTYPES'
],
@args
);
return
ldap_explode_rdn(
$rdn
,
$notypes
);
}
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"
};
}
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"
};
}
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"
};
}
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) {
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
;
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_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
);
$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"
);
if
(
$cookie
) {
save_cookie(
$cookie
,
$self
->{
"cookie"
});
}
}
}
}
return
@entries
;
}
sub
save_cookie
{
my
(
$self
,
@args
) =
@_
;
my
$cookiestr
=
$_
[0];
my
$cookie
=
$_
[1];
if
(
$cookiestr
=~ m/csn=/) {
chomp
(
my
@newcsns
=
split
(
';'
,
$cookiestr
=~ s/(rid=\d{3},)|(sid=\d{3},)|(csn=)//rg));
my
@outcsns
=
@newcsns
;
if
(-w
$cookie
) {
open
(COOKIE_FILE,
"<"
,
$cookie
) ||
die
(
"Cannot open file '"
.
$cookie
.
"' for reading."
);
chomp
(
my
@oldcsns
= <COOKIE_FILE>);
close
(COOKIE_FILE);
foreach
my
$oldcsn
(
@oldcsns
) {
my
$match
= 0;
my
$p_sid
= (
$oldcsn
=~ /(
foreach
my
$newcsn
(
@newcsns
) {
if
(
$newcsn
=~ m/\Q
$p_sid
/) {
$match
= 1;
last
;
}
}
if
(!
$match
) {
push
@outcsns
,
$oldcsn
; }
}
}
open
(COOKIE_FILE,
">"
,
$cookie
) ||
die
(
"Cannot open file '"
.
$cookie
.
"' for writing."
);
print
COOKIE_FILE
"$_\n"
for
@outcsns
;
close
(COOKIE_FILE);
}
}
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"
};
}
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"
};
}
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"
};
}
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
;
}
sub
get_control_oid {
my
(
$self
,
@args
) =
@_
;
my
(
$ctrl
) =
$self
->rearrange([
'CTRL'
],
@args
);
return
ldap_control_oid(
$ctrl
);
}
sub
get_control_berval {
my
(
$self
,
@args
) =
@_
;
my
(
$ctrl
) =
$self
->rearrange([
'CTRL'
],
@args
);
return
ldap_control_berval(
$ctrl
);
}
sub
get_control_critical {
my
(
$self
,
@args
) =
@_
;
my
(
$ctrl
) =
$self
->rearrange([
'CTRL'
],
@args
);
return
ldap_control_critical(
$ctrl
);
}
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
;
}
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
;
}
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
;
}
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
;
}
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
;
}
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
;
}
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
;
}
sub
perror
{
my
(
$self
,
@args
) =
@_
;
my
(
$msg
) =
$self
->rearrange([
'MSG'
],
@args
);
ldap_perror(
$self
->{
"ld"
},
$msg
);
}
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
;
}
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
;
}
sub
get_values_len {
my
(
$self
,
@args
) =
@_
;
return
$self
->get_values(
@args
);
}
sub
msgfree
{
my
(
$self
,
@args
) =
@_
;
my
(
$result
) =
$self
->rearrange([
'RESULT'
],
@args
);
$result
=
$self
->{
"result"
}
unless
$result
;
return
ldap_msgfree(
$self
->{
"result"
});
}
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
;
}
sub
modify_ext
{
my
(
$self
,
@args
) =
@_
;
return
$self
->modify(
@args
);
}
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
;
}
sub
modify_ext_s
{
my
(
$self
,
@args
) =
@_
;
return
$self
->modify_s(
@args
);
}
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
;
}
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
;
}
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
;
}
sub
is_ldap_url
{
my
(
$self
,
@args
) =
@_
;
my
(
$url
) =
$self
->rearrange([
'URL'
],
@args
);
return
ldap_is_ldap_url(
$url
);
}
sub
url_parse
{
my
(
$self
,
@args
) =
@_
;
my
(
$url
) =
$self
->rearrange([
'URL'
],
@args
);
return
ldap_url_parse(
$url
);
}
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
;
}
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
;
}
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
;
}
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
;
}
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
;
}
if
(
open
(COOKIE,
$cookie
) ) {
chomp
(
my
@csns
= <COOKIE>);
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'
);
if
(
$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
;
}
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
;
}
sub
search_ext
{
my
(
$self
,
@args
) =
@_
;
return
$self
->search(
@args
);
}
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
;
}
sub
search_ext_s
{
my
(
$self
,
@args
) =
@_
;
return
$self
->search_s(
@args
);
}
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
;
}
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
;
}
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
;
}
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
;
}
sub
count_references
{
my
(
$self
,
@args
) =
@_
;
my
(
$msg
) =
$self
->rearrange([
'MSG'
],
@args
);
$msg
=
$self
->{
"entry"
}
unless
$msg
;
return
ldap_count_references(
$self
->{
"ld"
},
$msg
);
}
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
;
}
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
;
}
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
;
}
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
);
}
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
;
}
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
);
}
sub
ssl
{
my
(
$self
) =
@_
;
my
(
$status
);
$status
= ldapssl_install_routines(
$self
->{
"ld"
});
return
$status
;
}
sub
entry
{
my
(
$self
) =
@_
;
return
$self
->{
"entry"
};
}
sub
err
{
my
(
$self
) =
@_
;
return
$self
->{
"errno"
};
}
sub
errno
{
my
(
$self
) =
@_
;
return
$self
->{
"errno"
};
}
sub
errstring
{
my
(
$self
) =
@_
;
return
ldap_err2string(
$self
->{
"errno"
});
}
sub
extramsg
{
my
(
$self
) =
@_
;
return
$self
->{
"extramsg"
};
}
sub
ld
{
my
(
$self
) =
@_
;
return
$self
->{
"ld"
};
}
sub
msgtype
{
my
(
$self
,
@args
) =
@_
;
my
(
$msg
) =
$self
->rearrange([
'MSG'
],
@args
);
$msg
=
$self
->{
"msg"
}
unless
$msg
;
return
ldap_msgtype(
$msg
);
}
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"
;
}
}
sub
msgid
{
my
(
$self
,
@args
) =
@_
;
my
(
$result
) =
$self
->rearrange([
'RESULT'
],
@args
);
$result
=
$self
->{
"result"
}
unless
$result
;
return
ldap_msgid(
$self
->{
"ld"
},
$result
);
}
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
;
}
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
;
}
sub
free_control
{
my
(
$self
,
@args
) =
@_
;
my
(
$control
) =
$self
->rearrange([
'CONTROL'
],
@args
);
ldap_control_free(
$control
);
}
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/^\-//;
(
$key
=
"\L$key"
) =~
tr
/_/-/;
my
$value
=
$escape
? simple_escape(
$attr
->{
$_
}) :
$attr
->{
$_
};
push
(
@att
,
defined
(
$attr
->{
$_
}) ?
qq/$key="$value"/
:
qq/$key/
);
}
return
@att
;
}
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/^\-//;
$param
[
$i
]=~
tr
/a-z/A-Z/;
}
my
(
%param
) =
@param
;
my
(
@return_array
);
my
(
$key
)=
''
;
foreach
$key
(
@$order
) {
my
(
$value
);
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
);
}
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
;
}
}
sub
CRITICAL {
1;
}
sub
NONCRITICAL {
0;
}
1;