зеркало из https://github.com/mozilla/pjs.git
Merged v1.1 development branch to trunk, v1.1 released
This commit is contained in:
leif%netscape.com
Родитель
47e9f04a72
Коммит
e4f2801b64
|
|
@ -1,5 +1,5 @@
|
|||
#############################################################################
|
||||
# $Id: API.pm,v 1.12 1998-08-13 22:03:42 leif Exp $
|
||||
# $Id: API.pm,v 1.13 1999-01-21 23:52:41 leif%netscape.com Exp $
|
||||
#
|
||||
# The contents of this file are subject to the Mozilla Public License
|
||||
# Version 1.0 (the "License"); you may not use this file except in
|
||||
|
|
@ -247,7 +247,7 @@ require AutoLoader;
|
|||
# Add Everything in %EXPORT_TAGS to @EXPORT_OK
|
||||
Exporter::export_ok_tags(keys %EXPORT_TAGS);
|
||||
|
||||
$VERSION = '1.00';
|
||||
$VERSION = '1.1';
|
||||
|
||||
# The XS 'constant' routine returns an integer. There are all constants
|
||||
# we want to return something else.
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
/******************************************************************************
|
||||
* $Id: API.xs,v 1.15 1998-08-13 22:40:53 leif Exp $
|
||||
* $Id: API.xs,v 1.16 1999-01-21 23:52:41 leif%netscape.com Exp $
|
||||
*
|
||||
* The contents of this file are subject to the Mozilla Public License
|
||||
* Version 1.0 (the "License"); you may not use this file except in
|
||||
|
|
@ -70,22 +70,24 @@ static int ldap_default_rebind_auth = LDAP_AUTH_SIMPLE;
|
|||
/* Return a Perl List from a char ** in PPCODE */
|
||||
#define RET_CPP(cppvar) \
|
||||
int cppindex; \
|
||||
if (cppvar) { \
|
||||
for (cppindex = 0; cppvar[cppindex] != NULL; cppindex++) \
|
||||
{ \
|
||||
EXTEND(sp,1); \
|
||||
PUSHs(sv_2mortal(newSVpv(cppvar[cppindex],strlen(cppvar[cppindex])))); \
|
||||
} \
|
||||
ldap_value_free(cppvar)
|
||||
ldap_value_free(cppvar); }
|
||||
|
||||
/* Return a Perl List from a berval ** in PPCODE */
|
||||
#define RET_BVPP(bvppvar) \
|
||||
int bvppindex; \
|
||||
if (bvppvar) { \
|
||||
for (bvppindex = 0; bvppvar[bvppindex] != NULL; bvppindex++) \
|
||||
{ \
|
||||
EXTEND(sp,1); \
|
||||
PUSHs(sv_2mortal(newSVpv(bvppvar[bvppindex]->bv_val,bvppvar[bvppindex]->bv_len))); \
|
||||
} \
|
||||
ldap_value_free_len(bvppvar)
|
||||
ldap_value_free_len(bvppvar); }
|
||||
|
||||
/* Return a char ** when passed a reference to an AV */
|
||||
char ** avref2charptrptr(SV *avref)
|
||||
|
|
@ -118,7 +120,7 @@ struct berval ** avref2berptrptr(SV *avref)
|
|||
I32 avref_arraylen;
|
||||
int ix_av,val_len;
|
||||
SV **current_val;
|
||||
char *tmp_char;
|
||||
char *tmp_char,*tmp2;
|
||||
struct berval **tmp_ber;
|
||||
|
||||
if (SvTYPE(SvRV(avref)) != SVt_PVAV ||
|
||||
|
|
@ -132,11 +134,14 @@ struct berval ** avref2berptrptr(SV *avref)
|
|||
{
|
||||
New(1,tmp_ber[ix_av],1,struct berval);
|
||||
current_val = av_fetch((AV *)SvRV(avref),ix_av,0);
|
||||
|
||||
tmp_char = SvPV(*current_val,na);
|
||||
val_len = SvCUR(*current_val);
|
||||
|
||||
Newz(1,tmp_char,val_len+1,char);
|
||||
Copy(SvPV(*current_val,na),tmp_char,val_len,char);
|
||||
tmp_ber[ix_av]->bv_val = tmp_char;
|
||||
Newz(1,tmp2,val_len+1,char);
|
||||
Copy(tmp_char,tmp2,val_len,char);
|
||||
|
||||
tmp_ber[ix_av]->bv_val = tmp2;
|
||||
tmp_ber[ix_av]->bv_len = val_len;
|
||||
}
|
||||
tmp_ber[ix_av] = NULL;
|
||||
|
|
@ -479,6 +484,13 @@ void
|
|||
ldap_ber_free(ber,freebuf)
|
||||
BerElement * ber
|
||||
int freebuf
|
||||
CODE:
|
||||
{
|
||||
if (ber)
|
||||
{
|
||||
ldap_ber_free(ber,freebuf);
|
||||
}
|
||||
}
|
||||
|
||||
int
|
||||
ldap_bind(ld,dn,passwd,authmethod)
|
||||
|
|
@ -587,7 +599,8 @@ ldap_create_filter(buf,buflen,pattern,prefix,suffix,attr,value,valwords)
|
|||
char * value
|
||||
char ** valwords
|
||||
CLEANUP:
|
||||
ldap_value_free(valwords);
|
||||
if (valwords)
|
||||
ldap_value_free(valwords);
|
||||
|
||||
#ifdef LDAPV3
|
||||
|
||||
|
|
@ -720,7 +733,8 @@ ldap_extended_operation_s(ld,requestoid,requestdata,serverctrls,clientctrls,reto
|
|||
retoidp
|
||||
retdatap
|
||||
CLEANUP:
|
||||
ldap_value_free_len(retdatap);
|
||||
if (retdatap)
|
||||
ldap_value_free_len(retdatap);
|
||||
|
||||
#endif
|
||||
|
||||
|
|
@ -957,7 +971,8 @@ ldap_memcache_init(ttl,size,baseDNs,cachep)
|
|||
RETVAL
|
||||
cachep
|
||||
CLEANUP:
|
||||
ldap_value_free(baseDNs);
|
||||
if (baseDNs)
|
||||
ldap_value_free(baseDNs);
|
||||
|
||||
int
|
||||
ldap_memcache_set(ld,cache)
|
||||
|
|
@ -1052,6 +1067,15 @@ ldap_mods_free(mods,freemods)
|
|||
int
|
||||
ldap_msgfree(lm)
|
||||
LDAPMessage * lm
|
||||
CODE:
|
||||
{
|
||||
if (lm)
|
||||
{
|
||||
RETVAL = ldap_msgfree(lm);
|
||||
}
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
int
|
||||
ldap_msgid(lm)
|
||||
|
|
@ -1074,7 +1098,8 @@ ldap_multisort_entries(ld,chain,attr)
|
|||
RETVAL
|
||||
chain
|
||||
CLEANUP:
|
||||
ldap_value_free(attr);
|
||||
if (attr)
|
||||
ldap_value_free(attr);
|
||||
|
||||
char *
|
||||
ldap_next_attribute(ld,entry,ber)
|
||||
|
|
@ -1285,7 +1310,8 @@ ldap_search(ld,base,scope,filter,attrs,attrsonly)
|
|||
char ** attrs
|
||||
int attrsonly
|
||||
CLEANUP:
|
||||
ldap_value_free(attrs);
|
||||
if (attrs)
|
||||
ldap_value_free(attrs);
|
||||
|
||||
#ifdef LDAPV3
|
||||
|
||||
|
|
@ -1306,7 +1332,8 @@ ldap_search_ext(ld,base,scope,filter,attrs,attrsonly,serverctrls,clientctrls,tim
|
|||
RETVAL
|
||||
msgidp
|
||||
CLEANUP:
|
||||
ldap_value_free(attrs);
|
||||
if (attrs)
|
||||
ldap_value_free(attrs);
|
||||
|
||||
int
|
||||
ldap_search_ext_s(ld,base,scope,filter,attrs,attrsonly,serverctrls,clientctrls,timeoutp,sizelimit,res)
|
||||
|
|
@ -1325,7 +1352,8 @@ ldap_search_ext_s(ld,base,scope,filter,attrs,attrsonly,serverctrls,clientctrls,t
|
|||
RETVAL
|
||||
res
|
||||
CLEANUP:
|
||||
ldap_value_free(attrs);
|
||||
if (attrs)
|
||||
ldap_value_free(attrs);
|
||||
|
||||
#endif
|
||||
|
||||
|
|
@ -1342,7 +1370,8 @@ ldap_search_s(ld,base,scope,filter,attrs,attrsonly,res)
|
|||
RETVAL
|
||||
res
|
||||
CLEANUP:
|
||||
ldap_value_free(attrs);
|
||||
if (attrs)
|
||||
ldap_value_free(attrs);
|
||||
|
||||
int
|
||||
ldap_search_st(ld,base,scope,filter,attrs,attrsonly,timeout,res)
|
||||
|
|
@ -1358,7 +1387,8 @@ ldap_search_st(ld,base,scope,filter,attrs,attrsonly,timeout,res)
|
|||
RETVAL
|
||||
res
|
||||
CLEANUP:
|
||||
ldap_value_free(attrs);
|
||||
if (attrs)
|
||||
ldap_value_free(attrs);
|
||||
|
||||
int
|
||||
ldap_set_filter_additions(lfdp,prefix,suffix)
|
||||
|
|
|
|||
|
|
@ -1,6 +1,216 @@
|
|||
1999-01-06 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
* Conn.pm (nextEntry): Fixed (tried to fix...) the bug with
|
||||
missing attributes. I hope this will work, at a minimum I'm sure
|
||||
it won't hurt. The idea is to keep the case on the attribute type
|
||||
when requesting the values_len().
|
||||
|
||||
1999-01-11 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
* API.xs: Added IF statements around all ldap_value_free() calls.
|
||||
|
||||
1999-01-05 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
* Conn.pm (getRes): Ooops, didn't return the appropriate
|
||||
value... :(
|
||||
(init): Changed test for LDAP_SUCCESS, to always return 0 or 1.
|
||||
(close): Dito.
|
||||
(delete): Dito.
|
||||
(add): Dito.
|
||||
(modifyRDN): Dito.
|
||||
(update): Dito.
|
||||
(simpleAuth): Dito.
|
||||
|
||||
* Entry.pm (NEXTKEY): Don't return the last $key if it's one that
|
||||
should be hidden.
|
||||
|
||||
* Conn.pm (newEntry): New method, to create an empty LDAP::Entry
|
||||
object. It is properly "tied" into the appropriate object.
|
||||
|
||||
1999-01-04 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
* Entry.pm (setDN): Added third optional argument, to enfoce DN
|
||||
normalization.
|
||||
(getDN): Dito.
|
||||
(hasDNValue): Dito.
|
||||
(matchDNValue): Dito.
|
||||
|
||||
* Entry.pm (removeValue): Added support for DN normalization
|
||||
(optional argument).
|
||||
(addValue): Dito
|
||||
(getDN): Dito.
|
||||
|
||||
1998-12-31 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
* Entry.pm (DESTROY): Added this method, don't know if it actually
|
||||
makes any sense at all... :(
|
||||
|
||||
* Conn.pm (add): Use _oc_order_ to find a list of attributes, to
|
||||
avoide calling the TIEHASH methods.
|
||||
(update): Dito.
|
||||
(ALL): Clean out some "my" definitions.
|
||||
|
||||
* Entry.pm (unRemove): New function, to undo remove opertaions on
|
||||
an attribute.
|
||||
(DELETE): Bug-fix, don't undef the attribute, it would prevent us
|
||||
from updating it properly in the Conn::update() method.
|
||||
(remove): Dito.
|
||||
|
||||
* Conn.pm (nextEntry): Return $obj instead of blessing the %entry
|
||||
(again).
|
||||
|
||||
1998-12-25 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
* Conn.pm (POD): Changed examples from $conn -> $entry.
|
||||
|
||||
1998-12-17 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
* Conn.pm (DESTROY): undef the Perl data after doing a
|
||||
ldap_msgfree(), bug #1964.
|
||||
(search): Dito.
|
||||
(searchURL): Dito.
|
||||
(nextEntry): Changed the order of setting numattr, to make sure
|
||||
it's zero if we don't find anything.
|
||||
|
||||
1998-12-16 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
* Entry.pm (FIRSTKEY): Modified to honor the oc_order.
|
||||
(NEXTKEY): Dito.
|
||||
(markModified): Made as an alias for attrModified().
|
||||
|
||||
* Conn.pm (nextEntry): Added code to handle internal counters for
|
||||
number of attributes in oc_order. This is used/needed for the
|
||||
FIRSTKEY and NEXTKEY methods in the Entry/Tie::Hash object.
|
||||
|
||||
* Entry.pm (isAttr): New method, to make sure an attribute name
|
||||
really is a valid LDAP attribute.
|
||||
(FIRSTKEY): Now we'll handle each() and keys() properly, whooohoo!
|
||||
(NEXTKEY): Dito.
|
||||
|
||||
1998-12-15 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
* Entry.pm (isDeleted): Added new method, almost identical to isModified().
|
||||
(EXISTS): New method, to implement the EXISTS functionality.
|
||||
|
||||
* API.xs (RET_CPP): Test for NULL pointers, bug #1387.
|
||||
(RET_BVPP): Dito.
|
||||
|
||||
* Utils.pm (ldapArgs): Fixed bug where "-s 0" would not be honored
|
||||
(I'm an idiot, OK?).
|
||||
|
||||
1998-12-14 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
* Conn.pm (getRes): New method, to return the internal result message.
|
||||
(getLD): Use defined() around test for existence.
|
||||
|
||||
1998-12-11 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
* Conn.pm (new): Make sure binddn and bindpasswd are set to the
|
||||
empty string unless specified.
|
||||
(init): Make sure certdb is defined before trying to use it.
|
||||
(setDefaultRebindProc): Added default auth method, unless
|
||||
explicitly specified.
|
||||
|
||||
* Utils.pm (askPassword): Added support for Term::ReadKey.
|
||||
(askPassword): Moved the eval "use ..." here.
|
||||
(userCredentials): Removed verbose print statement.
|
||||
(askPassword): Added an optional argument to print a prompt;
|
||||
|
||||
* Conn.pm (setDefaultRebindProc): Added a default "auth" value, if
|
||||
not provided in the call.
|
||||
|
||||
1998-12-04 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
* Makefile.PL: Modified so that "silent" install will actually
|
||||
echo what options it's setting.
|
||||
It will now croak() if the SDK dir specified doesn't exist.
|
||||
|
||||
* INSTALL: Updated to reflect new v1.1 stuff. Added links to the
|
||||
FAQ.
|
||||
|
||||
* README: Dito. Also changed some of the binary install
|
||||
information, which might not be useful anyways...
|
||||
|
||||
* Makefile.PL: Added "filters" to remove .dll and .sl from shared
|
||||
libraries when creating link options. I also replaced the code to
|
||||
put the valid library extensions into a variable (bug #1344).
|
||||
|
||||
* Makefile.PL: Fixed some crap with the config parsing, and ENV
|
||||
handling (for silent installs).
|
||||
|
||||
1998-12-03 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
* Conn.pm (update): Bug fix, now we empty the hash array before
|
||||
examining changed attributes (bug #1385).
|
||||
|
||||
* Makefile.PL: Added the "-nolinenumbers" XSUBS options (bug #1329).
|
||||
|
||||
1998-09-26 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
* Conn.pm (init): Cleaned out _perror() calls.
|
||||
(delete): Added support for calling delete() with an Entry::
|
||||
object as paramter.
|
||||
(new): Cleaned out some dead code for $ref.
|
||||
|
||||
* Entry.pm (setValue): New method, to avoid having to use Perl
|
||||
assignment statements to set an entire attribute value.
|
||||
|
||||
1998-09-18 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
* Conn.pm (init): Changed call to ldapssl_client_init() to pass a
|
||||
0 value as the handle pointer. This avoids a Perl compiler warning.
|
||||
|
||||
1998-09-12 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
* LDIF.pm (readEntries): Changed tests for empty arguments, to use
|
||||
defined().
|
||||
|
||||
* Utils.pm (ldapArgs): Bug fix, we used the wrong option for the
|
||||
certificate (-P) when checking to set the LDAP port.
|
||||
(normalizeDN): Chagned tests for empty arguments, to use use defined().
|
||||
|
||||
* Entry.pm (STORE): Changed tests for empty arguments, to use
|
||||
defined().
|
||||
(DELETE): Dito.
|
||||
(attrModified): Dito.
|
||||
(isModified): Dito.
|
||||
(remove): Dito.
|
||||
(removeValue): Dito.
|
||||
(addValue): Dito.
|
||||
(hasValue): Dito.
|
||||
(matchValue): Dito.
|
||||
(setDN): Dito.
|
||||
(size): Dito.
|
||||
(exists): Dito.
|
||||
|
||||
* Conn.pm (printError): Changed test for $str to see if it's defined.
|
||||
(delete): Cleaned up code around $dn.
|
||||
(modifyRDN): Cleaned up testes around $dn and $del.
|
||||
|
||||
1998-09-11 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
* Conn.pm (modifyRDN): We now preserve the case of the DN/RDN, but
|
||||
still treat RDNs as CIS when comparing strings.
|
||||
|
||||
1998-09-08 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
* Conn.pm (setDefaultRebindProc): Bug fix, it had the Ldapc:: crap
|
||||
stil in there... :-(.
|
||||
(simpleAuth): New method, to do simple authentication rebind.
|
||||
|
||||
1998-09-07 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
* Makefile.PL: Changed all <> to <STDIN>, to support command line
|
||||
arguments for MakeMaker.
|
||||
|
||||
1998-09-03 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
* Conn.pm (nextEntry): Fixed bug with case sensitivity.
|
||||
|
||||
1998-08-18 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
* Conn.pm (setDefaultRebindProc): It's back!
|
||||
Officially released PerLDAP v1.0.
|
||||
|
||||
1998-08-13 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#############################################################################
|
||||
# $Id: Conn.pm,v 1.18 1998-08-18 22:26:30 leif%netscape.com Exp $
|
||||
# $Id: Conn.pm,v 1.19 1999-01-21 23:52:42 leif%netscape.com Exp $
|
||||
#
|
||||
# The contents of this file are subject to the Mozilla Public License
|
||||
# Version 1.0 (the "License"); you may not use this file except in
|
||||
|
|
@ -43,9 +43,7 @@ sub new
|
|||
{
|
||||
my $class = shift;
|
||||
my $self = {};
|
||||
my $ref;
|
||||
|
||||
$ref = ref($_[$[]);
|
||||
if (ref $_[$[] eq "HASH")
|
||||
{
|
||||
my $hash;
|
||||
|
|
@ -68,11 +66,13 @@ sub new
|
|||
$self->{"certdb"} = $certdb;
|
||||
}
|
||||
|
||||
$self->{"binddn"} = "" unless defined $self->{"binddn"};
|
||||
$self->{"bindpasswd"} = "" unless defined $self->{"bindpasswd"};
|
||||
|
||||
if (!defined($self->{"port"}) || ($self->{"port"} eq ""))
|
||||
{
|
||||
$self->{"port"} = (($self->{"certdb"} ne "") ? LDAPS_PORT : LDAP_PORT);
|
||||
}
|
||||
|
||||
bless $self, $class;
|
||||
|
||||
return unless $self->init();
|
||||
|
|
@ -90,7 +90,11 @@ sub DESTROY
|
|||
return unless defined($self->{"ld"});
|
||||
|
||||
ldap_unbind_s($self->{"ld"});
|
||||
ldap_msgfree($self->{"ldres"}) if defined($self->{"ldres"});
|
||||
if (defined($self->{"ldres"}))
|
||||
{
|
||||
ldap_msgfree($self->{"ldres"});
|
||||
undef $self->{"ldres"};
|
||||
}
|
||||
|
||||
undef $self->{"ld"};
|
||||
}
|
||||
|
|
@ -103,12 +107,11 @@ sub DESTROY
|
|||
sub init
|
||||
{
|
||||
my $self = shift;
|
||||
my $ret;
|
||||
my $ld;
|
||||
my ($ret, $ld);
|
||||
|
||||
if ($self->{"certdb"} ne "")
|
||||
if (defined($self->{"certdb"}) && ($self->{"certdb"} ne ""))
|
||||
{
|
||||
$ret = ldapssl_client_init($self->{"certdb"}, "");
|
||||
$ret = ldapssl_client_init($self->{"certdb"}, 0);
|
||||
return 0 if ($ret < 0);
|
||||
|
||||
$ld = ldapssl_init($self->{"host"}, $self->{"port"}, 1);
|
||||
|
|
@ -117,24 +120,27 @@ sub init
|
|||
{
|
||||
$ld = ldap_init($self->{"host"}, $self->{"port"});
|
||||
}
|
||||
if (!$ld)
|
||||
{
|
||||
perror("ldap_init");
|
||||
|
||||
return 0;
|
||||
}
|
||||
return 0 unless $ld;
|
||||
|
||||
$self->{"ld"} = $ld;
|
||||
$ret = ldap_simple_bind_s($ld, $self->{"binddn"}, $self->{"bindpasswd"});
|
||||
|
||||
if ($ret)
|
||||
{
|
||||
ldap_perror($ld, "Authentication failed");
|
||||
return (($ret == LDAP_SUCCESS) ? 1 : 0);
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
return 1;
|
||||
#############################################################################
|
||||
# Create a new, empty, Entry object, properly tied into the Entry class.
|
||||
# This is mostly for convenience, you could directly do the "tie" yourself
|
||||
# in your code.
|
||||
#
|
||||
sub newEntry
|
||||
{
|
||||
my %entry = ();
|
||||
|
||||
tie %entry, Mozilla::LDAP::Entry;
|
||||
|
||||
return bless \%entry, Mozilla::LDAP::Entry;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -157,7 +163,19 @@ sub getLD
|
|||
{
|
||||
my ($self) = @_;
|
||||
|
||||
return $self->{"ld"} if $self->{"ld"};
|
||||
return $self->{"ld"} if defined($self->{"ld"});
|
||||
}
|
||||
|
||||
|
||||
#############################################################################
|
||||
# Return the actual the current result message, don't use this unless you
|
||||
# really have to...
|
||||
#
|
||||
sub getRes
|
||||
{
|
||||
my ($self) = @_;
|
||||
|
||||
return $self->{"ldres"} if defined($self->{"ldres"});
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -182,7 +200,7 @@ sub getErrorCode
|
|||
sub getErrorString
|
||||
{
|
||||
my ($self) = @_;
|
||||
my ($err);
|
||||
my $err;
|
||||
|
||||
$err = ldap_get_lderrno($self->{"ld"}, undef, undef);
|
||||
|
||||
|
|
@ -197,7 +215,7 @@ sub printError
|
|||
{
|
||||
my ($self, $str) = @_;
|
||||
|
||||
$str = "LDAP error: " if ($str eq "");
|
||||
$str = "LDAP error: " unless defined($str);
|
||||
ldap_perror($self->{"ld"}, $str);
|
||||
}
|
||||
|
||||
|
|
@ -209,14 +227,17 @@ sub printError
|
|||
sub search
|
||||
{
|
||||
my ($self, $basedn, $scope, $filter, $attrsonly, @attrs) = @_;
|
||||
my $resv;
|
||||
my $entry;
|
||||
my ($resv, $entry);
|
||||
my $res = \$resv;
|
||||
|
||||
$scope = Mozilla::LDAP::Utils::str2Scope($scope);
|
||||
$filter = "(objectclass=*)" if ($filter =~ /^ALL$/i);
|
||||
|
||||
ldap_msgfree($self->{"ldres"}) if defined($self->{"ldres"});
|
||||
if (defined($self->{"ldres"}))
|
||||
{
|
||||
ldap_msgfree($self->{"ldres"});
|
||||
undef $self->{"ldres"};
|
||||
}
|
||||
if (ldap_is_ldap_url($filter))
|
||||
{
|
||||
if (! ldap_url_search_s($self->{"ld"}, $filter, $attrsonly, $res))
|
||||
|
|
@ -247,11 +268,15 @@ sub search
|
|||
sub searchURL
|
||||
{
|
||||
my ($self, $url, $attrsonly) = @_;
|
||||
my $resv;
|
||||
my $entry;
|
||||
my ($resv, $entry);
|
||||
my $res = \$resv;
|
||||
|
||||
ldap_msgfree($self->{"ldres"}) if defined($self->{"ldres"});
|
||||
if (defined($self->{"ldres"}))
|
||||
{
|
||||
ldap_msgfree($self->{"ldres"});
|
||||
undef $self->{"ldres"};
|
||||
}
|
||||
|
||||
if (! ldap_url_search_s($self->{"ld"}, $url, $attrsonly, $res))
|
||||
{
|
||||
$self->{"ldres"} = $res;
|
||||
|
|
@ -270,9 +295,8 @@ sub searchURL
|
|||
sub nextEntry
|
||||
{
|
||||
my $self = shift;
|
||||
my %entry;
|
||||
my @ocorder;
|
||||
my ($attr, @vals, $obj, $ldentry, $berv, $dn);
|
||||
my (%entry, @ocorder, @vals);
|
||||
my ($attr, $lcattr, $obj, $ldentry, $berv, $dn, $count);
|
||||
my $ber = \$berv;
|
||||
|
||||
# I use the object directly, to avoid setting the "change" flags
|
||||
|
|
@ -294,24 +318,33 @@ sub nextEntry
|
|||
return "" unless $ldentry;
|
||||
|
||||
$dn = ldap_get_dn($self->{"ld"}, $self->{"ldentry"});
|
||||
$obj->{"_oc_numattr_"} = 0;
|
||||
$obj->{"_oc_keyidx_"} = 0;
|
||||
$obj->{"dn"} = $dn;
|
||||
$self->{"dn"} = $dn;
|
||||
|
||||
$attr = ldap_first_attribute($self->{"ld"}, $self->{"ldentry"}, $ber);
|
||||
return (bless \%entry, Mozilla::LDAP::Entry) unless $attr;
|
||||
|
||||
$lcattr = lc $attr;
|
||||
@vals = ldap_get_values_len($self->{"ld"}, $self->{"ldentry"}, $attr);
|
||||
$obj->{$attr} = [@vals];
|
||||
push(@ocorder, $attr);
|
||||
$obj->{$lcattr} = [@vals];
|
||||
push(@ocorder, $lcattr);
|
||||
|
||||
$count = 1;
|
||||
while ($attr = ldap_next_attribute($self->{"ld"},
|
||||
$self->{"ldentry"}, $ber))
|
||||
{
|
||||
$lcattr = lc $attr;
|
||||
@vals = ldap_get_values_len($self->{"ld"}, $self->{"ldentry"}, $attr);
|
||||
$obj->{$attr} = [@vals];
|
||||
push(@ocorder, $attr);
|
||||
$obj->{$lcattr} = [@vals];
|
||||
push(@ocorder, $lcattr);
|
||||
$count++;
|
||||
}
|
||||
|
||||
$obj->{"_oc_order_"} = \@ocorder;
|
||||
$obj->{"_self_obj_"} = $obj;
|
||||
$obj->{"_oc_numattr_"} = $count;
|
||||
|
||||
ldap_ber_free($ber, 0) if $ber;
|
||||
|
||||
|
|
@ -333,7 +366,7 @@ sub close
|
|||
$ret = ldap_unbind_s($self->{"ld"}) if defined($self->{"ld"});
|
||||
undef $self->{"ld"};
|
||||
|
||||
return ($ret == LDAP_SUCCESS);
|
||||
return (($ret == LDAP_SUCCESS) ? 1 : 0);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -342,20 +375,23 @@ sub close
|
|||
#
|
||||
sub delete
|
||||
{
|
||||
my ($self, $dn) = @_;
|
||||
my ($self, $id) = @_;
|
||||
my $ret = 1;
|
||||
my $dn = $id;
|
||||
|
||||
if ($dn ne "")
|
||||
if (ref($id) eq "Mozilla::LDAP::Entry")
|
||||
{
|
||||
$dn = Mozilla::LDAP::Utils::normalizeDN($dn);
|
||||
$dn = $id->getDN();
|
||||
}
|
||||
else
|
||||
{
|
||||
$dn = Mozilla::LDAP::Utils::normalizeDN($self->{"dn"});
|
||||
$dn = $self->{"dn"} unless (defined($dn) && ($dn ne ""));
|
||||
}
|
||||
|
||||
$dn = Mozilla::LDAP::Utils::normalizeDN($dn);
|
||||
$ret = ldap_delete_s($self->{"ld"}, $dn) if ($dn ne "");
|
||||
|
||||
return ($ret == LDAP_SUCCESS)
|
||||
return (($ret == LDAP_SUCCESS) ? 1 : 0);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -365,14 +401,14 @@ sub delete
|
|||
sub add
|
||||
{
|
||||
my ($self, $entry) = @_;
|
||||
my ($ref, $key, $val, %ent);
|
||||
my $ret = 1;
|
||||
my $gotcha = 0;
|
||||
my %ent;
|
||||
my ($ref, $key, $val);
|
||||
my ($ret, $gotcha) = (1, 0);
|
||||
|
||||
$ref = ref($entry);
|
||||
if (($ref eq "Mozilla::LDAP::Entry") || ($ref eq "HASH"))
|
||||
{
|
||||
foreach $key (keys %{$entry})
|
||||
foreach $key (@{$entry->{"_oc_order_"}})
|
||||
{
|
||||
next if (($key eq "dn") || ($key =~ /^_.+_$/));
|
||||
$ent{$key} = $entry->{$key};
|
||||
|
|
@ -382,25 +418,27 @@ sub add
|
|||
$ret = ldap_add_s($self->{"ld"}, $entry->{"dn"}, \%ent) if $gotcha;
|
||||
}
|
||||
|
||||
return ($ret == LDAP_SUCCESS);
|
||||
return (($ret == LDAP_SUCCESS) ? 1 : 0);
|
||||
}
|
||||
|
||||
|
||||
#############################################################################
|
||||
# Modify the RDN, and update the entry accordingly. Note that the last
|
||||
# two arguments (DN and "delete") are optional.
|
||||
# two arguments (DN and "delete") are optional. The last (optional) argument
|
||||
# is a flag, which if set to TRUE (the default), will cause the corresponding
|
||||
# attribute value to be removed from the entry.
|
||||
#
|
||||
sub modifyRDN
|
||||
{
|
||||
my ($self, $rdn, $dn, $del) = ($_[$[], lc $_[$[ + 1], $_[$[ + 2], $_[$[ + 3]);
|
||||
my (@vals);
|
||||
my ($self, $rdn, $dn, $del) = ($_[$[], $_[$[ + 1], $_[$[ + 2], $_[$[ + 3]);
|
||||
my @vals;
|
||||
my $ret = 1;
|
||||
|
||||
$del = 1 if ($del eq "");
|
||||
$dn = $self->{"dn"} if ($dn eq "");
|
||||
$del = 1 unless (defined($del) && ($del ne ""));
|
||||
$dn = $self->{"dn"} unless (defined($dn) && ($dn ne ""));
|
||||
|
||||
@vals = ldap_explode_dn(lc $dn, 0);
|
||||
if ($vals[$[] ne $rdn)
|
||||
@vals = ldap_explode_dn($dn, 0);
|
||||
if (lc($vals[$[]) ne lc($rdn))
|
||||
{
|
||||
$ret = ldap_modrdn2_s($self->{"ld"}, $dn, $rdn, $del);
|
||||
if ($ret == LDAP_SUCCESS)
|
||||
|
|
@ -411,7 +449,7 @@ sub modifyRDN
|
|||
}
|
||||
}
|
||||
|
||||
return ($ret == LDAP_SUCCESS);
|
||||
return (($ret == LDAP_SUCCESS) ? 1 : 0);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -422,14 +460,14 @@ sub modifyRDN
|
|||
sub update
|
||||
{
|
||||
my ($self, $entry) = @_;
|
||||
my (@vals, %mod, %new, @arr);
|
||||
my (@vals, @arr, %mod, %new);
|
||||
my ($key, $val);
|
||||
my $ret = 1;
|
||||
local $_;
|
||||
|
||||
foreach $key (keys (%$entry))
|
||||
foreach $key (@{$entry->{"_oc_order_"}})
|
||||
{
|
||||
next if (($key eq "dn") || ($key =~ /^_.+_/));
|
||||
next if (($key eq "dn") || ($key =~ /^_.+_$/));
|
||||
|
||||
if ($entry->{"_${key}_modified_"})
|
||||
{
|
||||
|
|
@ -441,6 +479,7 @@ sub update
|
|||
else
|
||||
{
|
||||
@arr = ();
|
||||
undef %new;
|
||||
grep(($new{$_} = 1), @vals);
|
||||
foreach (@{$entry->{"_${key}_save_"}})
|
||||
{
|
||||
|
|
@ -461,13 +500,15 @@ sub update
|
|||
}
|
||||
|
||||
delete $entry->{"_self_obj_"}->{"_${key}_modified_"};
|
||||
undef @{$entry->{"_${key}_save_"}};
|
||||
undef @{$entry->{"_${key}_save_"}} if
|
||||
defined $entry->{"_${key}_save_"};
|
||||
}
|
||||
elsif ($entry->{"_${key}_deleted_"})
|
||||
{
|
||||
$mod{$key} = { "db", [] };
|
||||
undef @{$entry->{"_${key}_save_"}};
|
||||
delete $entry->{"_self_obj_"}->{"_${key}_deleted_"};
|
||||
undef @{$entry->{"_${key}_save_"}} if
|
||||
defined $entry->{"_${key}_save_"};
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -492,7 +533,7 @@ sub update
|
|||
$ret = ldap_modify_s($self->{"ld"}, $entry->{"dn"}, \%mod)
|
||||
if ($#arr >= $[);
|
||||
|
||||
return ($ret == LDAP_SUCCESS);
|
||||
return (($ret == LDAP_SUCCESS) ? 1 : 0);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -516,10 +557,25 @@ sub setDefaultRebindProc
|
|||
{
|
||||
my ($self, $dn, $pswd, $auth) = @_;
|
||||
|
||||
$auth = LDAP_AUTH_SIMPLE unless defined($auth);
|
||||
die "No LDAP connection"
|
||||
unless defined($self->{ld});
|
||||
|
||||
Ldapc::ldap_set_default_rebind_proc($self->{"ld"}, $dn, $pswd, $auth);
|
||||
ldap_set_default_rebind_proc($self->{"ld"}, $dn, $pswd, $auth);
|
||||
}
|
||||
|
||||
|
||||
#############################################################################
|
||||
# Do a simple authentication, so that we can rebind as another user.
|
||||
#
|
||||
sub simpleAuth
|
||||
{
|
||||
my ($self, $dn, $pswd) = @_;
|
||||
my $ret;
|
||||
|
||||
$ret = ldap_simple_bind_s($self->{"ld"}, $dn, $pswd);
|
||||
|
||||
return (($ret == LDAP_SUCCESS) ? 1 : 0);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -766,8 +822,9 @@ the B<searchURL> method, add a second argument, which should be 0 or 1.
|
|||
|
||||
Once you have an LDAP entry, either from a search, or created directly to
|
||||
get a new empty object, you are ready to modify it. If you are creating a
|
||||
new entry, the first thing to set it it's DN:
|
||||
new entry, the first thing to set it it's DN, like
|
||||
|
||||
$entry = $conn->newEntry();
|
||||
$entry->setDN("uid=leif,ou=people,o=netscape.com");
|
||||
|
||||
You should not do this for an existing LDAP entry, changing the RDN (or
|
||||
|
|
@ -795,18 +852,19 @@ server, just call the B<delete> method, like
|
|||
|
||||
You can't use native Perl functions like push() and splice() on attribute
|
||||
values, since they won't update the ::Entry instance state properly.
|
||||
Instead use one of the methods provided by the object class, for instance
|
||||
Instead use one of the methods provided by the Mozilla::LDAP::Entry
|
||||
object class, for instance
|
||||
|
||||
$conn->addValue("cn", "The Swede");
|
||||
$conn->removeValue("mailAlternateAddress", "leif@mcom.com");
|
||||
$conn->remove("seeAlso");
|
||||
$entry->addValue("cn", "The Swede");
|
||||
$entry->removeValue("mailAlternateAddress", "leif@mcom.com");
|
||||
$entry->remove("seeAlso");
|
||||
|
||||
These methods return a TRUE or FALSE value, depending on the outcome
|
||||
of the operation. If there was no value to remove, or a value already
|
||||
exists, we return FALSE, otherwise TRUE. To check if an attribute has a
|
||||
certain value, use the B<hasValue> method, like
|
||||
|
||||
if ($conn->hasValue("mail", "leif@netscape.com")) {
|
||||
if ($entry->hasValue("mail", "leif@netscape.com")) {
|
||||
# Do something
|
||||
}
|
||||
|
||||
|
|
@ -876,6 +934,16 @@ This method will return the next entry from the search result, and can
|
|||
therefore only be called after a succesful search has been initiated. If
|
||||
there are no more entries to retrieve, it returns nothing (empty string).
|
||||
|
||||
=item B<newEntry>
|
||||
|
||||
This will create an empty Mozilla::LDAP::Entry object, which is properly
|
||||
tied into the appropriate objectclass. Use this method instead of manually
|
||||
creating new Entry objects, or at least make sure that you use the "tie"
|
||||
function when creating the entry. This function takes no arguments, and
|
||||
returns a pointer to an ::Entry object. For instance
|
||||
|
||||
$entry = $conn->newEntry();
|
||||
|
||||
=item B<update>
|
||||
|
||||
After modifying an Ldap::Entry entry (see below), use the B<update>
|
||||
|
|
@ -902,6 +970,27 @@ B<search> or B<entry>.
|
|||
Add a new entry to the LDAP server. Make sure you use the B<new> method
|
||||
for the Mozilla::LDAP::Entry object, to create a proper entry.
|
||||
|
||||
=item B<simpleAuth>
|
||||
|
||||
This method will rebind the LDAP connection using new credentials (i.e. a
|
||||
new user-DN and password). To rebind "anonymously", just don't pass a DN
|
||||
and password, and it will default to binding as the unprivleged user. For
|
||||
example:
|
||||
|
||||
$user = "leif";
|
||||
$password = "secret";
|
||||
$conn = new Mozilla::LDAP::Conn($host, $port); # Anonymous bind
|
||||
die "Could't connect to LDAP server $host" unless $conn;
|
||||
|
||||
$entry = $conn->search($root, $scope, "(uid=$user)", 0, (uid));
|
||||
exit (-1) unless $entry;
|
||||
|
||||
$ret = $conn->simpleAuth($entry->getDN(), $password);
|
||||
exit (-1) unless $ret;
|
||||
|
||||
$ret = $conn->simpleAuth(); # Bind as anon again.
|
||||
|
||||
|
||||
=item B<close>
|
||||
|
||||
Close the LDAP connection, and clean up the object. If you don't call this
|
||||
|
|
@ -931,6 +1020,18 @@ Return the (internal) LDAP* connection handle, which you can use
|
|||
(carefully) to call the native LDAP API functions. You shouldn't have to
|
||||
use this in most cases, unless of course our OO layer is seriously flawed.
|
||||
|
||||
=item B<getRes>
|
||||
|
||||
Just like B<getLD>, except it returns the internal LDAP return message
|
||||
structure. Again, use this very carefully, and be aware that this might
|
||||
break in future releases of PerLDAP. These two methods can be used to call
|
||||
some useful API functions, like
|
||||
|
||||
$cld = $conn->getLD();
|
||||
$res = $conn->getRes();
|
||||
$count = Mozilla::LDAP::API::ldap_count_entries($cld, $res);
|
||||
|
||||
|
||||
=item B<getErrorCode>
|
||||
|
||||
Return the error code (numeric) from the last LDAP API function
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#############################################################################
|
||||
# $Id: Entry.pm,v 1.9 1998-08-13 21:31:36 leif Exp $
|
||||
# $Id: Entry.pm,v 1.10 1999-01-21 23:52:42 leif%netscape.com Exp $
|
||||
#
|
||||
# The contents of this file are subject to the Mozilla Public License
|
||||
# Version 1.0 (the "License"); you may not use this file except in
|
||||
|
|
@ -28,6 +28,7 @@
|
|||
|
||||
package Mozilla::LDAP::Entry;
|
||||
|
||||
use Mozilla::LDAP::Utils qw(normalizeDN);
|
||||
require Tie::Hash;
|
||||
@ISA = (Tie::StdHash);
|
||||
|
||||
|
|
@ -47,7 +48,7 @@ sub TIEHASH
|
|||
|
||||
|
||||
#############################################################################
|
||||
# Destructor, does nothing really...
|
||||
# Destructor.
|
||||
#
|
||||
#sub DESTROY
|
||||
#{
|
||||
|
|
@ -61,7 +62,8 @@ sub STORE
|
|||
{
|
||||
my ($self, $attr, $val) = ($_[$[], lc $_[$[ + 1], $_[$[ + 2]);
|
||||
|
||||
return if (($val eq "") || ($attr eq ""));
|
||||
return unless (defined($val) && ($val ne ""));
|
||||
return unless (defined($attr) && ($attr ne ""));
|
||||
|
||||
if (defined($self->{$attr}))
|
||||
{
|
||||
|
|
@ -75,6 +77,7 @@ sub STORE
|
|||
if (($attr ne "dn") && !grep(/^$attr$/i, @{$self->{"_oc_order_"}}))
|
||||
{
|
||||
push(@{$self->{"_oc_order_"}}, $attr);
|
||||
$self->{"_oc_numattr_"}++;
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -87,23 +90,86 @@ sub FETCH
|
|||
my ($self, $attr) = ($_[$[], lc $_[$[ + 1]);
|
||||
|
||||
return unless defined($self->{$attr});
|
||||
return if $self->{"_${attr}_deleted_"};
|
||||
|
||||
return $self->{$attr};
|
||||
}
|
||||
|
||||
|
||||
#############################################################################
|
||||
# Delete method, to keep track of changes.
|
||||
# Delete method, to keep track of changes. Note that we actually don't
|
||||
# delete the attribute, just mark it as deleted.
|
||||
#
|
||||
sub DELETE
|
||||
{
|
||||
my ($self, $attr) = ($_[$[], lc $_[$[ + 1]);
|
||||
|
||||
return if ($attr eq "");
|
||||
return unless (defined($attr) && ($attr ne ""));
|
||||
return unless defined($self->{$attr});
|
||||
|
||||
$self->{"_${attr}_deleted_"} = 1;
|
||||
undef $self->{$attr};
|
||||
}
|
||||
|
||||
|
||||
#############################################################################
|
||||
# See if an attribute/key exists in the entry (could still be undefined).
|
||||
#
|
||||
sub EXISTS
|
||||
{
|
||||
my ($self, $attr) = ($_[$[], lc $_[$[ + 1]);
|
||||
|
||||
return 0 unless (defined($attr) && ($attr ne ""));
|
||||
return 0 if $self->{"_${attr}_deleted_"};
|
||||
|
||||
return exists $self->{$attr};
|
||||
}
|
||||
|
||||
|
||||
#############################################################################
|
||||
# Reset the each()/key() session, and return the first key. This honors
|
||||
# the oc_order, i.e. the order the attributes were returned in.
|
||||
#
|
||||
sub FIRSTKEY
|
||||
{
|
||||
my ($self, $idx) = ($_[$[], 0);
|
||||
my @attrs = @{$self->{"_oc_order_"}};
|
||||
my $key;
|
||||
|
||||
while ($idx < $self->{"_oc_numattr_"})
|
||||
{
|
||||
$key = $attrs[$idx++];
|
||||
next if ($key =~ /^_.+_$/);
|
||||
next if $self->{"_${key}_deleted_"};
|
||||
last;
|
||||
}
|
||||
$self->{"_oc_keyidx_"} = $idx;
|
||||
|
||||
return $key;
|
||||
}
|
||||
|
||||
|
||||
#############################################################################
|
||||
# Get the next key, if appropriate.
|
||||
#
|
||||
sub NEXTKEY
|
||||
{
|
||||
my $self = $_[$[];
|
||||
my $idx = $self->{"_oc_keyidx_"};
|
||||
my @attrs = @{$self->{"_oc_order_"}};
|
||||
my $key;
|
||||
|
||||
while ($idx < $self->{"_oc_numattr_"})
|
||||
{
|
||||
$key = $attrs[$idx++];
|
||||
next if ($key =~ /^_.+_$/);
|
||||
next if $self->{"_${key}_deleted_"};
|
||||
last;
|
||||
}
|
||||
$self->{"_oc_keyidx_"} = $idx;
|
||||
|
||||
return if ($key =~ /^_.+_$/);
|
||||
return if $self->{"_${key}_deleted_"};
|
||||
return $key;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -115,8 +181,9 @@ sub attrModified
|
|||
{
|
||||
my ($self, $attr) = ($_[$[], lc $_[$[ + 1]);
|
||||
|
||||
return 0 if ($attr eq "");
|
||||
return 0 unless (defined($attr) && ($attr ne ""));
|
||||
return 0 unless defined($self->{$attr});
|
||||
return 0 if $self->{"_${attr}_deleted_"};
|
||||
|
||||
@{$self->{"_${attr}_save_"}} = @{$self->{$attr}}
|
||||
unless $self->{"_${attr}_save_"};
|
||||
|
|
@ -124,6 +191,7 @@ sub attrModified
|
|||
|
||||
return 1;
|
||||
}
|
||||
*markModified = \*attrModified;
|
||||
|
||||
|
||||
#############################################################################
|
||||
|
|
@ -134,11 +202,43 @@ sub isModified
|
|||
{
|
||||
my ($self, $attr) = ($_[$[], lc $_[$[ + 1]);
|
||||
|
||||
return 0 if ($attr eq ""); return 0 unless defined($self->{$attr});
|
||||
return 0 unless (defined($attr) && ($attr ne ""));
|
||||
return 0 unless defined($self->{$attr});
|
||||
return $self->{"_self_obj_"}->{"_${attr}_modified_"};
|
||||
}
|
||||
|
||||
|
||||
#############################################################################
|
||||
# Ask if a particular attribute has been deleted already. Return True or
|
||||
# false depending on the internal status of the attribute.
|
||||
#
|
||||
sub isDeleted
|
||||
{
|
||||
my ($self, $attr) = ($_[$[], lc $_[$[ + 1]);
|
||||
|
||||
return 0 unless (defined($attr) && ($attr ne ""));
|
||||
return 0 unless defined($self->{$attr});
|
||||
|
||||
return $self->{"_self_obj_"}->{"_${attr}_deleted_"};
|
||||
}
|
||||
|
||||
|
||||
#############################################################################
|
||||
# Test if a attribute name is actually a real attribute, and not part of
|
||||
# the internal structures.
|
||||
#
|
||||
sub isAttr
|
||||
{
|
||||
my ($self, $attr) = ($_[$[], lc $_[$[ + 1]);
|
||||
|
||||
return 0 unless (defined($attr) && ($attr ne ""));
|
||||
return 0 unless defined($self->{$attr});
|
||||
return 0 if $self->{"_${attr}_deleted_"};
|
||||
|
||||
return ($attr !~ /^_.+_$/);
|
||||
}
|
||||
|
||||
|
||||
#############################################################################
|
||||
# Remove an attribute from the entry, basically the same as the DELETE
|
||||
# method. We also make an alias for "delete" here, just in case (and to be
|
||||
|
|
@ -148,17 +248,39 @@ sub remove
|
|||
{
|
||||
my ($self, $attr) = ($_[$[], lc $_[$[ + 1]);
|
||||
|
||||
return 0 if ($attr eq "");
|
||||
return 0 unless (defined($attr) && ($attr ne ""));
|
||||
return 0 unless defined($self->{$attr});
|
||||
|
||||
$self->{"_self_obj_"}->{"_${attr}_deleted_"} = 1;
|
||||
undef $self->{"_self_obj_"}->{$attr};
|
||||
|
||||
return 1;
|
||||
}
|
||||
*delete = \*remove;
|
||||
|
||||
|
||||
#############################################################################
|
||||
# Undo a remove(), or set of removeValues() fairly useless, to restore an
|
||||
# attribute to it's original state. This is fairly useless, but hey...
|
||||
#
|
||||
sub unRemove
|
||||
{
|
||||
my ($self, $attr) = ($_[$[], lc $_[$[ + 1]);
|
||||
|
||||
return 0 unless (defined($attr) && ($attr ne ""));
|
||||
return 0 unless defined($self->{$attr});
|
||||
|
||||
undef $self->{"_self_obj_"}->{"_${attr}_deleted_"};
|
||||
if (defined $self->{"_${attr}_save_"})
|
||||
{
|
||||
@{$self->{$attr}} = @{$self->{"_${attr}_save_"}};
|
||||
undef @{$selfl->{"_${key}_save_"}};
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
*unDelete = \*unRemove;
|
||||
|
||||
|
||||
#############################################################################
|
||||
# Delete a value from an attribute, if it exists. NOTE: If it was the last
|
||||
# value, we'll actually remove the entire attribute! We should then also
|
||||
|
|
@ -166,17 +288,22 @@ sub remove
|
|||
#
|
||||
sub removeValue
|
||||
{
|
||||
my ($self, $attr, $val) = ($_[$[], lc $_[$[ + 1], $_[$[ + 2]);
|
||||
my ($self, $attr, $val, $norm) = ($_[$[], lc $_[$[ + 1], $_[$[ + 2],
|
||||
$_[$[ + 3]);
|
||||
my $i = 0;
|
||||
local $_;
|
||||
|
||||
return 0 if (($val eq "") || ($attr eq ""));
|
||||
return 0 unless (defined($val) && ($val ne ""));
|
||||
return 0 unless (defined($attr) && ($attr ne ""));
|
||||
return 0 unless defined($self->{$attr});
|
||||
|
||||
@{$self->{"_${attr}_save_"}} = @{$self->{$attr}}
|
||||
unless $self->{"_${attr}_save_"};
|
||||
$val = normalizeDN($val) if (defined($norm) && $norm);
|
||||
@{$self->{"_${attr}_save_"}} = @{$self->{$attr}} unless
|
||||
defined $self->{"_${attr}_save_"};
|
||||
|
||||
foreach (@{$self->{$attr}})
|
||||
{
|
||||
$_ = normalizeDN($_) if (defined($norm) && $norm);
|
||||
if ($_ eq $val)
|
||||
{
|
||||
splice(@{$self->{$attr}}, $i, 1);
|
||||
|
|
@ -187,7 +314,6 @@ sub removeValue
|
|||
else
|
||||
{
|
||||
$self->{"_self_obj_"}->{"_${attr}_deleted_"} = 1;
|
||||
# TODO: Now remove it from _oc_order_ !
|
||||
}
|
||||
|
||||
return 1;
|
||||
|
|
@ -200,6 +326,18 @@ sub removeValue
|
|||
*deleteValue = \*removeValue;
|
||||
|
||||
|
||||
#############################################################################
|
||||
# Just like removeValue(), but force the DN normalization of the value.
|
||||
#
|
||||
sub removeDNValue
|
||||
{
|
||||
my ($self, $attr, $val) = ($_[$[], lc $_[$[ + 1], $_[$[ + 2]);
|
||||
|
||||
return $self->removeValue($attr, $val, 1);
|
||||
}
|
||||
*deleteDNValue = \*removeDNValue;
|
||||
|
||||
|
||||
#############################################################################
|
||||
# Add a value to an attribute. The optional third argument indicates that
|
||||
# we should not enforce the uniqueness on this attibute, thus bypassing
|
||||
|
|
@ -208,15 +346,22 @@ sub removeValue
|
|||
sub addValue
|
||||
{
|
||||
my $self = shift;
|
||||
my ($attr, $val, $force) = (lc $_[$[], $_[$[ + 1], $_[$[ + 2]);
|
||||
my ($attr, $val, $force, $norm) = (lc $_[$[], $_[$[ + 1], $_[$[ + 2],
|
||||
$_[$[ + 3]);
|
||||
local $_;
|
||||
|
||||
return 0 if (($val eq "") || ($attr eq ""));
|
||||
if (!$force)
|
||||
return 0 unless (defined($val) && ($val ne ""));
|
||||
return 0 unless (defined($attr) && ($attr ne ""));
|
||||
|
||||
if (!defined($force) || !$force)
|
||||
{
|
||||
my $nval = $val;
|
||||
|
||||
$nval = normalizeDN($val) if (defined($norm) && $norm);
|
||||
foreach (@{$self->{$attr}})
|
||||
{
|
||||
return 0 if ($_ eq $val);
|
||||
$_ = normalizeDN($_) if (defined($norm) && $norm);
|
||||
return 0 if ($_ eq $nval);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -233,24 +378,90 @@ sub addValue
|
|||
if (($attr ne "dn") && !grep(/^$attr$/i, @{$self->{"_oc_order_"}}))
|
||||
{
|
||||
push(@{$self->{"_oc_order_"}}, $attr);
|
||||
$self->{"_oc_numattr_"}++;
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
#############################################################################
|
||||
# Just like addValue(), but force the DN normalization of the value. Note
|
||||
# that we also have an $norm argument here, to normalize the DN value
|
||||
# before we add it.
|
||||
#
|
||||
sub addDNValue
|
||||
{
|
||||
my $self = shift;
|
||||
my ($attr, $val, $force, $norm) = (lc $_[$[], $_[$[ + 1], $_[$[ + 2],
|
||||
$_[$[ + 2]);
|
||||
|
||||
$val = normalizeDN($val) if (defined($norm) && $norm);
|
||||
return $self->addValue($attr, $val, $force, 1);
|
||||
}
|
||||
|
||||
|
||||
#############################################################################
|
||||
# Set the entire value of an attribute, removing whatever was already set.
|
||||
# The arguments are the name of the attribute, and then one or more values,
|
||||
# passed as scalar or an array (not pointer).
|
||||
#
|
||||
sub setValue
|
||||
{
|
||||
my ($self, $attr) = (shift, lc shift);
|
||||
my (@vals) = @_;
|
||||
local $_;
|
||||
|
||||
return 0 unless (defined(@vals) && ($#vals >= $[));
|
||||
return 0 unless (defined($attr) && ($attr ne ""));
|
||||
|
||||
$self->{$attr} = [@vals];
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
#############################################################################
|
||||
# Return TRUE or FALSE, if the attribute has the specified value. The
|
||||
# optional third argument says we should do case insensitive search.
|
||||
#
|
||||
sub hasValue
|
||||
{
|
||||
my($self, $attr, $val, $nocase, $norm) = @_;
|
||||
|
||||
return 0 unless (defined($val) && ($val ne ""));
|
||||
return 0 unless (defined($attr) && ($attr ne ""));
|
||||
return 0 unless defined($self->{$attr});
|
||||
|
||||
$val = normalizeDN($val) if (defined($norm) && $norm);
|
||||
if ($nocase)
|
||||
{
|
||||
foreach (@{$self->{$attr}})
|
||||
{
|
||||
$_ = normalizeDN($_) if (defined($norm) && $norm);
|
||||
return 1 if /^\Q$val\E$/i;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
foreach (@{$self->{$attr}})
|
||||
{
|
||||
$_ = normalizeDN($_) if (defined($norm) && $norm);
|
||||
return 1 if /^\Q$val\E$/;
|
||||
}
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
#############################################################################
|
||||
# Just like hasValue(), but force the DN normalization of the value.
|
||||
#
|
||||
sub hasDNValue
|
||||
{
|
||||
my($self, $attr, $val, $nocase) = @_;
|
||||
|
||||
return 0 if (($val eq "") || ($attr eq ""));
|
||||
return 0 unless defined($self->{$attr});
|
||||
return grep(/^\Q$val\E$/i, @{$self->{$attr}}) if $nocase;
|
||||
return grep(/^\Q$val\E$/, @{$self->{$attr}});
|
||||
return $self->hasValue($attr, $val, $nocase, 1);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -262,10 +473,39 @@ sub matchValue
|
|||
{
|
||||
my($self, $attr, $reg, $nocase) = @_;
|
||||
|
||||
return 0 if (($reg eq "") || ($attr eq ""));
|
||||
return 0 unless (defined($reg) && ($reg ne ""));
|
||||
return 0 unless (defined($attr) && ($attr ne ""));
|
||||
return 0 unless defined($self->{$attr});
|
||||
return grep(/$reg/i, @{$self->{$attr}}) if $nocase;
|
||||
return grep(/$reg/, @{$self->{$attr}});
|
||||
|
||||
if ($nocase)
|
||||
{
|
||||
foreach (@{$self->{$attr}})
|
||||
{
|
||||
$_ = normalizeDN($_);
|
||||
return 1 if /$reg/i;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
foreach (@{$self->{$attr}})
|
||||
{
|
||||
$_ = normalizeDN($_);
|
||||
return 1 if /$reg/;
|
||||
}
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
#############################################################################
|
||||
# Just like matchValue(), but force the DN normalization of the values.
|
||||
#
|
||||
sub matchDNValue
|
||||
{
|
||||
my($self, $attr, $reg, $nocase) = @_;
|
||||
|
||||
return $self->matchValue($attr, $reg, $nocase, 1);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -274,10 +514,11 @@ sub matchValue
|
|||
#
|
||||
sub setDN
|
||||
{
|
||||
my ($self, $val) = @_;
|
||||
my ($self, $val, $norm) = @_;
|
||||
|
||||
return 0 if ($val eq "");
|
||||
return 0 unless (defined($val) && ($val ne ""));
|
||||
|
||||
$val = normalizeDN($val) if (defined($norm) && $norm);
|
||||
$self->{"dn"} = $val;
|
||||
|
||||
return 1;
|
||||
|
|
@ -289,8 +530,9 @@ sub setDN
|
|||
#
|
||||
sub getDN
|
||||
{
|
||||
my ($self) = @_;
|
||||
my ($self, $norm) = @_;
|
||||
|
||||
return normalizeDN($self->{"dn"}) if (defined($norm) && $norm);
|
||||
return $self->{"dn"};
|
||||
}
|
||||
|
||||
|
|
@ -304,7 +546,7 @@ sub size
|
|||
my ($self, $attr) = ($_[$[], lc $_[$[ + 1]);
|
||||
my @val;
|
||||
|
||||
return 0 if ($attr eq "");
|
||||
return 0 unless (defined($attr) && ($attr ne ""));
|
||||
return 0 unless defined($self->{$attr});
|
||||
|
||||
@val = @{$self->{$attr}};
|
||||
|
|
@ -320,7 +562,8 @@ sub exists
|
|||
{
|
||||
my ($self, $attr) = ($_[$[], lc $_[$[ + 1]);
|
||||
|
||||
return 0 if ($attr eq "");
|
||||
return 0 unless (defined($attr) && ($attr ne ""));
|
||||
|
||||
return defined($self->{$attr});
|
||||
}
|
||||
|
||||
|
|
@ -383,10 +626,12 @@ easy to write LDAP clients that needs to update/modify entries, since
|
|||
you'll just do the changes, and this object class will take care of the
|
||||
rest.
|
||||
|
||||
We define local functions for STORE, FETCH and DELETE in this object
|
||||
class, and inherit the rest from the super class. Overloading these
|
||||
specific functions is how we can keep track of what is changing in the
|
||||
entry, which turns out to be very convenient.
|
||||
We define local functions for STORE, FETCH, DELETE, EXISTS, FIRSTKEY and
|
||||
NEXTKEY in this object class, and inherit the rest from the super
|
||||
class. Overloading these specific functions is how we can keep track of
|
||||
what is changing in the entry, which turns out to be very convenient. We
|
||||
can also easily "loop" over the attribute types, ignoring internal data,
|
||||
or deleted attributes.
|
||||
|
||||
Most of the methods here either return the requested LDAP value, or a
|
||||
status code. The status code (either 0 or 1) indicates the failure or
|
||||
|
|
@ -467,6 +712,28 @@ been modified, in any way, we return True (1), otherwise we return False
|
|||
|
||||
if ($entry->isModified("cn")) { # do something }
|
||||
|
||||
=item B<isDeleted>
|
||||
|
||||
This is almost identical to B<isModified>, except it tests if an attribute
|
||||
has been deleted. You use it the same way as above, like
|
||||
|
||||
if (! $entry->isDeleted("cn")) { # do something }
|
||||
|
||||
=item B<isAttr>
|
||||
|
||||
This method can be used to decide if an attribute name really is a valid
|
||||
LDAP attribute in the current entry. Use of this method is fairly limited,
|
||||
but could potentially be useful. Usage is like previous examples, like
|
||||
|
||||
if ($entry->isAttr("cn")) { # do something }
|
||||
|
||||
The code section will only be executed if these criterias are true:
|
||||
|
||||
1. The name of the attribute is a non-empty string.
|
||||
2. The name of the attribute does not begin, and end, with an
|
||||
underscore character (_).
|
||||
2. The attribute has one or more values in the entry.
|
||||
|
||||
=item B<remove>
|
||||
|
||||
This will remove the entire attribute, including all it's values, from the
|
||||
|
|
@ -486,6 +753,20 @@ sensitive, so make sure you preserve case properly. An example is:
|
|||
|
||||
$entry->removeValue("objectclass", "nscpPerson");
|
||||
|
||||
=item B<removeDNValue>
|
||||
|
||||
This is almost identical to B<removeValue>, except it will normalize the
|
||||
attribute values before trying to remove them. This is useful if you know
|
||||
that the attribute is a DN value, but perhaps the values are not cosistent
|
||||
in all LDAP entries. For example
|
||||
|
||||
$dn = "uid=Leif, dc=Netscape, dc=COM";
|
||||
$entry->removeDNValue("owner", $dn);
|
||||
|
||||
|
||||
will remove the owner "uid=leif,dc=netscape,dc=com", no matter how it's
|
||||
capitalized and formatted in the entry.
|
||||
|
||||
=item B<addValue>
|
||||
|
||||
Add a value to an attribute. If the attribute value already exists, or we
|
||||
|
|
@ -500,6 +781,33 @@ a particular attribute. To add a CN to an existing entry/attribute, do:
|
|||
|
||||
$entry->addValue("cn", "Leif Hedstrom");
|
||||
|
||||
=item B<addDNValue>
|
||||
|
||||
Just like B<addValue>, except this method assume the value is a DN
|
||||
attribute. For instance
|
||||
|
||||
$dn = "uid=Leif, dc=Netscape, dc=COM";
|
||||
$entry->addDNValue("uniqueMember", $dn);
|
||||
|
||||
|
||||
will only add the DN for "uid=leif" if it does not exist as a DN in the
|
||||
uniqueMember attribute.
|
||||
|
||||
=item B<setValue>
|
||||
|
||||
Set the specified attribute to the new value (or values), overwriting
|
||||
whatever old values it had before. This is a little dangerous, since you
|
||||
can lose attribute values you didn't intend to remove. Therefore, it's
|
||||
usually recommended to use B<removeValue()> and B<setValue()>. If you know
|
||||
exactly what the new values should be like, you can use this method like
|
||||
|
||||
$entry->setValue("cn", "Leif Hedstrom", "The Swede");
|
||||
$entry->setValue("mail", @mailAddresses);
|
||||
|
||||
or if it's a single value attribute,
|
||||
|
||||
$entry->setValue("uidNumber", "12345");
|
||||
|
||||
=item B<hasValue>
|
||||
|
||||
Return TRUE or FALSE if the attribute has the specified value. A typical
|
||||
|
|
@ -511,6 +819,11 @@ The (optional) third argument indicates if the string comparison should be
|
|||
case insensitive or not. The first two arguments are the name and value of
|
||||
the attribute, as usual.
|
||||
|
||||
=item B<hasDNValue>
|
||||
|
||||
Exactly like B<hasValue>, except we assume the attribute values are DN
|
||||
attributes.
|
||||
|
||||
=item B<matchValue>
|
||||
|
||||
This is very similar to B<hasValue>, except it does a regular expression
|
||||
|
|
@ -520,6 +833,9 @@ matching. The usage is identical to the example for hasValue, e.g.
|
|||
|
||||
if ($entry->matchValue("objectclass", "pers", 1)) { # do something }
|
||||
|
||||
=item B<matchDNValue>
|
||||
|
||||
Like B<matchValue>, except the attribute values are considered being DNs.
|
||||
|
||||
=item B<setDN>
|
||||
|
||||
|
|
@ -531,12 +847,19 @@ newly created entry, we can do
|
|||
|
||||
$entry->setDN("uid=leif,ou=people,dc=netscape,dc=com");
|
||||
|
||||
There is an optional third argument, a boolean flag, indicating that we
|
||||
should normalize the DN before setting it. This will assure a consistent
|
||||
format of your DNs.
|
||||
|
||||
=item B<getDN>
|
||||
|
||||
Return the DN for the entry. For instance
|
||||
|
||||
print "The DN is: ", $entry->getDN(), "\n";
|
||||
|
||||
Just like B<setDN>, this method also has an optional argument, which
|
||||
indicates we should normalize the DN before returning it to the caller.
|
||||
|
||||
=item B<size>
|
||||
|
||||
Return the number of values for a particular attribute. For instance
|
||||
|
|
|
|||
|
|
@ -26,6 +26,11 @@ information available on
|
|||
|
||||
http://www.mozilla.org/directory/
|
||||
|
||||
and the FAQ at
|
||||
|
||||
http://www.mozilla.org/directory/faq/perldap-faq.html
|
||||
|
||||
|
||||
|
||||
Building
|
||||
========
|
||||
|
|
@ -46,14 +51,17 @@ session is
|
|||
|
||||
PerLDAP - Perl 5 Module for LDAP
|
||||
================================
|
||||
|
||||
Directory containing 'include' and 'lib' directory of the Netscape
|
||||
LDAP Software Developer Kit (default: /usr): /opt/ldapsdk3
|
||||
Using LDAPv3 Developer Kit (default: yes)?
|
||||
Include SSL Support (default: yes)?
|
||||
Libraries to link with (default: -L/opt/pkg/ldapsdk3/lib -lldapssl30):
|
||||
Checking if your kit is complete...
|
||||
Looks good
|
||||
Writing Makefile for Mozilla::LDAP::API
|
||||
|
||||
|
||||
|
||||
The important question is where your LDAP SDK is installed, in the example
|
||||
above the base directory is /opt/ldapsdk3. This directory should have two
|
||||
subdirectories, named "lib" and "include". If you installed the SDK in the
|
||||
|
|
@ -77,12 +85,13 @@ it possible to do configuration and installs non-interactively. The
|
|||
variables are
|
||||
|
||||
LDAPSDKDIR - Full path to the C SDK base directory
|
||||
LDAPSDKVER - Either "11" (for v1.1) or "30" (for v3.x)
|
||||
LDAPSDKSSL - Set to "Y" to enable SSL
|
||||
LDAPV3ON - Set to "N" to diable LDAP v3 (on by default)
|
||||
LDAPSDKSSL - Set to "N" to disable SSL (SSL is default)
|
||||
|
||||
|
||||
With these variables set, you will not be asked any of the questions
|
||||
above. Just run the Makefile.PL script, and finish the build, e.g.
|
||||
With these variables set, you will not be asked any of the questions above
|
||||
(but it will echo the paramaters). Just run the Makefile.PL script, and
|
||||
finish the build, e.g.
|
||||
|
||||
% perl5 Makefile.PL
|
||||
% make
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#############################################################################
|
||||
# $Id: LDIF.pm,v 1.5 1998-08-13 21:32:50 leif Exp $
|
||||
# $Id: LDIF.pm,v 1.6 1999-01-21 23:52:42 leif%netscape.com Exp $
|
||||
#
|
||||
# The contents of this file are subject to the Mozilla Public License
|
||||
# Version 1.0 (the "License"); you may not use this file except in
|
||||
|
|
@ -179,8 +179,8 @@ sub readEntries
|
|||
my $entry;
|
||||
my (@entries);
|
||||
|
||||
return if (($num ne "") && ($num <= 0));
|
||||
$num = -1 unless $num;
|
||||
return if (defined($num) && ($num ne "") && ($num <= 0));
|
||||
$num = (-1) unless defined($num);
|
||||
|
||||
do
|
||||
{
|
||||
|
|
@ -229,11 +229,16 @@ Mozilla::LDAP::LDIF - Read, write and modify LDIF files.
|
|||
|
||||
=head1 ABSTRACT
|
||||
|
||||
This package is used to read and write LDIF information from files (actually, file handles).
|
||||
This package is used to read and write LDIF information from files
|
||||
(actually, file handles). It can also be used to generate LDIF modify
|
||||
files from changes made to an entry.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
LDIF rules...
|
||||
The LDIF format is a simple, yet useful, text representation of an LDAP
|
||||
database. The goal of this package is to make it as easy as possible to
|
||||
read, parse and use LDIF data, possible generated from other information
|
||||
sources.
|
||||
|
||||
=head1 EXAMPLES
|
||||
|
||||
|
|
|
|||
|
|
@ -16,6 +16,9 @@ MPL-1.0.txt
|
|||
test_api/search.pl
|
||||
test_api/write.pl
|
||||
test_api/api.pl
|
||||
t/conn.pl
|
||||
t/entry.pl
|
||||
t/ChangeLog
|
||||
examples/ChangeLog
|
||||
examples/lfinger.pl
|
||||
examples/qsearch.pl
|
||||
|
|
@ -26,4 +29,5 @@ examples/tabdump.pl
|
|||
examples/modattr.pl
|
||||
examples/rename.pl
|
||||
examples/psoftsync.pl
|
||||
examples/changes2ldif.pl
|
||||
install-bin
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#############################################################################
|
||||
# $Id: Makefile.PL,v 1.13 1998-08-14 21:45:39 leif%netscape.com Exp $
|
||||
# $Id: Makefile.PL,v 1.14 1999-01-21 23:52:42 leif%netscape.com Exp $
|
||||
#
|
||||
# The contents of this file are subject to the Mozilla Public License
|
||||
# Version 1.0 (the "License"); you may not use this file except in
|
||||
|
|
@ -26,24 +26,33 @@
|
|||
|
||||
use ExtUtils::MakeMaker;
|
||||
use Config;
|
||||
use Carp;
|
||||
|
||||
$perlpath = $Config{'perlpath'};
|
||||
$osname = $Config{'osname'};
|
||||
|
||||
$ldapsdk_loc = $ENV{"LDAPSDKDIR"}; # Full Path to C SDK Top-Level
|
||||
$ldapsdk_ver = $ENV{"LDAPSDKVER"}; # 11 or 30
|
||||
$ldapsdk_ssl = $ENV{"LDAPSDKSSL"}; # Y to include SSL
|
||||
$ldapsdk_ssl = $ENV{"LDAPSDKSSL"}; # N to exclude SSL
|
||||
$ldapsdk_ver = $ENV{"LDAPV3ON"}; # N to exclude LDAP v3 features
|
||||
|
||||
$libexts = "so|sl|a|lib";
|
||||
|
||||
|
||||
print "\nPerLDAP - Perl 5 Module for LDAP\n";
|
||||
print "================================\n";
|
||||
|
||||
$silent = 1;
|
||||
print "Directory containing 'include' and 'lib' directory of the Netscape\n";
|
||||
print "LDAP Software Developer Kit (default: /usr): ";
|
||||
if (!$ldapsdk_loc)
|
||||
{
|
||||
print "Directory containing 'include' and 'lib' directory of the Netscape\n";
|
||||
print "LDAP Software Developer Kit (default: /usr): ";
|
||||
chomp ($ldapsdk_loc = <>);
|
||||
$silent = 0;
|
||||
chomp ($ldapsdk_loc = <STDIN>);
|
||||
$ldapsdk_loc = "/usr" unless $ldapsdk_loc =~ /\S/;
|
||||
} else {
|
||||
print "$ldapsdk_loc\n";
|
||||
}
|
||||
croak("Directory $ldapsdk_loc does not exist!") unless -d $ldapsdk_loc;
|
||||
|
||||
if ($osname =~ /mswin/i)
|
||||
{
|
||||
|
|
@ -55,80 +64,110 @@ if ($osname =~ /mswin/i)
|
|||
$include_ldap = $ldapsdk_loc . $dir_sep . "include";
|
||||
$lib_ldap = $ldapsdk_loc . $dir_sep . "lib";
|
||||
|
||||
print "Using LDAPv3 Developer Kit (default: yes)? ";
|
||||
if (!$ldapsdk_ver)
|
||||
{
|
||||
print "Using LDAPv3 Developer Kit (default: yes)? ";
|
||||
chomp ($ver = <>);
|
||||
if ($ver =~ /^n/i)
|
||||
{
|
||||
$ldapsdk_ver = "11";
|
||||
} else {
|
||||
$ldapsdk_ver = "30";
|
||||
}
|
||||
$silent = 0;
|
||||
chomp ($ldapsdk_ver = <STDIN>);
|
||||
} else {
|
||||
print "YES\n";
|
||||
}
|
||||
$v3_def = "-DLDAPV3" unless ($ldapsdk_ver =~ /^n/i);
|
||||
|
||||
if ($ldapsdk_ver == "30")
|
||||
{
|
||||
$v3def = "-DLDAPV3";
|
||||
}
|
||||
|
||||
print "Include SSL Support (default: yes)? ";
|
||||
if (!$ldapsdk_ssl)
|
||||
{
|
||||
print "Include SSL Support (default: yes)? ";
|
||||
chomp ($ldapsdk_ssl = <>);
|
||||
$silent = 0;
|
||||
chomp ($ldapsdk_ssl = <STDIN>);
|
||||
} else {
|
||||
print "YES\n";
|
||||
}
|
||||
$ssl_def = "-DUSE_SSL" unless ($ldapsdk_ssl =~ /^n/i);
|
||||
|
||||
|
||||
opendir(DIR,$lib_ldap);
|
||||
@files = grep{/ldap|lber/} readdir(DIR);
|
||||
closedir(DIR);
|
||||
|
||||
if (!((@ldaplib = grep{/ldapssl.*\.($libexts)$/} @files) && $ssl_def))
|
||||
{
|
||||
@ldaplib = grep{/ldap.*\.($libexts)$/} @files;
|
||||
@lberlib = grep{/lber.*\.($libexts)$/} @files;
|
||||
}
|
||||
|
||||
if ($ldapsdk_ssl =~ /^n/i)
|
||||
if ($#ldaplib < 0)
|
||||
{
|
||||
$ssl_def = "";
|
||||
} else {
|
||||
$ssl_def = "-DUSE_SSL";
|
||||
die "No LDAP libraries found.";
|
||||
}
|
||||
|
||||
if ($osname =~ /mswin/i)
|
||||
if ($#ldaplib > 0)
|
||||
{
|
||||
if ($ssl_def)
|
||||
print "Located multiple libraries:\n";
|
||||
foreach $alib (@ldaplib)
|
||||
{
|
||||
if ($ldapsdk_ver == "30")
|
||||
{
|
||||
$ldap_lib = "nsldapssl32v30";
|
||||
} else {
|
||||
$ldap_lib = "nsldap32v11";
|
||||
}
|
||||
} else {
|
||||
$ldap_lib = "nsldap32v" . $ldapsdk_ver;
|
||||
}
|
||||
} else {
|
||||
if ($ssl_def)
|
||||
{
|
||||
if ($ldapsdk_ver == "30")
|
||||
{
|
||||
$ldap_lib = "ldapssl30";
|
||||
} else {
|
||||
$ldap_lib = "ldap30";
|
||||
}
|
||||
} else {
|
||||
$ldap_lib = "ldap" . $ldapsdk_ver;
|
||||
print " - $alib\n";
|
||||
}
|
||||
}
|
||||
|
||||
$lline_ldap = $ldaplib[0];
|
||||
$lline_ldap =~ s/^lib//;
|
||||
$lline_ldap =~ s/\.($libexts)$//;
|
||||
$lline = "-L$lib_ldap -l$lline_ldap";
|
||||
|
||||
if ($#lberlib >= 0 && $lline =~ /ldap$/)
|
||||
{
|
||||
$lline_lber = $lberlib[0];
|
||||
$lline_lber =~ s/^lib//;
|
||||
$lline_lber =~ s/\.($libexts)$//;
|
||||
$lline .= " -l$lline_lber";
|
||||
}
|
||||
|
||||
print "Libraries to link with (default: $lline): ";
|
||||
if (!$silent)
|
||||
{
|
||||
chomp ($lib_line = <STDIN>);
|
||||
$lib_line = $lline unless $lib_line =~ /\S/;
|
||||
} else {
|
||||
print "\n";
|
||||
}
|
||||
|
||||
|
||||
if ($osname =~ /mswin/i)
|
||||
{
|
||||
$myextlib = "$lib_ldap\\$ldap_lib.lib";
|
||||
$myextlib = "$lib_ldap\\$ldaplib[0]";
|
||||
if ($lber_lib)
|
||||
{
|
||||
$myextlib .= " $lib_ldap\\$lberlib[0]";
|
||||
}
|
||||
} else {
|
||||
$myextlib = "";
|
||||
}
|
||||
|
||||
@extras = ();
|
||||
|
||||
push(@extras,
|
||||
CAPI => 'TRUE')
|
||||
if ($] >= 5.005 and $^O eq 'MSWin32'
|
||||
and $Config{archname} =~ /-object\b/i);
|
||||
|
||||
push(@extras,
|
||||
ABSTRACT => 'Perl methods for LDAP C API calls',
|
||||
AUTHOR => 'Netscape Communications Corp., Inc. and Clayton Donley')
|
||||
if ($ExtUtils::MakeMaker::Version >= 5.4301);
|
||||
|
||||
WriteMakefile(
|
||||
'NAME' => 'Mozilla::LDAP::API',
|
||||
'DISTNAME' => 'PerLDAP',
|
||||
'VERSION_FROM' => 'API.pm',
|
||||
($include_ldap ne "/usr/include" ? (
|
||||
'INC' => "-I$include_ldap",
|
||||
) : (
|
||||
'INC' => "",
|
||||
)),
|
||||
'LIBS' => ["-L$lib_ldap -l$ldap_lib"],
|
||||
'LIBS' => [$lib_line],
|
||||
'MYEXTLIB' => $myextlib,
|
||||
'DEFINE' => "$v3_def $ssl_def",
|
||||
'XSOPT' => "-nolinenumbers",
|
||||
@extras
|
||||
);
|
||||
|
|
|
|||
|
|
@ -26,37 +26,50 @@ functionality in future releases.
|
|||
Installing PerLDAP Binaries
|
||||
===========================
|
||||
|
||||
You will first need version 3.0 Beta 1 of the LDAP C SDK from Netscape. This
|
||||
is available from the DevEdge page at:
|
||||
You will first need version 3.0 of the LDAP C SDK from Netscape. This is
|
||||
available from the DevEdge page at:
|
||||
|
||||
http://developer.netscape.com/tech/directory/
|
||||
|
||||
You will also need Perl v5.004, available at http://www.perl.com/. Earlier
|
||||
versions of Perl will NOT work with the binaries. If you wish to use v5.004,
|
||||
you will need to compile PerLDAP from source.
|
||||
You will also need Perl v5.004, available at http://www.perl.com/.
|
||||
Earlier, or later, versions of Perl will NOT work with these binaries. If
|
||||
you wish to use v5.005, you will need to compile PerLDAP from source.
|
||||
|
||||
On Unix (Solaris Only...HPUX, IRIX, AIX to follow):
|
||||
1. Be sure that the libraries from the C SDK are installed in locations
|
||||
referenced by the environment variable LD_LIBRARY_PATH.
|
||||
referenced by the environment variable LD_LIBRARY_PATH, or one of the
|
||||
default system lib directories (e.g. /usr/lib). Alternatively you can
|
||||
later also copy the SDK libraries to the same "site" directory where
|
||||
Perl installed the PerLDAP libraries.
|
||||
|
||||
2. Save the file in a temporary location
|
||||
|
||||
3. Unzip the file by entering the command:
|
||||
gunzip <filename>.tar.gz
|
||||
|
||||
4. Untar the resulting tar file by entering the command:
|
||||
tar xvof <filename>.tar
|
||||
|
||||
5. Change to the extract directory:
|
||||
cd PerLDAP-1.0
|
||||
cd PerLDAP-1.1
|
||||
|
||||
6. Execute the following command in as the super-user (root):
|
||||
perl install-bin
|
||||
|
||||
On Windows NT:
|
||||
1. Be sure that the DLL from the C SDK is installed in your system32
|
||||
directory. Or alternatively, put the SDK DLLs in the same directory
|
||||
as your Perl-5 binary.
|
||||
1. Put the LDAP C SDK DLL in the same directory as the perl.exe
|
||||
binary. You can also set your PATH to point to the directory where you
|
||||
have the C SDK installed. Alternatively, you can put the DLL in the
|
||||
system32 folder, but avoid that if possible.
|
||||
|
||||
2. Save the file in a temporary location
|
||||
|
||||
3. Unzip the file by entering the command:
|
||||
I don't have a tool for creating self-extracting archives...
|
||||
|
||||
4. Change to the extract directory:
|
||||
cd PerLDAP-1.0
|
||||
cd PerLDAP-1.1
|
||||
|
||||
5. Execute the following command:
|
||||
perl install-bin
|
||||
|
||||
|
|
@ -78,6 +91,11 @@ Further instructions for using CVS and Mozilla is available at
|
|||
|
||||
http://www.mozilla.org/cvs.html
|
||||
|
||||
and an FAQ is at
|
||||
|
||||
http://www.mozilla.org/directory/faq/perldap-faq.html
|
||||
|
||||
|
||||
Instructions for building the source can be found in the INSTALL file
|
||||
in the source distribution.
|
||||
|
||||
|
|
@ -140,7 +158,7 @@ Reporting problems and bugs
|
|||
|
||||
Address all bug reports and comments to the Mozilla newsgroups at:
|
||||
|
||||
news://news.mozilla.org/netscape.public.mozilla.general
|
||||
news://news.mozilla.org/netscape.public.mozilla.directory
|
||||
|
||||
|
||||
License/Copyright
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#############################################################################
|
||||
# $Id: Utils.pm,v 1.10 1998-08-13 21:32:29 leif Exp $
|
||||
# $Id: Utils.pm,v 1.11 1999-01-21 23:52:43 leif%netscape.com Exp $
|
||||
#
|
||||
# The contents of this file are subject to the Mozilla Public License
|
||||
# Version 1.0 (the "License"); you may not use this file except in
|
||||
|
|
@ -63,7 +63,7 @@ sub normalizeDN
|
|||
my ($dn) = @_;
|
||||
my (@vals);
|
||||
|
||||
return "" if ($dn eq "");
|
||||
return "" unless (defined($dn) && ($dn ne ""));
|
||||
|
||||
@vals = Mozilla::LDAP::API::ldap_explode_dn(lc $dn, 0);
|
||||
|
||||
|
|
@ -188,14 +188,29 @@ sub str2Scope
|
|||
|
||||
|
||||
#############################################################################
|
||||
# Ask for a password, without displaying it on the TTY. This is very non-
|
||||
# portable, we need a better solution (using the term package perhaps?).
|
||||
# Ask for a password, without displaying it on the TTY.
|
||||
#
|
||||
sub askPassword
|
||||
{
|
||||
system('/bin/stty -echo');
|
||||
chop($_ = <STDIN>);
|
||||
system('/bin/stty echo');
|
||||
my $prompt = $_[0];
|
||||
my $hasReadKey = 0;
|
||||
|
||||
eval "use Term::ReadKey";
|
||||
$hasReadKey=1 unless ($@);
|
||||
|
||||
print "LDAP password: " if $prompt;
|
||||
if ($hasReadKey)
|
||||
{
|
||||
ReadMode(2);
|
||||
chop($_ = ReadLine(0));
|
||||
ReadMode(0);
|
||||
}
|
||||
else
|
||||
{
|
||||
system('/bin/stty -echo');
|
||||
chop($_ = <STDIN>);
|
||||
system('/bin/stty echo');
|
||||
}
|
||||
print "\n";
|
||||
|
||||
return $_;
|
||||
|
|
@ -204,7 +219,8 @@ sub askPassword
|
|||
|
||||
#############################################################################
|
||||
# Handle some standard LDAP options, and construct a nice little structure
|
||||
# that we can use later on.
|
||||
# that we can use later on. We really should have some appropriate defaults,
|
||||
# perhaps from an Mozilla::LDAP::Config module.
|
||||
#
|
||||
sub ldapArgs
|
||||
{
|
||||
|
|
@ -212,8 +228,9 @@ sub ldapArgs
|
|||
my %ld;
|
||||
|
||||
$main::opt_v = $main::opt_n if defined($main::opt_n);
|
||||
$main::opt_p = LDAPS_PORT unless (defined($main::opt_p) ||
|
||||
($main::opt_p eq ""));
|
||||
$main::opt_p = LDAPS_PORT if (!defined($main::opt_p) &&
|
||||
defined($main::opt_P) &&
|
||||
($main::opt_P ne ""));
|
||||
|
||||
$ld{"host"} = $main::opt_h || "ldap";
|
||||
$ld{"port"} = $main::opt_p || LDAP_PORT;
|
||||
|
|
@ -221,12 +238,11 @@ sub ldapArgs
|
|||
$ld{"bind"} = $main::opt_D || $bind || "";
|
||||
$ld{"pswd"} = $main::opt_w || "";
|
||||
$ld{"cert"} = $main::opt_P || "";
|
||||
$ld{"scope"} = $main::opt_s || LDAP_SCOPE_SUBTREE;
|
||||
$ld{"scope"} = (defined($main::opt_s) ? $main::opt_s : LDAP_SCOPE_SUBTREE);
|
||||
|
||||
if (($ld{"bind"} ne "") && ($ld{"pswd"} eq ""))
|
||||
{
|
||||
print "LDAP password: ";
|
||||
$ld{pswd} = askPassword();
|
||||
$ld{pswd} = askPassword(1);
|
||||
}
|
||||
|
||||
return %ld;
|
||||
|
|
@ -250,7 +266,7 @@ sub unixCrypt
|
|||
|
||||
#############################################################################
|
||||
# Try to find a user to bind as, and possibly ask for the password. Pass
|
||||
# a pointer to the hash array with parameters to this function.
|
||||
# a pointer to the hash array with LDAP parameters to this function.
|
||||
#
|
||||
sub userCredentials
|
||||
{
|
||||
|
|
@ -268,13 +284,11 @@ sub userCredentials
|
|||
|
||||
$conn->close();
|
||||
$ld->{"bind"} = $entry->getDN();
|
||||
print "Binding as ", $ld->{"bind"}, "\n\n" if $main::opt_v;
|
||||
}
|
||||
|
||||
if ($ld->{"pswd"} eq "")
|
||||
{
|
||||
print "Enter bind password: ";
|
||||
$ld->{"pswd"} = Mozilla::LDAP::Utils::askPassword();
|
||||
$ld->{"pswd"} = Mozilla::LDAP::Utils::askPassword(1);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -295,6 +309,12 @@ sub answer
|
|||
}
|
||||
|
||||
|
||||
#############################################################################
|
||||
# Mandatory TRUE return value.
|
||||
#
|
||||
1;
|
||||
|
||||
|
||||
#############################################################################
|
||||
# POD documentation...
|
||||
#
|
||||
|
|
|
|||
|
|
@ -1,3 +1,17 @@
|
|||
1999-01-05 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
* psoftsync.pl (delAttr): Fixed annoying bug where I missed to
|
||||
"my" $entry.
|
||||
|
||||
1999-01-04 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
* modattr.pl: Bug fixes for handling bad cases better (like
|
||||
missing attribute, adding empty values etc).
|
||||
|
||||
1998-12-11 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
* modattr.pl: Modified slightly to enable the rebind proc.
|
||||
|
||||
1998-08-03 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
* psoftsync.pl: New file, also merged in some modules from
|
||||
|
|
|
|||
|
|
@ -0,0 +1,118 @@
|
|||
#!/usr/bin/perl5
|
||||
#############################################################################
|
||||
# $Id: changes2ldif.pl,v 1.2 1999-01-21 23:52:46 leif%netscape.com Exp $
|
||||
#
|
||||
# The contents of this file are subject to the Mozilla Public License
|
||||
# Version 1.0 (the "License"); you may not use this file except in
|
||||
# compliance with the License. You may obtain a copy of the License at
|
||||
# http://www.mozilla.org/MPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS IS"
|
||||
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
|
||||
# License for the specific language governing rights and limitations
|
||||
# under the License.
|
||||
#
|
||||
# The Original Code is PerLDAP. The Initial Developer of the Original
|
||||
# Code is Netscape Communications Corp. and Clayton Donley. Portions
|
||||
# created by Netscape are Copyright (C) Netscape Communications
|
||||
# Corp., portions created by Clayton Donley are Copyright (C) Clayton
|
||||
# Donley. All Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
#
|
||||
# DESCRIPTION
|
||||
# Search the changelog, and produce an LDIF file suitable for ldapmodify
|
||||
# for instance. This should be merged into LDIF.pm eventually.
|
||||
#
|
||||
#############################################################################
|
||||
|
||||
use Getopt::Std; # To parse command line arguments.
|
||||
use Mozilla::LDAP::Conn; # Main "OO" layer for LDAP
|
||||
use Mozilla::LDAP::Utils; # LULU, utilities.
|
||||
|
||||
use strict;
|
||||
no strict "vars";
|
||||
|
||||
|
||||
#################################################################################
|
||||
# Constants, shouldn't have to edit these...
|
||||
#
|
||||
$APPNAM = "changes2ldif";
|
||||
$USAGE = "$APPNAM [-nv] -b base -h host -D bind -w pswd -P cert [min [max]]";
|
||||
|
||||
|
||||
#################################################################################
|
||||
# Check arguments, and configure some parameters accordingly..
|
||||
#
|
||||
if (!getopts('nvb:h:D:p:s:w:P:'))
|
||||
{
|
||||
print "usage: $APPNAM $USAGE\n";
|
||||
exit;
|
||||
}
|
||||
%ld = Mozilla::LDAP::Utils::ldapArgs();
|
||||
$ld{root} = "cn=changelog" if (!defined($ld{root}) || $ld{root} eq "");
|
||||
|
||||
|
||||
#################################################################################
|
||||
# Instantiate an LDAP object, which also binds to the LDAP server.
|
||||
#
|
||||
$conn = new Mozilla::LDAP::Conn(\%ld);
|
||||
die "Could't connect to LDAP server $ld{host}" unless $conn;
|
||||
|
||||
|
||||
#################################################################################
|
||||
# Create the search filter.
|
||||
#
|
||||
$min = $ARGV[$[];
|
||||
$max = $ARGV[$[ + 1];
|
||||
|
||||
if ($min ne "")
|
||||
{
|
||||
if ($max ne "")
|
||||
{
|
||||
$search = "(&(changenumber>=$min)(changenumber<=$max))";
|
||||
}
|
||||
else
|
||||
{
|
||||
$search = "(changenumber>=$min)";
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
$search = "(changenumber=*)";
|
||||
}
|
||||
|
||||
|
||||
#################################################################################
|
||||
# Do the searches, and print the results.
|
||||
#
|
||||
$entry = $conn->search($ld{root}, "ONE", "$search");
|
||||
while ($entry)
|
||||
{
|
||||
print "dn: ", $entry->{targetdn}[0], "\n";
|
||||
$type = $entry->{changetype}[0];
|
||||
print "changetype: $type\n";
|
||||
if ($type =~ /modify/i)
|
||||
{
|
||||
# Should we filter out modifiersname and modifytimestamp ? We do chop
|
||||
# off the trailing \0 though.
|
||||
chop($entry->{changes}[0]);
|
||||
print $entry->{changes}[0], "\n";
|
||||
}
|
||||
elsif ($type =~ /add/i)
|
||||
{
|
||||
print $entry->{changes}[0], "\n";
|
||||
}
|
||||
else
|
||||
{
|
||||
print "\n";
|
||||
}
|
||||
|
||||
$entry = $conn->nextEntry;
|
||||
}
|
||||
|
||||
|
||||
#################################################################################
|
||||
# Close the connection.
|
||||
#
|
||||
$ld{conn}->close if $ld{conn};
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
#!/usr/bin/perl5
|
||||
#############################################################################
|
||||
# $Id: modattr.pl,v 1.7 1998-08-13 23:32:28 leif Exp $
|
||||
# $Id: modattr.pl,v 1.8 1999-01-21 23:52:46 leif%netscape.com Exp $
|
||||
#
|
||||
# The contents of this file are subject to the Mozilla Public License
|
||||
# Version 1.0 (the "License"); you may not use this file except in
|
||||
|
|
@ -31,6 +31,9 @@ use Getopt::Std; # To parse command line arguments.
|
|||
use Mozilla::LDAP::Conn; # Main "OO" layer for LDAP
|
||||
use Mozilla::LDAP::Utils; # LULU, utilities.
|
||||
|
||||
use strict;
|
||||
no strict "vars";
|
||||
|
||||
|
||||
#############################################################################
|
||||
# Constants, shouldn't have to edit these...
|
||||
|
|
@ -58,8 +61,7 @@ Mozilla::LDAP::Utils::userCredentials(\%ld) unless $opt_n;
|
|||
$conn = new Mozilla::LDAP::Conn(\%ld);
|
||||
die "Could't connect to LDAP server $ld{host}" unless $conn;
|
||||
|
||||
#$conn->setDefaultRebindProc($ld{bind}, $ld{pswd}, 128);
|
||||
#$conn->setRebindProc(\&LdapUtils::rebindProc);
|
||||
$conn->setDefaultRebindProc($ld{bind}, $ld{pswd});
|
||||
|
||||
($change, $search) = @ARGV;
|
||||
if (($change eq "") || ($search eq ""))
|
||||
|
|
@ -74,26 +76,37 @@ while ($entry)
|
|||
{
|
||||
$changed = 0;
|
||||
|
||||
if ($opt_d && defined $entry->{$attr})
|
||||
if ($opt_d)
|
||||
{
|
||||
if ($value)
|
||||
if (defined $entry->{$attr})
|
||||
{
|
||||
$changed = $entry->removeValue($attr, $value);
|
||||
if ($changed && $opt_v)
|
||||
if ($value)
|
||||
{
|
||||
print "Removed value from ", $entry->getDN(), "\n" if $opt_v;
|
||||
$changed = $entry->removeValue($attr, $value);
|
||||
if ($changed && $opt_v)
|
||||
{
|
||||
print "Removed value from ", $entry->getDN(), "\n" if $opt_v;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
delete $entry->{$attr};
|
||||
print "Deleted attribute $attr for ", $entry->getDN(), "\n" if $opt_v;
|
||||
$changed = 1;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
delete $entry->{$attr};
|
||||
print "Deleted attribute $attr for ", $entry->getDN(), "\n" if $opt_v;
|
||||
$changed = 1;
|
||||
print "No attribute values for: $attr\n";
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
if ($opt_a)
|
||||
if (!defined($value) || !$value)
|
||||
{
|
||||
print "No value provided for the attribute $attr\n";
|
||||
}
|
||||
elsif ($opt_a)
|
||||
{
|
||||
$changed = $entry->addValue($attr, $value);
|
||||
if ($changed && $opt_v)
|
||||
|
|
@ -103,12 +116,9 @@ while ($entry)
|
|||
}
|
||||
else
|
||||
{
|
||||
if ($entry->{$attr}[0] ne $value)
|
||||
{
|
||||
$entry->{$attr} = [$value];
|
||||
$changed = 1;
|
||||
print "Set attribute for ", $entry->getDN(), "\n" if $opt_v;
|
||||
}
|
||||
$entry->setValue($attr, $value);
|
||||
$changed = 1;
|
||||
print "Set attribute for ", $entry->getDN(), "\n" if $opt_v;
|
||||
}
|
||||
}
|
||||
if ($changed && ! $opt_n)
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
#!/usr/bin/perl5
|
||||
#############################################################################
|
||||
# $Id: psoftsync.pl,v 1.4 1998-08-13 09:27:53 leif Exp $
|
||||
# $Id: psoftsync.pl,v 1.5 1999-01-21 23:52:47 leif%netscape.com Exp $
|
||||
#
|
||||
# The contents of this file are subject to the Mozilla Public License
|
||||
# Version 1.0 (the "License"); you may not use this file except in
|
||||
|
|
@ -132,7 +132,7 @@ chop($TODAY);
|
|||
#
|
||||
sub psoftError
|
||||
{
|
||||
my($str, $entry) = @_;
|
||||
my ($str, $entry) = @_;
|
||||
|
||||
print "Error: $str: ";
|
||||
print $entry->key(), " (";
|
||||
|
|
@ -147,10 +147,9 @@ sub psoftError
|
|||
#
|
||||
sub readDump
|
||||
{
|
||||
my($file) = @_;
|
||||
my(@info);
|
||||
my(%entries);
|
||||
my($val);
|
||||
my ($file) = @_;
|
||||
my (@info, %entries);
|
||||
my $val;
|
||||
|
||||
if (!open(PSOFT, $file))
|
||||
{
|
||||
|
|
@ -206,10 +205,10 @@ sub readDump
|
|||
# Make a list "uniq", just like the Unix command.
|
||||
#
|
||||
sub uniq { # uniq(elements[])
|
||||
my(%tmp);
|
||||
my %tmp;
|
||||
|
||||
grep($tmp{$_}++, @_);
|
||||
return sort(keys(%tmp));
|
||||
grep($tmp{$_}++, @_);
|
||||
return sort(keys(%tmp));
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -217,7 +216,7 @@ sub uniq { # uniq(elements[])
|
|||
# Delete an attribute from an entry.
|
||||
#
|
||||
sub delAttr { # delAttr(ENTRY, ATTR)
|
||||
($entry, $attr) = @_;
|
||||
my ($entry, $attr) = @_;
|
||||
|
||||
if (defined($entry->{$attr}))
|
||||
{
|
||||
|
|
@ -365,7 +364,7 @@ package PsoftEntry;
|
|||
#
|
||||
sub new
|
||||
{
|
||||
my($class, $key) = @_;
|
||||
my ($class, $key) = @_;
|
||||
my $self = {};
|
||||
|
||||
bless $self, ref $class || $class;
|
||||
|
|
@ -380,7 +379,7 @@ sub new
|
|||
#
|
||||
sub add
|
||||
{
|
||||
my($self, $attr, $val, $lev) = @_;
|
||||
my ($self, $attr, $val, $lev) = @_;
|
||||
|
||||
return if ($lev & 16);
|
||||
|
||||
|
|
@ -397,7 +396,7 @@ sub add
|
|||
}
|
||||
$self->{__employeetype__} = $val;
|
||||
}
|
||||
elsif ($val eq "")
|
||||
elsif (!defined($val) || ($val eq ""))
|
||||
{
|
||||
main::psoftError("No attribute $attr", $self)
|
||||
if ($main::opt_W && ($lev & 1) && !($lev & 8));
|
||||
|
|
@ -415,7 +414,7 @@ sub add
|
|||
#
|
||||
sub get
|
||||
{
|
||||
my($self, $attr) = @_;
|
||||
my ($self, $attr) = @_;
|
||||
|
||||
return $self->{$attr};
|
||||
}
|
||||
|
|
@ -427,7 +426,7 @@ sub get
|
|||
#
|
||||
sub expired
|
||||
{
|
||||
my($self, $date) = @_;
|
||||
my ($self, $date) = @_;
|
||||
|
||||
if ($date)
|
||||
{
|
||||
|
|
@ -441,7 +440,7 @@ sub expired
|
|||
|
||||
if ($date lt $main::TODAY)
|
||||
{
|
||||
$self->{employeetype} = "$NOTYPE";
|
||||
$self->{employeetype} = "$main::NOTYPE";
|
||||
$self->{__expired__} = 1;
|
||||
|
||||
return 1;
|
||||
|
|
@ -457,7 +456,7 @@ sub expired
|
|||
#
|
||||
sub handled
|
||||
{
|
||||
my($self, $flag) = @_;
|
||||
my ($self, $flag) = @_;
|
||||
|
||||
$self->{__handled__} = 1 if $flag;
|
||||
|
||||
|
|
@ -470,7 +469,7 @@ sub handled
|
|||
#
|
||||
sub key
|
||||
{
|
||||
my($self) = @_;
|
||||
my ($self) = @_;
|
||||
|
||||
return $self->{__key__};
|
||||
}
|
||||
|
|
@ -489,7 +488,7 @@ package Mail;
|
|||
#
|
||||
sub new
|
||||
{
|
||||
my($class, $to, $from, $subject) = @_;
|
||||
my ($class, $to, $from, $subject) = @_;
|
||||
my $self = {};
|
||||
|
||||
bless $self, ref $class || $class;
|
||||
|
|
@ -511,7 +510,7 @@ sub new
|
|||
#
|
||||
sub DESTROY
|
||||
{
|
||||
my($self) = @_;
|
||||
my ($self) = @_;
|
||||
|
||||
if ($self->{send} && !$self->{nomail})
|
||||
{
|
||||
|
|
@ -526,7 +525,7 @@ sub DESTROY
|
|||
#
|
||||
sub set
|
||||
{
|
||||
my($self, $field, $string) = @_;
|
||||
my ($self, $field, $string) = @_;
|
||||
|
||||
if ($field && $string)
|
||||
{
|
||||
|
|
@ -541,7 +540,7 @@ sub set
|
|||
#
|
||||
sub write
|
||||
{
|
||||
my($self, $string) = @_;
|
||||
my ($self, $string) = @_;
|
||||
|
||||
if ($string ne "")
|
||||
{
|
||||
|
|
@ -559,7 +558,7 @@ sub write
|
|||
#
|
||||
sub force
|
||||
{
|
||||
my($self) = @_;
|
||||
my ($self) = @_;
|
||||
|
||||
$self->{send} = 1;
|
||||
$self->{nomail} = 0;
|
||||
|
|
@ -571,7 +570,7 @@ sub force
|
|||
#
|
||||
sub nomail
|
||||
{
|
||||
my($self) = @_;
|
||||
my ($self) = @_;
|
||||
|
||||
$self->{send} = 0;
|
||||
$self->{nomail} = 1;
|
||||
|
|
@ -583,7 +582,7 @@ sub nomail
|
|||
#
|
||||
sub echo
|
||||
{
|
||||
my($self) = @_;
|
||||
my ($self) = @_;
|
||||
|
||||
$self->{echo} = 1;
|
||||
}
|
||||
|
|
@ -595,7 +594,7 @@ sub echo
|
|||
#
|
||||
sub send
|
||||
{
|
||||
my($self) = @_;
|
||||
my ($self) = @_;
|
||||
|
||||
if ($self->{send} && !$self->{nomail})
|
||||
{
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
#!/usr/bin/perl5
|
||||
#############################################################################
|
||||
# $Id: qsearch.pl,v 1.7 1998-08-13 09:28:05 leif Exp $
|
||||
# $Id: qsearch.pl,v 1.8 1999-01-21 23:52:47 leif%netscape.com Exp $
|
||||
#
|
||||
# The contents of this file are subject to the Mozilla Public License
|
||||
# Version 1.0 (the "License"); you may not use this file except in
|
||||
|
|
@ -29,6 +29,9 @@ use Getopt::Std; # To parse command line arguments.
|
|||
use Mozilla::LDAP::Conn; # Main "OO" layer for LDAP
|
||||
use Mozilla::LDAP::Utils; # LULU, utilities.
|
||||
|
||||
use strict;
|
||||
no strict "vars";
|
||||
|
||||
|
||||
#################################################################################
|
||||
# Constants, shouldn't have to edit these...
|
||||
|
|
@ -80,7 +83,7 @@ foreach $search (@srch)
|
|||
print "Searched for `$search':\n\n";
|
||||
$conn->printError() if $conn->getErrorCode();
|
||||
|
||||
while($entry)
|
||||
while ($entry)
|
||||
{
|
||||
$entry->printLDIF();
|
||||
$entry = $conn->nextEntry;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
#!/usr/bin/perl5
|
||||
#############################################################################
|
||||
# $Id: rename.pl,v 1.3 1998-08-13 09:56:03 leif Exp $
|
||||
# $Id: rename.pl,v 1.4 1999-01-21 23:52:47 leif%netscape.com Exp $
|
||||
#
|
||||
# The contents of this file are subject to the Mozilla Public License
|
||||
# Version 1.0 (the "License"); you may not use this file except in
|
||||
|
|
@ -37,8 +37,6 @@ use Mozilla::LDAP::Utils; # LULU, utilities.
|
|||
$APPNAM = "rename";
|
||||
$USAGE = "$APPNAM [-nvI] -b base -h host -D bind -w pswd -P cert filter new_rdn";
|
||||
|
||||
@ATTRIBUTES = ("objectclass");
|
||||
|
||||
|
||||
#############################################################################
|
||||
# Check arguments, and configure some parameters accordingly..
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
#!/usr/bin/perl5
|
||||
#############################################################################
|
||||
# $Id: rmentry.pl,v 1.3 1998-08-13 09:10:57 leif Exp $
|
||||
# $Id: rmentry.pl,v 1.4 1999-01-21 23:52:47 leif%netscape.com Exp $
|
||||
#
|
||||
# The contents of this file are subject to the Mozilla Public License
|
||||
# Version 1.0 (the "License"); you may not use this file except in
|
||||
|
|
@ -77,7 +77,7 @@ foreach $search (@ARGV)
|
|||
{
|
||||
if (! $opt_n)
|
||||
{
|
||||
$conn->delete($entry->{dn});
|
||||
$conn->delete($entry);
|
||||
$conn->printError() if $conn->getErrorCode();
|
||||
}
|
||||
print "Deleted $entry->{dn}\n" if $opt_v;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,6 @@
|
|||
1999-01-05 Leif Hedstrom <leif@netscape.com>
|
||||
|
||||
* entry.pl: New script, to test all Entry:: methods.
|
||||
|
||||
* conn.pl (attributeEQ): Added test for modifyRDN().
|
||||
|
||||
|
|
@ -0,0 +1,270 @@
|
|||
#!/usr/bin/perl5
|
||||
#############################################################################
|
||||
# $Id: conn.pl,v 1.2 1999-01-21 23:52:50 leif%netscape.com Exp $
|
||||
#
|
||||
# The contents of this file are subject to the Mozilla Public License
|
||||
# Version 1.0 (the "License"); you may not use this file except in
|
||||
# compliance with the License. You may obtain a copy of the License at
|
||||
# http://www.mozilla.org/MPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS IS"
|
||||
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
|
||||
# License for the specific language governing rights and limitations
|
||||
# under the License.
|
||||
#
|
||||
# The Original Code is PerLDAP. The Initial Developer of the Original
|
||||
# Code is Netscape Communications Corp. and Clayton Donley. Portions
|
||||
# created by Netscape are Copyright (C) Netscape Communications
|
||||
# Corp., portions created by Clayton Donley are Copyright (C) Clayton
|
||||
# Donley. All Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
#
|
||||
# DESCRIPTION
|
||||
# Test most (all?) of the LDAP::Mozilla::Conn methods.
|
||||
#
|
||||
#############################################################################
|
||||
|
||||
use Getopt::Std; # To parse command line arguments.
|
||||
use Mozilla::LDAP::Conn; # Main "OO" layer for LDAP
|
||||
use Mozilla::LDAP::Utils; # LULU, utilities.
|
||||
use Mozilla::LDAP::API;
|
||||
|
||||
use strict;
|
||||
no strict "vars";
|
||||
|
||||
|
||||
#################################################################################
|
||||
# Configurations, modify these as needed.
|
||||
#
|
||||
$BIND = "uid=ldapadmin";
|
||||
$BASE = "o=Netscape Communications Corp.,c=US";
|
||||
$PEOPLE = "ou=people";
|
||||
$GROUPS = "ou=groups";
|
||||
$UID = "leif-test";
|
||||
$CN = "test-group-1";
|
||||
|
||||
|
||||
#################################################################################
|
||||
# Constants, shouldn't have to edit these...
|
||||
#
|
||||
$APPNAM = "conn.pl";
|
||||
$USAGE = "$APPNAM -b base -h host -D bind -w pswd -P cert";
|
||||
|
||||
|
||||
#################################################################################
|
||||
# Check arguments, and configure some parameters accordingly..
|
||||
#
|
||||
if (!getopts('b:h:D:p:s:w:P:'))
|
||||
{
|
||||
print "usage: $APPNAM $USAGE\n";
|
||||
exit;
|
||||
}
|
||||
%ld = Mozilla::LDAP::Utils::ldapArgs($BIND, $BASE);
|
||||
|
||||
|
||||
#################################################################################
|
||||
# Get an LDAP connection
|
||||
#
|
||||
sub getConn
|
||||
{
|
||||
my $conn;
|
||||
|
||||
if ($main::reuseConn)
|
||||
{
|
||||
if (!defined($main::mainConn))
|
||||
{
|
||||
$main::mainConn = new Mozilla::LDAP::Conn(\%main::ld);
|
||||
die "Could't connect to LDAP server $main::ld{host}"
|
||||
unless $main::mainConn;
|
||||
}
|
||||
return $main::mainConn;
|
||||
}
|
||||
else
|
||||
{
|
||||
$conn = new Mozilla::LDAP::Conn(\%main::ld);
|
||||
die "Could't connect to LDAP server $main::ld{host}" unless $conn;
|
||||
}
|
||||
|
||||
return $conn;
|
||||
}
|
||||
|
||||
|
||||
#################################################################################
|
||||
# Some small help functions...
|
||||
#
|
||||
sub dotPrint
|
||||
{
|
||||
my $str = shift;
|
||||
|
||||
print $str . '.' x (20 - length($str));
|
||||
}
|
||||
|
||||
sub attributeEQ
|
||||
{
|
||||
my @a, @b;
|
||||
my $i;
|
||||
|
||||
@a = @{$_[0]};
|
||||
@b = @{$_[1]};
|
||||
return 1 if (($#a < 0) && ($#b < 0));
|
||||
return 0 unless ($#a == $#b);
|
||||
|
||||
@a = sort(@a);
|
||||
@b = sort(@b);
|
||||
for ($i = 0; $i <= $#a; $i++)
|
||||
{
|
||||
return 0 unless ($a[$i] eq $b[$i]);;
|
||||
}
|
||||
|
||||
return 1; # We passed all the tests, we're ok.
|
||||
}
|
||||
|
||||
|
||||
#################################################################################
|
||||
# Test adding, deleting and retrieving entries.
|
||||
#
|
||||
$filter = "(uid=$UID)";
|
||||
$conn = getConn();
|
||||
$nentry = $conn->newEntry();
|
||||
|
||||
$nentry->setDN("uid=$UID, $PEOPLE, $BASE");
|
||||
$nentry->{objectclass} = [ "top", "person", "inetOrgPerson", "mailRecipient" ];
|
||||
$nentry->addValue("uid", $UID);
|
||||
$nentry->addValue("sn", "Hedstrom");
|
||||
$nentry->addValue("givenName", "Leif");
|
||||
$nentry->addValue("cn", "Leif Hedstrom");
|
||||
$nentry->addValue("cn", "Leif P. Hedstrom");
|
||||
$nentry->addValue("cn", "The Swede");
|
||||
$nentry->addValue("mail", "leif\@ogre.com");
|
||||
|
||||
$ent = $conn->search($ld{root}, $ld{scope}, $filter);
|
||||
$conn->delete($ent->getDN()) if $ent;
|
||||
|
||||
dotPrint("Conn/newEntry");
|
||||
$conn->add($nentry) || print "not ";
|
||||
print "ok\n";
|
||||
|
||||
dotPrint("Conn/delete");
|
||||
$conn->delete($nentry) || print "not ";
|
||||
print "ok\n";
|
||||
|
||||
dotPrint("Conn/add");
|
||||
$conn->add($nentry) || print "not ";
|
||||
print "ok\n";
|
||||
|
||||
dotPrint("Conn/delete(DN)");
|
||||
$conn->delete($nentry->getDN()) || print "not ";
|
||||
print "ok\n";
|
||||
|
||||
$conn->add($nentry) || die "Can't create entry again...\n";
|
||||
dotPrint("Conn/search");
|
||||
$ent = $conn->search($ld{root}, $ld{scope}, $filter);
|
||||
$err = 0;
|
||||
foreach (keys (%{$nentry}))
|
||||
{
|
||||
$err = 1 unless (defined($ent->{$_})
|
||||
&& attributeEQ($nentry->{$_}, $ent->{$_}));
|
||||
}
|
||||
print "not " if $err;
|
||||
print "ok\n";
|
||||
|
||||
$conn->close();
|
||||
|
||||
|
||||
#################################################################################
|
||||
# Test LDAP URL handling.
|
||||
#
|
||||
$conn = getConn();
|
||||
|
||||
$url1 = "ldap:///" . $ld{root} . "??sub?$filter";
|
||||
$url2 = "ldaps:///" . $ld{root} . "??sub?$filter";
|
||||
$badurl1 = "ldap:" . $ld{root} . "??sub?$filter";
|
||||
$badurl2 = "http://" . $ld{root} . "??sub?$filter";
|
||||
|
||||
dotPrint("Conn/isURL");
|
||||
print "not " unless ($conn->isURL($url1) && $conn->isURL($url2) &&
|
||||
!$conn->isURL($badurl2) && !$conn->isURL($badurl1));
|
||||
print "ok\n";
|
||||
|
||||
dotPrint("Conn/searchURL");
|
||||
$ent = $conn->searchURL($url1);
|
||||
$err = 0;
|
||||
foreach (keys (%{$nentry}))
|
||||
{
|
||||
|
||||
$err = 1 unless (defined($ent->{$_})
|
||||
&& attributeEQ($nentry->{$_}, $ent->{$_}));
|
||||
}
|
||||
print "not " if $err;
|
||||
print "ok\n";
|
||||
|
||||
$conn->close();
|
||||
|
||||
|
||||
#################################################################################
|
||||
# Test some small internal stuff.
|
||||
#
|
||||
$conn = getConn();
|
||||
|
||||
$ent = $conn->search($ld{root}, $ld{scope}, $filter);
|
||||
print "Can't locate entry again" unless $ent;
|
||||
|
||||
dotPrint("Conn/getLD+getRes");
|
||||
$err = 0;
|
||||
$cld = $conn->getLD();
|
||||
$res = $conn->getRes();
|
||||
|
||||
$err = 1 unless $cld;
|
||||
$err = 1 unless $res;
|
||||
|
||||
$count = Mozilla::LDAP::API::ldap_count_entries($cld, $res);
|
||||
$err = 1 unless ($count == 1);
|
||||
print "not " if $err;
|
||||
print "ok\n";
|
||||
|
||||
$conn->close();
|
||||
|
||||
|
||||
#################################################################################
|
||||
# Test the simple authentication method
|
||||
#
|
||||
$conn = new Mozilla::LDAP::Conn($ld{host}, $ld{port});
|
||||
$ent = $conn->search($ld{root}, $ld{scope}, $filter);
|
||||
die "Can't locate entry again" unless $ent;
|
||||
|
||||
dotPrint("Conn/simpleAuth");
|
||||
$err = 0;
|
||||
$conn->simpleAuth($ld{bind}, $ld{pswd}) || ($err = 1);
|
||||
$ent = $conn->search($ld{root}, $ld{scope}, $filter);
|
||||
$err = 1 unless $ent;
|
||||
print "not " if $err;
|
||||
print "ok\n";
|
||||
|
||||
$conn->close();
|
||||
|
||||
|
||||
#################################################################################
|
||||
# Test the modifyRDN functionality
|
||||
#
|
||||
$conn = getConn();
|
||||
$ent = $conn->search($ld{root}, $ld{scope}, $filter);
|
||||
die "Can't locate entry again" unless $ent;
|
||||
|
||||
dotPrint("Conn/modifyRDN");
|
||||
$err = 0;
|
||||
$rdn = "uid=$UID-rdn";
|
||||
$conn->modifyRDN($rdn, $ent->getDN()) || ($err = 1);
|
||||
|
||||
$filter = "($rdn)";
|
||||
$ent = $conn->search($ld{root}, $ld{scope}, $filter);
|
||||
$err = 1 unless $ent;
|
||||
print "not " if $err;
|
||||
print "ok\n";
|
||||
|
||||
$conn->delete($ent->getDN()) if $ent;
|
||||
|
||||
|
||||
#################################################################################
|
||||
# Test error handling (ToDo!)
|
||||
#
|
||||
|
|
@ -0,0 +1,150 @@
|
|||
#!/usr/bin/perl5
|
||||
#############################################################################
|
||||
# $Id: entry.pl,v 1.2 1999-01-21 23:52:50 leif%netscape.com Exp $
|
||||
#
|
||||
# The contents of this file are subject to the Mozilla Public License
|
||||
# Version 1.0 (the "License"); you may not use this file except in
|
||||
# compliance with the License. You may obtain a copy of the License at
|
||||
# http://www.mozilla.org/MPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS IS"
|
||||
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
|
||||
# License for the specific language governing rights and limitations
|
||||
# under the License.
|
||||
#
|
||||
# The Original Code is PerLDAP. The Initial Developer of the Original
|
||||
# Code is Netscape Communications Corp. and Clayton Donley. Portions
|
||||
# created by Netscape are Copyright (C) Netscape Communications
|
||||
# Corp., portions created by Clayton Donley are Copyright (C) Clayton
|
||||
# Donley. All Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
#
|
||||
# DESCRIPTION
|
||||
# Test most (all?) of the LDAP::Mozilla::Conn methods.
|
||||
#
|
||||
#############################################################################
|
||||
|
||||
use Getopt::Std; # To parse command line arguments.
|
||||
use Mozilla::LDAP::Conn; # Main "OO" layer for LDAP
|
||||
use Mozilla::LDAP::Utils; # LULU, utilities.
|
||||
use Mozilla::LDAP::API;
|
||||
|
||||
use strict;
|
||||
no strict "vars";
|
||||
|
||||
|
||||
#################################################################################
|
||||
# Configurations, modify these as needed.
|
||||
#
|
||||
$BIND = "uid=ldapadmin";
|
||||
$BASE = "o=Netscape Communications Corp.,c=US";
|
||||
$PEOPLE = "ou=people";
|
||||
$GROUPS = "ou=groups";
|
||||
$UID = "leif-test";
|
||||
$CN = "test-group-1";
|
||||
|
||||
|
||||
#################################################################################
|
||||
# Constants, shouldn't have to edit these...
|
||||
#
|
||||
$APPNAM = "entry.pl";
|
||||
$USAGE = "$APPNAM -b base -h host -D bind -w pswd -P cert";
|
||||
|
||||
|
||||
#################################################################################
|
||||
# Check arguments, and configure some parameters accordingly..
|
||||
#
|
||||
if (!getopts('b:h:D:p:s:w:P:'))
|
||||
{
|
||||
print "usage: $APPNAM $USAGE\n";
|
||||
exit;
|
||||
}
|
||||
%ld = Mozilla::LDAP::Utils::ldapArgs($BIND, $BASE);
|
||||
|
||||
|
||||
#################################################################################
|
||||
# Get an LDAP connection
|
||||
#
|
||||
sub getConn
|
||||
{
|
||||
my $conn;
|
||||
|
||||
if ($main::reuseConn)
|
||||
{
|
||||
if (!defined($main::mainConn))
|
||||
{
|
||||
$main::mainConn = new Mozilla::LDAP::Conn(\%main::ld);
|
||||
die "Could't connect to LDAP server $main::ld{host}"
|
||||
unless $main::mainConn;
|
||||
}
|
||||
return $main::mainConn;
|
||||
}
|
||||
else
|
||||
{
|
||||
$conn = new Mozilla::LDAP::Conn(\%main::ld);
|
||||
die "Could't connect to LDAP server $main::ld{host}" unless $conn;
|
||||
}
|
||||
|
||||
return $conn;
|
||||
}
|
||||
|
||||
|
||||
#################################################################################
|
||||
# Some small help functions...
|
||||
#
|
||||
sub dotPrint
|
||||
{
|
||||
my $str = shift;
|
||||
|
||||
print $str . '.' x (20 - length($str));
|
||||
}
|
||||
|
||||
sub attributeEQ
|
||||
{
|
||||
my @a, @b;
|
||||
my $i;
|
||||
|
||||
@a = @{$_[0]};
|
||||
@b = @{$_[1]};
|
||||
return 1 if (($#a < 0) && ($#b < 0));
|
||||
return 0 unless ($#a == $#b);
|
||||
|
||||
@a = sort(@a);
|
||||
@b = sort(@b);
|
||||
for ($i = 0; $i <= $#a; $i++)
|
||||
{
|
||||
return 0 unless ($a[$i] eq $b[$i]);;
|
||||
}
|
||||
|
||||
return 1; # We passed all the tests, we're ok.
|
||||
}
|
||||
|
||||
|
||||
#################################################################################
|
||||
# Setup the test entries.
|
||||
#
|
||||
$filter = "(uid=$UID)";
|
||||
$conn = getConn();
|
||||
$nentry = $conn->newEntry();
|
||||
|
||||
$nentry->setDN("uid=$UID, $PEOPLE, $BASE");
|
||||
$nentry->{objectclass} = [ "top", "person", "inetOrgPerson", "mailRecipient" ];
|
||||
$nentry->addValue("uid", $UID);
|
||||
$nentry->addValue("sn", "Hedstrom");
|
||||
$nentry->addValue("givenName", "Leif");
|
||||
$nentry->addValue("cn", "Leif Hedstrom");
|
||||
$nentry->addValue("cn", "Leif P. Hedstrom");
|
||||
$nentry->addValue("cn", "The Swede");
|
||||
$nentry->addValue("description", "Test1");
|
||||
$nentry->addValue("description", "Test2");
|
||||
$nentry->addValue("description", "Test3");
|
||||
$nentry->addValue("description", "Test4");
|
||||
$nentry->addValue("description", "Test5");
|
||||
$nentry->addValue("mail", "leif\@ogre.com");
|
||||
|
||||
$ent = $conn->search($ld{root}, $ld{scope}, $filter);
|
||||
$conn->delete($ent->getDN()) if $ent;
|
||||
$conn->add($nentry);
|
||||
|
||||
$conn->close();
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
#!/usr/bin/perl -w
|
||||
#############################################################################
|
||||
# $Id: api.pl,v 1.6 1998-08-13 04:40:00 clayton Exp $
|
||||
# $Id: api.pl,v 1.7 1999-01-21 23:52:52 leif%netscape.com Exp $
|
||||
#
|
||||
# The contents of this file are subject to the Mozilla Public License
|
||||
# Version 1.0 (the "License"); you may not use this file except in
|
||||
|
|
@ -12,7 +12,7 @@
|
|||
# License for the specific language governing rights and limitations
|
||||
# under the License.
|
||||
#
|
||||
# The Original Code is PerlDAP. The Initial Developer of the Original
|
||||
# The Original Code is PerLDAP. The Initial Developer of the Original
|
||||
# Code is Netscape Communications Corp. and Clayton Donley. Portions
|
||||
# created by Netscape are Copyright (C) Netscape Communications
|
||||
# Corp., portions created by Clayton Donley are Copyright (C) Clayton
|
||||
|
|
@ -44,6 +44,10 @@ if (!$HOST)
|
|||
exit -1;
|
||||
}
|
||||
|
||||
print "\nPerLDAP API TestSuite\n";
|
||||
print "\nNote: Failures in earlier tests will cause later tests to fail.\n";
|
||||
print "\n";
|
||||
|
||||
my $howmany = 10;
|
||||
|
||||
# Initialize the Connection
|
||||
|
|
@ -132,8 +136,9 @@ foreach my $number (1..$howmany)
|
|||
foreach my $number (1..$howmany)
|
||||
{
|
||||
$entry = {
|
||||
"sn" => {"a",["Test"]},
|
||||
"telephoneNumber" => "800-555-111$number",
|
||||
"sn" => {"ab",["Test"]},
|
||||
"telephoneNumber" => {"ab",[123.456]},
|
||||
# "telephoneNumber" => "800-555-111$number",
|
||||
};
|
||||
if (ldap_modify_s($ld,"cn=Mozilla $number,$BASE",$entry)
|
||||
!= LDAP_SUCCESS)
|
||||
|
|
|
|||
Загрузка…
Ссылка в новой задаче