mozilla
/
mozilla-history
зеркало из https://github.com/mozilla/mozilla-history.git
1
0
Форкнуть 0
Код Задачи Пакеты Проекты Релизы Вики Активность

Merged v1.3.x to trunk, for v1.4 release

This commit is contained in:
leif%netscape.com 1999-08-24 22:30:55 +00:00
Родитель daac3f22da
Коммит d96b56077a
23 изменённых файлов: 2742 добавлений и 748 удалений
Показать статистику Скачать Patch файл Скачать Diff файл Показать все файлы Свернуть все файлы

11
directory/perldap/API.pm
Просмотреть файл

@ -1,5 +1,5 @@
#############################################################################
# $Id: API.pm,v 1.14 1999-03-22 04:13:22 leif%netscape.com Exp $
# $Id: API.pm,v 1.15 1999-08-24 22:30:40 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,11 +247,11 @@ require AutoLoader;
# Add Everything in %EXPORT_TAGS to @EXPORT_OK
Exporter::export_ok_tags(keys %EXPORT_TAGS);
$VERSION = '1.2.1';
$VERSION = '1.4';
# The XS 'constant' routine returns an integer. There are all constants
# we want to return something else.
my %OVERRIDE_CONST = (
my (%OVERRIDE_CONST) = (
"LDAP_ALL_USER_ATTRS","*",
"LDAP_CONTROL_ENTRYCHANGE","2.16.840.1.113730.3.4.7",
"LDAP_CONTROL_MANAGEDSAIT","2.16.840.1.113730.3.4.2",
@ -271,13 +271,14 @@ my %OVERRIDE_CONST = (
);
sub AUTOLOAD {
my ($constname);
my ($val);
# This AUTOLOAD is used to 'autoload' constants from the constant()
# XS function. If a constant is not found then control is passed
# to the AUTOLOAD in AutoLoader.
my $constname;
($constname = $AUTOLOAD) =~ s/.*:://;
my $val;
if (($val = $OVERRIDE_CONST{$constname}))
{
eval "sub $AUTOLOAD { $val }";

268
directory/perldap/API.xs
Просмотреть файл

@ -1,5 +1,5 @@
/******************************************************************************
* $Id: API.xs,v 1.16 1999-01-21 23:52:41 leif%netscape.com Exp $
* $Id: API.xs,v 1.17 1999-08-24 22:30: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
@ -48,12 +48,36 @@ extern "C" {
/* AUTOLOAD methods for LDAP constants */
#include "constant.h"
/* Prototypes - Processing LDAP Modifications */
/* Prototypes */
static int perldap_init();
static void * perldap_malloc(size_t size);
static void * perldap_calloc(size_t number, size_t size);
static void * perldap_realloc(void *ptr, size_t size);
static void perldap_free(void *ptr);
static char ** avref2charptrptr(SV *avref);
static struct berval ** avref2berptrptr(SV *avref);
static SV* charptrptr2avref(char **cppval);
static SV* berptrptr2avref(struct berval **bval);
static LDAPMod *parse1mod(SV *ldap_value_ref,char *ldap_current_attribute,
int ldap_add_func,int cont);
static int calc_mod_size(HV *ldap_change);
static LDAPMod **hash2mod(SV *ldap_change_ref,int ldap_add_func,const char *func);
/* Prototypes - Calls for Handling Rebinds */
static int StrCaseCmp(const char *s, const char *t);
static char * StrDup(const char *source);
static int LDAP_CALL internal_rebind_proc(LDAP *ld,char **dnp,char **pwp,
int *authmethodp,int freeit,void *arg);
@ -89,8 +113,71 @@ static int ldap_default_rebind_auth = LDAP_AUTH_SIMPLE;
} \
ldap_value_free_len(bvppvar); }
/*
* Function Definition
*/
static
int
perldap_init()
{
struct ldap_memalloc_fns memalloc_fns;
memalloc_fns.ldapmem_malloc = perldap_malloc;
memalloc_fns.ldapmem_calloc = perldap_calloc;
memalloc_fns.ldapmem_realloc = perldap_realloc;
memalloc_fns.ldapmem_free = perldap_free;
return (ldap_set_option(NULL,
LDAP_OPT_MEMALLOC_FN_PTRS,
&memalloc_fns));
}
static
void *
perldap_malloc(size_t size)
{
void *new_ptr;
New(1, new_ptr, size, char);
return (new_ptr);
}
static
void *
perldap_calloc(size_t number, size_t size)
{
void *new_ptr;
Newz(1, new_ptr, (number*size), char);
return (new_ptr);
}
static
void *
perldap_realloc(void *ptr, size_t size)
{
Renew(ptr, size, char);
return (ptr);
}
static
void
perldap_free(void *ptr)
{
Safefree(ptr);
}
/* Return a char ** when passed a reference to an AV */
char ** avref2charptrptr(SV *avref)
static
char **
avref2charptrptr(SV *avref)
{
I32 avref_arraylen;
int ix_av;
@ -107,15 +194,17 @@ char ** avref2charptrptr(SV *avref)
for (ix_av = 0;ix_av <= avref_arraylen;ix_av++)
{
current_val = av_fetch((AV *)SvRV(avref),ix_av,0);
tmp_cpp[ix_av] = strdup(SvPV(*current_val,na));
tmp_cpp[ix_av] = StrDup(SvPV(*current_val,na));
}
tmp_cpp[ix_av] = NULL;
return(tmp_cpp);
return (tmp_cpp);
}
/* Return a struct berval ** when passed a reference to an AV */
struct berval ** avref2berptrptr(SV *avref)
static
struct berval **
avref2berptrptr(SV *avref)
{
I32 avref_arraylen;
int ix_av,val_len;
@ -151,7 +240,9 @@ struct berval ** avref2berptrptr(SV *avref)
/* Return an AV reference when given a char ** */
SV* charptrptr2avref(char **cppval)
static
SV*
charptrptr2avref(char **cppval)
{
AV* tmp_av = newAV();
SV* tmp_ref = newRV((SV*)tmp_av);
@ -171,7 +262,9 @@ SV* charptrptr2avref(char **cppval)
/* Return an AV Reference when given a struct berval ** */
SV* berptrptr2avref(struct berval **bval)
static
SV*
berptrptr2avref(struct berval **bval)
{
AV* tmp_av = newAV();
SV* tmp_ref = newRV((SV*)tmp_av);
@ -195,8 +288,9 @@ SV* berptrptr2avref(struct berval **bval)
/* return a single LDAPMod pointer to this data. */
static
LDAPMod *parse1mod(SV *ldap_value_ref,char *ldap_current_attribute,
int ldap_add_func,int cont)
LDAPMod *
parse1mod(SV *ldap_value_ref,char *ldap_current_attribute,
int ldap_add_func,int cont)
{
LDAPMod *ldap_current_mod;
static HV *ldap_current_values_hv;
@ -209,7 +303,7 @@ LDAPMod *parse1mod(SV *ldap_value_ref,char *ldap_current_attribute,
if (ldap_current_attribute == NULL)
return(NULL);
Newz(1,ldap_current_mod,1,LDAPMod);
ldap_current_mod->mod_type = ldap_current_attribute;
ldap_current_mod->mod_type = StrDup(ldap_current_attribute);
if (SvROK(ldap_value_ref))
{
if (SvTYPE(SvRV(ldap_value_ref)) == SVt_PVHV)
@ -249,7 +343,7 @@ LDAPMod *parse1mod(SV *ldap_value_ref,char *ldap_current_attribute,
{
if (ldap_isa_ber == 1)
{
ldap_current_mod->mod_values = (char **)
ldap_current_mod->mod_bvalues =
avref2berptrptr(ldap_current_value_sv);
} else {
ldap_current_mod->mod_values =
@ -289,20 +383,59 @@ LDAPMod *parse1mod(SV *ldap_value_ref,char *ldap_current_attribute,
ldap_current_mod->mod_op = LDAP_MOD_REPLACE;
}
New(1,ldap_current_mod->mod_values,2,char *);
ldap_current_mod->mod_values[0] = strdup(SvPV(ldap_value_ref,na));
ldap_current_mod->mod_values[0] = StrDup(SvPV(ldap_value_ref,na));
ldap_current_mod->mod_values[1] = NULL;
}
}
return(ldap_current_mod);
}
/* calc_mod_size */
/* Calculates the number of LDAPMod's buried inside the ldap_change passed */
/* in. This is used by hash2mod to calculate the size to allocate in Newz */
static
int
calc_mod_size(HV *ldap_change)
{
int mod_size = 0;
HE *ldap_change_element;
SV *ldap_change_element_value_ref;
HV *ldap_change_element_value;
hv_iterinit(ldap_change);
while((ldap_change_element = hv_iternext(ldap_change)) != NULL)
{
ldap_change_element_value_ref = hv_iterval(ldap_change,ldap_change_element);
/* Hashes can take up multiple mod slots. */
if ( (SvROK(ldap_change_element_value_ref)) &&
(SvTYPE(SvRV(ldap_change_element_value_ref)) == SVt_PVHV) )
{
ldap_change_element_value = (HV *)SvRV(ldap_change_element_value_ref);
hv_iterinit(ldap_change_element_value);
while ( hv_iternext(ldap_change_element_value) != NULL )
{
mod_size++;
}
}
/* scalars and array references only take up one mod slot */
else
{
mod_size++;
}
}
return(mod_size);
}
/* hash2mod - Cycle through all the keys in the hash and properly call */
/* the appropriate functions to build a NULL terminated list of */
/* LDAPMod pointers. */
static
LDAPMod ** hash2mod(SV *ldap_change_ref,int ldap_add_func,const char *func)
LDAPMod **
hash2mod(SV *ldap_change_ref,int ldap_add_func,const char *func)
{
LDAPMod **ldapmod = NULL;
LDAPMod *ldap_current_mod;
@ -318,11 +451,11 @@ LDAPMod ** hash2mod(SV *ldap_change_ref,int ldap_add_func,const char *func)
ldap_change = (HV *)SvRV(ldap_change_ref);
Newz(1,ldapmod,1+HvKEYS(ldap_change),LDAPMod *);
Newz(1,ldapmod,1+calc_mod_size(ldap_change),LDAPMod *);
hv_iterinit(ldap_change);
while((ldap_change_element = hv_iternext(ldap_change)) != NULL)
{
ldap_current_attribute = strdup(hv_iterkey(ldap_change_element,&keylen));
ldap_current_attribute = hv_iterkey(ldap_change_element,&keylen);
ldap_current_value_sv = hv_iterval(ldap_change,ldap_change_element);
ldap_current_mod = parse1mod(ldap_current_value_sv,
ldap_current_attribute,ldap_add_func,0);
@ -342,7 +475,9 @@ LDAPMod ** hash2mod(SV *ldap_change_ref,int ldap_add_func,const char *func)
/* StrCaseCmp - Replacement for strcasecmp, since it doesn't exist on many
systems, including NT... */
int StrCaseCmp(const char *s, const char *t)
static
int
StrCaseCmp(const char *s, const char *t)
{
while (*s && *t && toupper(*s) == toupper(*t))
{
@ -351,10 +486,35 @@ int StrCaseCmp(const char *s, const char *t)
return(toupper(*s) - toupper(*t));
}
/*
* StrDup
*
* Duplicates a string, but uses the Perl memory allocation
* routines (so it can be free by the internal routines
*/
static
char *
StrDup(const char *source)
{
char *dest;
STRLEN length;
if ( source == NULL )
return(NULL);
length = strlen(source);
Newz(1,dest,length+1,char);
Copy(source,dest,length+1,char);
return(dest);
}
/* internal_rebind_proc - Wrapper to call a PERL rebind process */
int LDAP_CALL internal_rebind_proc(LDAP *ld, char **dnp, char **pwp,
int *authmethodp, int freeit, void *arg)
static
int
LDAP_CALL
internal_rebind_proc(LDAP *ld, char **dnp, char **pwp,
int *authmethodp, int freeit, void *arg)
{
if (freeit == 0)
{
@ -371,19 +531,19 @@ int LDAP_CALL internal_rebind_proc(LDAP *ld, char **dnp, char **pwp,
croak("ldap_perl_rebindproc: Expected DN, PASSWORD, and AUTHTYPE returned.\n");
*authmethodp = POPi;
*pwp = strdup(POPp);
*dnp = strdup(POPp);
*pwp = StrDup(POPp);
*dnp = StrDup(POPp);
FREETMPS ;
LEAVE ;
} else {
if (dnp && *dnp)
{
free(*dnp);
Safefree(*dnp);
}
if (pwp && *pwp)
{
free(*pwp);
Safefree(*pwp);
}
}
return(LDAP_SUCCESS);
@ -391,8 +551,11 @@ int LDAP_CALL internal_rebind_proc(LDAP *ld, char **dnp, char **pwp,
/* NT and internal_rebind_proc hate each other, so they need this... */
static int LDAP_CALL ldap_default_rebind_proc(LDAP *ld, char **dn, char **pwd,
int *auth, int freeit, void *arg)
static
int
LDAP_CALL
ldap_default_rebind_proc(LDAP *ld, char **dn, char **pwd,
int *auth, int freeit, void *arg)
{
if (!ldap_default_rebind_dn || !ldap_default_rebind_pwd)
{
@ -411,10 +574,16 @@ static int LDAP_CALL ldap_default_rebind_proc(LDAP *ld, char **dn, char **pwd,
}
MODULE = Mozilla::LDAP::API PACKAGE = Mozilla::LDAP::API
PROTOTYPES: ENABLE
BOOT:
if ( perldap_init() != 0)
{
fprintf(stderr, "Error loading Mozilla::LDAP::API: perldap_init failed\n");
exit(1);
}
double
constant(name,arg)
char * name
@ -442,7 +611,9 @@ ldap_add(ld,dn,attrs)
const char * dn
LDAPMod ** attrs = hash2mod($arg,1,"$func_name");
CLEANUP:
ldap_mods_free(attrs,1);
if (attrs)
ldap_mods_free(attrs, 1);
#ifdef LDAPV3
@ -458,7 +629,8 @@ ldap_add_ext(ld,dn,attrs,serverctrls,clientctrls,msgidp)
RETVAL
msgidp
CLEANUP:
ldap_mods_free(attrs,1);
if (attrs)
ldap_mods_free(attrs, 1);
int
ldap_add_ext_s(ld,dn,attrs,serverctrls,clientctrls)
@ -468,7 +640,8 @@ ldap_add_ext_s(ld,dn,attrs,serverctrls,clientctrls)
LDAPControl ** serverctrls
LDAPControl ** clientctrls
CLEANUP:
ldap_mods_free(attrs,1);
if (attrs)
ldap_mods_free(attrs, 1);
#endif
@ -478,7 +651,8 @@ ldap_add_s(ld,dn,attrs)
const char * dn
LDAPMod ** attrs = hash2mod($arg,1,"$func_name");
CLEANUP:
ldap_mods_free(attrs,1);
if (attrs)
ldap_mods_free(attrs, 1);
void
ldap_ber_free(ber,freebuf)
@ -488,7 +662,7 @@ ldap_ber_free(ber,freebuf)
{
if (ber)
{
ldap_ber_free(ber,freebuf);
ldap_ber_free(ber, freebuf);
}
}
@ -995,7 +1169,8 @@ ldap_modify(ld,dn,mods)
const char * dn
LDAPMod ** mods = hash2mod($arg,0,"$func_name");
CLEANUP:
ldap_mods_free(mods,1);
if (mods)
ldap_mods_free(mods, 1);
#ifdef LDAPV3
@ -1011,7 +1186,8 @@ ldap_modify_ext(ld,dn,mods,serverctrls,clientctrls,msgidp)
RETVAL
msgidp
CLEANUP:
ldap_mods_free(mods,1);
if (mods)
ldap_mods_free(mods, 1);
int
ldap_modify_ext_s(ld,dn,mods,serverctrls,clientctrls)
@ -1021,7 +1197,8 @@ ldap_modify_ext_s(ld,dn,mods,serverctrls,clientctrls)
LDAPControl ** serverctrls
LDAPControl ** clientctrls
CLEANUP:
ldap_mods_free(mods,1);
if (mods)
ldap_mods_free(mods, 1);
#endif
@ -1029,9 +1206,10 @@ int
ldap_modify_s(ld,dn,mods)
LDAP * ld
const char * dn
LDAPMod ** mods = hash2mod($arg,0,"$func_name");
LDAPMod ** mods = hash2mod($arg, 0, "$func_name");
CLEANUP:
ldap_mods_free(mods,1);
if (mods)
ldap_mods_free(mods, 1);
int
ldap_modrdn(ld,dn,newrdn)
@ -1294,7 +1472,7 @@ ldap_sasl_bind_s(ld,dn,mechanism,cred,serverctrls,clientctrls,servercredp)
struct berval &cred
LDAPControl ** serverctrls
LDAPControl ** clientctrls
struct berval **servercredp
struct berval **servercredp = NO_INIT
OUTPUT:
RETVAL
servercredp
@ -1435,8 +1613,18 @@ ldap_set_default_rebind_proc(ld, dn, pwd, auth)
int auth
CODE:
{
ldap_default_rebind_dn = strdup(dn);
ldap_default_rebind_pwd = strdup(pwd);
if ( ldap_default_rebind_dn != NULL )
{
Safefree(ldap_default_rebind_dn);
ldap_default_rebind_dn = NULL;
}
if ( ldap_default_rebind_pwd != NULL )
{
Safefree(ldap_default_rebind_pwd);
ldap_default_rebind_pwd = NULL;
}
ldap_default_rebind_dn = StrDup(dn);
ldap_default_rebind_pwd = StrDup(pwd);
ldap_default_rebind_auth = auth;
ldap_set_rebind_proc(ld,

48
directory/perldap/CREDITS Normal file
Просмотреть файл

@ -0,0 +1,48 @@
This is a short list of people that have contributed to the success of
this project.
* Leif Hedstrom <leif@perldap.org>
- Project lead.
- Wrote some of the API code, and most of OO layers (Conn.pm,
Entry.pm etc.)
- Unix portability test.
- Port to Windows/NT and ActivePerl.
* Clayton Donley
- Wrote a lot of the initial API code (API.xs and API.pm).
* Kevin McCarthy <kmccarth@perldap.org>
- Bug fixes, tons of contribution, particularly to the API.xs file.
* Michelle Wyner <mwyner@perldap.org>
- Testing, bug fixes, and documentation, as well as working on new
modules for PerLDAP v2.0.
* John Kristian <kristian@netscape.com>
- Rewrote the entire LDIF module, great stuff!
* Netscape Netcenter team (Kevin Burns, Max Block, Mark Takacs etc.)
- Tons of ideas and requests for features.
- Discovering bugs daily (great, thanks... ;-).
* Bob Ferguson <rferguso@netscape.com>
- Primary guinea pig for all my NT builds.
* Everyone else that I've forgot to mention:
- Thanks for testing and debugging this package!

251
directory/perldap/ChangeLog
Просмотреть файл

@ -1,3 +1,182 @@
1999-08-24 Leif Hedstrom <leif@netscape.com>
* Merged v1.3.x into trunk, tagged it as v1.4, and released it!
1999-08-19 Leif Hedstrom <leif@netscape.com>
* Changed internal version numbering again, just called this plain
v1.4.
* Entry.pm (FIRSTKEY): Bug fix, we'd crap out if there are no
attributes in the returned entry.
(NEXTKEY): Ditto.
1999-08-18 Leif Hedstrom <leif@netscape.com>
* Set version number to v1.4! Woohoo! Also tagged it as v1.3.4,
last "development" release.
1999-08-17 Leif Hedstrom <leif@netscape.com>
* Makefile.PL: Fixes for Windows/NT, cleaned out some code etc.
(MY::postamble): Support for "make html".
* MANIFEST: Updated with all new files etc.
* test.pl: Renamed to oldtest.pl, to avoid "make test" to fail.
1999-08-16 Kevin McCarthy <kmccarth@perldap.org> and Leif Hedstrom
* API.xs: Cleaned most all the memory allocation changes, we are
changing it to use the LDAP_OPT_MEMALLOC_FN_PTRS option in the
C-SDK instead (much cleaner!).
(perldap_init): New function, set up the memory management
handlers. This is called when the API module is loaded.
(perldap_malloc): New function, our memory management method(s).
(perldap_calloc): Ditto.
(perldap_realloc): Ditto.
(perldap_free): Ditto.
1999-08-16 Kevin McCarthy <kmccarth@perldap.org>
* API.xs: Cleaned up prototypes, changed strdup() to use a
Perl'ified version, change a number of free()'s to use Safefree.
(ldap_value_free_perl): New function, similar to
ldap_mods_free_perl(), to avoid memory problems (on NT and
ActivePerl primarily).
(StrDup): New function, to handle strdup() calls in a safe way.
(ber_bvfree_perl): Ditto.
(ber_bvecfree_perl): Ditto.
1999-08-15 Leif Hedstrom <leif@netscape.com>
* API.xs (ldap_mods_free_perl): Modified version of
ldap_mods_free(), which uses Perl native free method instead of
the things from the LDAP SDK. This fixes some nasty issues with
Windows/NT and ActiveState Perl. Woohoo!!!
1999-08-14 Leif Hedstrom <leif@netscape.com> and Kevin McCarthy
* Entry.pm (setValues): Implemented bug fix for bug id 7131, where
the "_save_" structures weren't set properly when using setValues().
1999-08-14 Kevin McCarthy <kmccarth@perldap.org>
* Conn.pm (update): Rewrote to optimize add/remove vs replace
operations. Basically, we'll try to do whatever seems to be the
smallest amount of work for the LDAP server now.
1999-08-13 Leif Hedstrom <leif@netscape.com>
* Makefile.PL: Cleaned up code, and added support for linking in
the missing libraries need for some missing symbols.
1999-08-13 Michelle Wyner <mwyner@netscape.com>
* Entry.pm: Updated documentation, and cleaned it up.
* Conn.pm: Ditto.
1999-08-12 Leif Hedstrom <leif@netscape.com>
* Entry.pm (move): Changed name, was rename(), is now move().
1999-08-10 Leif Hedstrom <leif@netscape.com>
* Entry.pm (setValues): Renamed, used to be setValue(), which is
now an alias to setValues().
(getValues): New method, to get the array of values.
(STORE): Fixed tests around DN handling, making sure it's not
treated as an array. I also optimized a couple of tests, since we
now filter out "DN" earlier in the funtion(s).
(attrModified): Ditto.
(attrClean): Ditto.
(unRemove): Ditto.
(removeValue): Ditto.
(addValue): Ditto.
1999-08-08 Leif Hedstrom <leif@netscape.com> and Kevin McCarthy
* Entry.pm (setValue): Remove _delete_ flag, if set.
* Conn.pm (close): Fixed memory leak, moved code from the DESTROY
method over here.
(DESTROY): Call the close() method.
(getErrorCode): We now return LDAP_SUCCESS if there is no LDAP
connection handle.
(getErrorString): Ditto.
* Entry.pm (STORE): Bug fix for large attribute sets.
(attrModified): Ditto.
(removeValue): Ditto.
(addValue): Ditto.
(EXISTS): Fix for bug 4368, cleaning up the code, and avoid the
double calls.
1999-08-06 Leif Hedstrom <leif@netscape.com> and Kevin McCarthy
* API.xs: Added some more tests around free() statements. These
are most likely never triggered, but better safe than sorrow (and
the overhead of testing this is insignificant).
* Conn.pm (browse): Added this function, to make it easy to browse
an entry.
(compare): Compare an attribute value against a DN/entry, without
having to do the search.
* Entry.pm (removeValue): Fixed loop bug.
(addValue): Ditto.
(hasValue): Ditto.
(matchValue): Fixed loop bug, and also missing normalization in
half of the case statement.
(rename): Added this new method, to rename attributes.
(copy): Added, to copy attributes.
* Merged v1.2.3 with v1.3 branch.
1999-08-06 Kevin McCarthy <kmccarth@perldap.org>
* Entry.pm (addDNValue): Bug fix, index for norm was wrong.
* Entry.pm (size): Optimzied for performance.
1999-07-25 Kevin McCarthy <kmccarth@perldap.org>
* API.xs: Fixed memory allocation problems in parsing and
generating the LDAPMods structure.
1999-06-22 Leif Hedstrom <leif@netscape.com>
* Conn.pm (add): Fixed bug 3342, thanks to Kevin McCarthy for
debugging this, and providing a patch. This fixes the problem with
adding new entries that has binary data.
1999-03-23 Leif Hedstrom <leif@netscape.com>
* Changed versioning numbers for all .pm files.
1999-03-22 Leif Hedstrom <leif@netscape.com>
* Entry.pm: Removed all _self_obj_ stuff...
* Conn.pm: Ditto.
* Conn.pm: Cleanup in use statements, and "use strict".
(search): Avoid warnings of uninitialized variables.
(searchURL): Ditto.
(modifyRDN): Bugfix, we did not update the appropriate DN in the
self object (very minor...).
* Entry.pm: Cleanup in use statements, and "use strict".
(BEGIN): Added this initializer, to use the new LDIF module.
(STORE): Fixed bug where we would not ignore the internal instance
variables properly.
* Utils.pm: Cleanup in all use statements, and "use strict". Also
enforces the VERSION control feature.
* Merged v1.2.1 to devel-branch-1_3, and tagged v1.3.1.
1999-03-21 Leif Hedstrom <leif@netscape.com>
* Checked in v1.2.1(beta).
@ -17,7 +196,7 @@
(addValue): Bug fix, when calling delete, and then
addValue(). From Stephen P. Schaefer as well.
* Conn.pm: Dito. This fixes the bug where qsearch/printLDIF()
* Conn.pm: Ditto. This fixes the bug where qsearch/printLDIF()
would print multiple values.
1999-03-12 Leif Hedstrom <leif@netscape.com>
@ -70,7 +249,7 @@
* Utils.pm (ldapArgs): Changed "root" to "base" in the LD
structure.
(userCredentials): Dito.
(userCredentials): Ditto.
* Conn.pm: Changed documentation to reflect the "base/root"
change.
@ -91,12 +270,12 @@
* 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.
(close): Ditto.
(delete): Ditto.
(add): Ditto.
(modifyRDN): Ditto.
(update): Ditto.
(simpleAuth): Ditto.
* Entry.pm (NEXTKEY): Don't return the last $key if it's one that
should be hidden.
@ -108,14 +287,14 @@
* Entry.pm (setDN): Added third optional argument, to enfoce DN
normalization.
(getDN): Dito.
(hasDNValue): Dito.
(matchDNValue): Dito.
(getDN): Ditto.
(hasDNValue): Ditto.
(matchDNValue): Ditto.
* Entry.pm (removeValue): Added support for DN normalization
(optional argument).
(addValue): Dito
(getDN): Dito.
(addValue): Ditto
(getDN): Ditto.
1998-12-31 Leif Hedstrom <leif@netscape.com>
@ -124,14 +303,14 @@
* Conn.pm (add): Use _oc_order_ to find a list of attributes, to
avoide calling the TIEHASH methods.
(update): Dito.
(update): Ditto.
(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.
(remove): Ditto.
* Conn.pm (nextEntry): Return $obj instead of blessing the %entry
(again).
@ -144,15 +323,15 @@
* Conn.pm (DESTROY): undef the Perl data after doing a
ldap_msgfree(), bug #1964.
(search): Dito.
(searchURL): Dito.
(search): Ditto.
(searchURL): Ditto.
(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.
(NEXTKEY): Ditto.
(markModified): Made as an alias for attrModified().
* Conn.pm (nextEntry): Added code to handle internal counters for
@ -162,7 +341,7 @@
* 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.
(NEXTKEY): Ditto.
1998-12-15 Leif Hedstrom <leif@netscape.com>
@ -170,7 +349,7 @@
(EXISTS): New method, to implement the EXISTS functionality.
* API.xs (RET_CPP): Test for NULL pointers, bug #1387.
(RET_BVPP): Dito.
(RET_BVPP): Ditto.
* Utils.pm (ldapArgs): Fixed bug where "-s 0" would not be honored
(I'm an idiot, OK?).
@ -205,7 +384,7 @@
* INSTALL: Updated to reflect new v1.1 stuff. Added links to the
FAQ.
* README: Dito. Also changed some of the binary install
* README: Ditto. 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
@ -248,17 +427,17 @@
* 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.
(DELETE): Ditto.
(attrModified): Ditto.
(isModified): Ditto.
(remove): Ditto.
(removeValue): Ditto.
(addValue): Ditto.
(hasValue): Ditto.
(matchValue): Ditto.
(setDN): Ditto.
(size): Ditto.
(exists): Ditto.
* Conn.pm (printError): Changed test for $str to see if it's defined.
(delete): Cleaned up code around $dn.
@ -300,7 +479,7 @@
* Entry.pm (STORE): Fixed a bug with attribute names not being
properly added to _oc_order_.
(addValue): Dito, added the same code as for STORE.
(addValue): Ditto, added the same code as for STORE.
1998-08-06 Leif Hedstrom <leif@netscape.com>
@ -348,8 +527,8 @@
* Utils.pm (str2Scope): New function, for converting strings
(subtree) to a numerical scope value (2).
(askPassword): Dito, ask for a password, interactively.
(ldapArgs): Dito, handle common LDAP command line arguments.
(askPassword): Ditto, ask for a password, interactively.
(ldapArgs): Ditto, handle common LDAP command line arguments.
* Makefile.PL: Minor change, to do regex match on OS version for
MSWin.
@ -371,5 +550,5 @@
* Utils.pm (printEntry): Moved from the ::Connection class, and
marked it as "obsolete".
(encodeBase64): Moved from my LdapUtils.pm package.
(decodeBase64): Dito.
(decodeBase64): Ditto.

426
directory/perldap/Conn.pm
Просмотреть файл

@ -1,5 +1,5 @@
#############################################################################
# $Id: Conn.pm,v 1.22 1999-03-30 01:35:42 leif%netscape.com Exp $
# $Id: Conn.pm,v 1.23 1999-08-24 22:30: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
@ -29,9 +29,14 @@
package Mozilla::LDAP::Conn;
use Mozilla::LDAP::Utils;
use Mozilla::LDAP::API qw(/.+/);
use Mozilla::LDAP::Entry;
use Mozilla::LDAP::Utils 1.4 ();
use Mozilla::LDAP::API 1.4 qw(/.+/);
use Mozilla::LDAP::Entry 1.4 ();
use strict;
use vars qw($VERSION);
$VERSION = "1.4";
#############################################################################
@ -45,7 +50,7 @@ sub new
if (ref $_[$[] eq "HASH")
{
my $hash;
my ($hash);
$hash = $_[$[];
$self->{"host"} = $hash->{"host"} if defined($hash->{"host"});
@ -84,18 +89,11 @@ sub new
#
sub DESTROY
{
my $self = shift;
my ($self) = shift;
return unless defined($self->{"ld"});
ldap_unbind_s($self->{"ld"});
if (defined($self->{"ldres"}))
{
ldap_msgfree($self->{"ldres"});
undef $self->{"ldres"};
}
undef $self->{"ld"};
$self->close();
}
@ -105,7 +103,7 @@ sub DESTROY
#
sub init
{
my $self = shift;
my ($self) = shift;
my ($ret, $ld);
if (defined($self->{"certdb"}) && ($self->{"certdb"} ne ""))
@ -135,12 +133,11 @@ sub init
#
sub newEntry
{
my %entry = {};
my $obj;
my (%entry);
my ($obj);
tie %entry, Mozilla::LDAP::Entry;
$obj = bless \%entry, Mozilla::LDAP::Entry;
$obj->{"_self_obj_"} = $obj;
tie %entry, 'Mozilla::LDAP::Entry';
$obj = bless \%entry, 'Mozilla::LDAP::Entry';
return $obj;
}
@ -163,7 +160,7 @@ sub isURL
#
sub getLD
{
my $self = shift;
my ($self) = shift;
return $self->{"ld"} if defined($self->{"ld"});
}
@ -175,7 +172,7 @@ sub getLD
#
sub getRes
{
my $self = shift;
my ($self) = shift;
return $self->{"ldres"} if defined($self->{"ldres"});
}
@ -189,8 +186,9 @@ sub getRes
sub getErrorCode
{
my ($self, $match, $msg) = @_;
my $ret;
my ($ret);
return LDAP_SUCCESS unless defined($self->{"ld"});
return ldap_get_lderrno($self->{"ld"}, $match, $msg);
}
*getError = \*getErrorCode;
@ -201,9 +199,10 @@ sub getErrorCode
#
sub getErrorString
{
my $self = shift;
my $err;
my ($self) = shift;
my ($err);
return LDAP_SUCCESS unless defined($self->{"ld"});
$err = ldap_get_lderrno($self->{"ld"}, undef, undef);
return ldap_err2string($err);
@ -217,6 +216,8 @@ sub printError
{
my ($self, $str) = @_;
return unless defined($self->{"ld"});
$str = "LDAP error:" unless defined($str);
print "$str ", $self->getErrorString(), "\n";
}
@ -230,7 +231,7 @@ sub search
{
my ($self, $basedn, $scope, $filter, $attrsonly, @attrs) = @_;
my ($resv, $entry);
my $res = \$resv;
my ($res) = \$resv;
$scope = Mozilla::LDAP::Utils::str2Scope($scope);
$filter = "(objectclass=*)" if ($filter =~ /^ALL$/i);
@ -251,8 +252,10 @@ sub search
}
else
{
if (! ldap_search_s($self->{"ld"}, $basedn, $scope, $filter, \@attrs,
$attrsonly, $res))
if (! ldap_search_s($self->{"ld"}, $basedn, $scope, $filter,
defined(\@attrs) ? \@attrs : 0,
defined($attrsonly) ? $attrsonly : 0,
defined($res) ? $res : 0))
{
$self->{"ldres"} = $res;
$self->{"ldfe"} = 1;
@ -271,7 +274,7 @@ sub searchURL
{
my ($self, $url, $attrsonly) = @_;
my ($resv, $entry);
my $res = \$resv;
my ($res) = \$resv;
if (defined($self->{"ldres"}))
{
@ -279,7 +282,9 @@ sub searchURL
undef $self->{"ldres"};
}
if (! ldap_url_search_s($self->{"ld"}, $url, $attrsonly, $res))
if (! ldap_url_search_s($self->{"ld"}, $url,
defined($attrsonly) ? $attrsonly : 0,
defined($res) ? $res : 0))
{
$self->{"ldres"} = $res;
$self->{"ldfe"} = 1;
@ -290,19 +295,49 @@ sub searchURL
}
#############################################################################
# Browse an LDAP entry, very much like the regular search, except we set
# some defaults (like scope=BASE, filter=(objectclass=*) and so on). Note
# that this method does not support the attributesOnly flag.
#
sub browse
{
my ($self, $basedn, @attrs) = @_;
my ($scope, $filter);
$scope = Mozilla::LDAP::Utils::str2Scope("BASE");
$filter = "(objectclass=*)" ;
return $self->search($basedn, $scope, $filter, 0, @attrs);
}
#############################################################################
# Compare an attribute value against a DN in the server (without having to
# do a search first).
#
sub compare
{
my ($self, $dn, $attr, $value) = @_;
return ldap_compare_s($self->{"ld"}, $dn, $attr, $value) ==
LDAP_COMPARE_TRUE;
}
#############################################################################
# Get an entry from the search, either the first entry, or the next entry,
# depending on the call order.
#
sub nextEntry
{
my $self = shift;
my ($self) = shift;
my (%entry, @ocorder, @vals);
my ($attr, $lcattr, $obj, $ldentry, $berv, $dn, $count);
my $ber = \$berv;
my ($ber) = \$berv;
# I use the object directly, to avoid setting the "change" flags
$obj = tie %entry, Mozilla::LDAP::Entry;
$obj = tie %entry, 'Mozilla::LDAP::Entry';
$self->{"dn"} = "";
if ($self->{"ldfe"} == 1)
@ -338,7 +373,7 @@ sub nextEntry
$self->{"dn"} = $dn;
$attr = ldap_first_attribute($self->{"ld"}, $self->{"ldentry"}, $ber);
return (bless \%entry, Mozilla::LDAP::Entry) unless $attr;
return (bless \%entry, 'Mozilla::LDAP::Entry') unless $attr;
$lcattr = lc $attr;
@vals = ldap_get_values_len($self->{"ld"}, $self->{"ldentry"}, $attr);
@ -357,12 +392,11 @@ sub nextEntry
}
$obj->{"_oc_order_"} = \@ocorder;
$obj->{"_self_obj_"} = $obj;
$obj->{"_oc_numattr_"} = $count;
ldap_ber_free($ber, 0) if $ber;
return bless \%entry, Mozilla::LDAP::Entry;
return bless \%entry, 'Mozilla::LDAP::Entry';
}
# This is deprecated...
@ -374,10 +408,15 @@ sub nextEntry
#
sub close
{
my $self = shift;
my $ret = 1;
my ($self) = shift;
my ($ret) = 1;
$ret = ldap_unbind_s($self->{"ld"}) if defined($self->{"ld"});
ldap_unbind_s($self->{"ld"}) if defined($self->{"ld"});
if (defined($self->{"ldres"}))
{
ldap_msgfree($self->{"ldres"});
undef $self->{"ldres"};
}
undef $self->{"ld"};
return (($ret == LDAP_SUCCESS) ? 1 : 0);
@ -390,10 +429,10 @@ sub close
sub delete
{
my ($self, $id) = @_;
my $ret = 1;
my $dn = $id;
my ($ret) = 1;
my ($dn) = $id;
if (ref($id) eq "Mozilla::LDAP::Entry")
if (ref($id) eq 'Mozilla::LDAP::Entry')
{
$dn = $id->getDN();
}
@ -420,22 +459,22 @@ sub add
my ($ret, $gotcha) = (1, 0);
$ref = ref($entry);
if ($ref eq "Mozilla::LDAP::Entry")
if ($ref eq 'Mozilla::LDAP::Entry')
{
foreach $key (@{$entry->{"_oc_order_"}})
{
next if (($key eq "dn") || ($key =~ /^_.+_$/));
$ent{$key} = $entry->{$key};
$ent{$key} = { "ab" => $entry->{$key} };
$gotcha++;
$entry->attrClean($key);
}
}
elsif ($ref eq "HASH")
elsif ($ref eq 'HASH')
{
foreach $key (keys(%{$entry}))
{
next if (($key eq "dn") || ($key =~ /^_.+_$/));
$ent{$key} = $entry->{$key};
$ent{$key} = { "ab" => $entry->{$key} };
$gotcha++;
}
}
@ -465,7 +504,7 @@ sub modifyRDN
{
my ($self, $rdn, $dn, $del) = ($_[$[], $_[$[ + 1], $_[$[ + 2], $_[$[ + 3]);
my (@vals);
my $ret = 1;
my ($ret) = 1;
$del = 1 unless (defined($del) && ($del ne ""));
$dn = $self->{"dn"} unless (defined($dn) && ($dn ne ""));
@ -493,64 +532,65 @@ sub modifyRDN
sub update
{
my ($self, $entry) = @_;
my (@vals, @arr, %mod, %new);
my ($vals, @add, @remove, %mod, %new);
my ($key, $val);
my $ret = 1;
my ($ret) = 1;
local $_;
foreach $key (@{$entry->{"_oc_order_"}})
{
next if (($key eq "dn") || ($key =~ /^_.+_$/));
if (defined($entry->{"_${key}_modified_"}))
{
undef @vals;
@vals = @{$entry->{$key}} if (defined($entry->{$key}));
if ($#vals == $[)
{
$mod{$key} = { "rb", [$vals[$[]] };
}
else
{
@arr = ();
undef %new;
grep(($new{$_} = 1), @vals);
if (defined($entry->{"_${key}_save_"}))
{
foreach (@{$entry->{"_${key}_save_"}})
{
if (! $new{$_})
{
push(@arr, $_);
}
$new{$_} = 0;
}
}
$mod{$key}{"db"} = [@arr] if ($#arr >= $[);
$vals = defined($entry->{$key}) ?
$entry->{$key} :
[ ];
@arr = ();
foreach (@vals)
{
push(@arr, $_) if ($new{$_} == 1);
}
$mod{$key}{"ab"} = [@arr] if ($#arr >= $[);
}
if (defined($entry->{"_${key}_deleted_"}))
{
$mod{$key} = { "db", [] };
}
elsif (defined($entry->{"_${key}_modified_"}))
{
@remove = ();
undef %new;
grep(($new{$_} = 1), @{$vals});
if (defined($entry->{"_${key}_save_"}))
{
foreach (@{$entry->{"_${key}_save_"}})
{
if (! $new{$_})
{
push(@remove, $_);
}
$new{$_} = 0;
}
}
}
elsif (defined($entry->{"_${key}_deleted_"}))
{
$mod{$key} = { "db", [] };
}
@add = ();
foreach (@{$vals})
{
push(@add, $_) if ($new{$_} == 1);
}
if ((scalar(@remove) + scalar(@add)) < scalar(@{$vals}))
{
$mod{$key}{"db"} = [ @remove ] if ($#remove >= $[);
$mod{$key}{"ab"} = [ @add ] if ($#add >= $[);
}
else
{
$mod{$key}{"rb"} = [ @{$vals} ];
}
}
$entry->attrClean($key);
}
@arr = keys %mod;
# This is here for debug purposes only...
if ($main::LDAP_DEBUG)
{
my $op;
my ($op);
foreach $key (@arr)
foreach $key (keys(%mod))
{
print "Working on $key\n";
foreach $op (keys %{$mod{$key}})
@ -565,7 +605,7 @@ sub update
}
$ret = ldap_modify_s($self->{"ld"}, $entry->{"dn"}, \%mod)
if ($#arr >= $[);
if (scalar(keys(%mod)));
return (($ret == LDAP_SUCCESS) ? 1 : 0);
}
@ -593,7 +633,7 @@ sub setDefaultRebindProc
$auth = LDAP_AUTH_SIMPLE unless defined($auth);
die "No LDAP connection"
unless defined($self->{ld});
unless defined($self->{"ld"});
ldap_set_default_rebind_proc($self->{"ld"}, $dn, $pswd, $auth);
}
@ -605,7 +645,7 @@ sub setDefaultRebindProc
sub simpleAuth
{
my ($self, $dn, $pswd) = @_;
my $ret;
my ($ret);
$ret = ldap_simple_bind_s($self->{"ld"}, $dn, $pswd);
@ -702,7 +742,8 @@ There's also a term called RDN, which stands for Relative Distinguished
Name. In the above examples, C<uid=leif>, C<cn=gene-staff> and C<dc=data>
are all RDNs. One particular property for a RDN is that they must be
unique within it's sub-tree. Hence, there can only be one user with
C<uid=leif> within the ou=people tree, there can never be a name conflict.
C<uid=leif> within the C<ou=people> tree, there can never be a name
conflict.
=head1 CREATING A NEW OBJECT INSTANCE
@ -921,6 +962,71 @@ module is likely to change.
=over 13
=item B<add>
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<browse>
Searches for an LDAP entry, but sets some default values to begin with,
such as scope=BASE, filter=(objectclass=*) and so on. Much like B<search>
except for these defaults. Requires a DN value
as an argument. An optional second argument is an array of which
attributes to return from the entry. Note that this does not support the
"attributesOnly" flag.
$secondEntry = $conn->browse($entry->getDN());
=item B<close>
Close the LDAP connection, and clean up the object. If you don't call this
directly, the destructor for the object instance will do the job for you.
=item B<compare>
Compares an attribute and value to a given DN without first doing a
search. Requires three arguments: a DN, the attribute name, and the value
of the attribute. Returns TRUE if the attribute/value compared ok.
print "not" unless $conn->compare($entry->getDN(), "cn", "Big Swede");
print "ok";
=item B<delete>
This will delete the current entry, or possibly an entry as specified with
the optional argument. You can use this function to delete any entry you
like, by passing it an explicit DN. If you don't pass it this argument,
B<delete> defaults to delete the current entry, from the last call to
B<search> or B<entry>. I'd recommend doing a delete with the explicit DN,
like
$conn->delete($entry->getDN());
=item B<modifyRDN>
This will rename the specified LDAP entry, by modifying it's RDN. For
example, assuming you have a DN of
uid=leif, ou=people, dc=netscape, dc=com
and you wish to rename to
uid=fiel, ou=people, dc=netscape, dc=com
you'd do something like
$rdn = "uid=fiel";
$conn->modifyRDN($rdn, $entry->getDN());
Note that this can only be done on the RDN, you could not change say
C<ou=people> to be C<ou=hackers> in the example above. To do that, you have
to add a new entry (a copy of the old one), and then remove the old
entry.
The last argument is a boolean (0 or 1), which indicates if the old RDN
value should be removed from the entry. The default is TRUE ("1").
=item B<new>
This creates and initialized a new LDAP connection and object. The
@ -937,6 +1043,26 @@ A typical usage could be something like
Also, remember that if you use SSL, the port is (usually) 636.
=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();
or
$entry = Mozilla::LDAP::Conn->newEntry();
=item B<nextEntry>
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<search>
The B<search> method is the main entry point into this module. It requires
@ -966,56 +1092,6 @@ attribute names to be returned (and no values). This function isn't very
useful, since the B<search> method will actually honor properly formed
LDAP URL's, and use it if appropriate.
=item B<nextEntry>
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();
or
$entry = Mozilla::LDAP::Conn->newEntry();
=item B<update>
After modifying an Ldap::Entry entry (see below), use the B<update>
method to commit changes to the LDAP server. Only attributes that has been
changed will be updated, assuming you have used the appropriate methods in
the Entry object. For instance, do not use B<push> or B<splice> to
modify an entry, the B<update> will not recognize such changes.
To change the CN value for an entry, you could do
$entry->{cn} = ["Leif Hedstrom"];
$conn->update($entry);
=item B<delete>
This will delete the current entry, or possibly an entry as specified with
the optional argument. You can use this function to delete any entry you
like, by passing it an explicit DN. If you don't pass it this argument,
B<delete> defaults to delete the current entry, from the last call to
B<search> or B<entry>. I'd recommend doing a delete with the explicit DN,
like
$conn->delete($entry->getDN());
=item B<add>
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
@ -1036,19 +1112,18 @@ example:
$ret = $conn->simpleAuth(); # Bind as anon again.
=item B<update>
=item B<close>
After modifying an Ldap::Entry entry (see below), use the B<update>
method to commit changes to the LDAP server. Only attributes that has been
changed will be updated, assuming you have used the appropriate methods in
the Entry object. For instance, do not use B<push> or B<splice> to
modify an entry, the B<update> will not recognize such changes.
Close the LDAP connection, and clean up the object. If you don't call this
directly, the destructor for the object instance will do the job for you.
To change the CN value for an entry, you could do
=item B<modifyRDN>
This will rename the specified LDAP entry, by modifying it's RDN. For
example:
$rdn = "uid=fiel";
$conn->modifyRDN($rdn, $entry->getDN());
$entry->{cn} = ["Leif Hedstrom"];
$conn->update($entry);
=back
@ -1056,28 +1131,6 @@ example:
=over 13
=item B<isURL>
Returns TRUE or FALSE if the given argument is a properly formed URL.
=item B<getLD>
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
@ -1102,10 +1155,31 @@ returned by the LDAP server.
=item B<getErrorString>
Very much like B<getError>, but return a string with a human readable
Very much like B<getErrorCode>, but return a string with a human readable
error message. This can then be used to print a good error message on the
console.
=item B<getLD>
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<isURL>
Returns TRUE or FALSE if the given argument is a properly formed URL.
=item B<printError>
Print the last error message on standard output.

590
directory/perldap/Entry.pm
Просмотреть файл

@ -1,5 +1,5 @@
#############################################################################
# $Id: Entry.pm,v 1.11 1999-03-22 04:04:56 leif%netscape.com Exp $
# $Id: Entry.pm,v 1.12 1999-08-24 22:30:44 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,9 +28,14 @@
package Mozilla::LDAP::Entry;
use Mozilla::LDAP::Utils qw(normalizeDN);
require Tie::Hash;
@ISA = (Tie::StdHash);
use Mozilla::LDAP::Utils 1.4 qw(normalizeDN);
use Tie::Hash;
use strict;
use vars qw($VERSION @ISA);
@ISA = ('Tie::StdHash');
$VERSION = "1.4";
#############################################################################
@ -38,12 +43,11 @@ require Tie::Hash;
#
sub new
{
my $class = shift;
my ($class) = shift;
my (%entry, $obj);
tie %entry, $class;
$obj = bless \%entry, $class;
$obj->{"_self_obj_"} = $obj;
return $obj;
}
@ -69,7 +73,7 @@ sub TIEHASH
#
sub DESTROY
{
my $self = shift;
my ($self) = shift;
undef %{$self};
undef $self;
@ -77,7 +81,8 @@ sub DESTROY
#############################################################################
# Store method, to keep track of changes.
# Store method, to keep track of changes on an entire array of values (per
# attribute, of course).
#
sub STORE
{
@ -86,20 +91,26 @@ sub STORE
return unless (defined($val) && ($val ne ""));
return unless (defined($attr) && ($attr ne ""));
# We don't "track" internal values, or DNs...
if (($attr =~ /^_.+_$/) || ($attr eq "dn"))
{
$self->{$attr} = $val;
return;
}
if (defined($self->{$attr}))
{
@{$self->{"_${attr}_save_"}} = @{$self->{$attr}}
$self->{"_${attr}_save_"} = [ @{$self->{$attr}} ]
unless defined($self->{"_${attr}_save_"});
}
$self->{$attr} = $val;
return if ($attr =~ /^_.+_$/); # Don't track "internal" values
$self->{$attr} = $val;
$self->{"_${attr}_modified_"} = 1;
delete $self->{"_self_obj_"}->{"_${attr}_deleted_"}
delete $self->{"_${attr}_deleted_"}
if defined($self->{"_${attr}_deleted_"});
# Potentially add the attribute to the OC order list.
if (($attr ne "dn") && !grep(/^$attr$/i, @{$self->{"_oc_order_"}}))
if (! grep(/^$attr$/i, @{$self->{"_oc_order_"}}))
{
push(@{$self->{"_oc_order_"}}, $attr);
$self->{"_oc_numattr_"}++;
@ -138,13 +149,15 @@ sub DELETE
}
else
{
$self->{"_self_obj_"}->{"_${attr}_deleted_"} = 1;
$self->{"_${attr}_deleted_"} = 1;
}
}
#############################################################################
# See if an attribute/key exists in the entry (could still be undefined).
# The exists() (lowercase) is a kludge, kept for backward compatibility.
# Please use the EXISTS method (or just exists ... instead).
#
sub EXISTS
{
@ -157,6 +170,14 @@ sub EXISTS
}
sub exists
{
my ($self, $attr) = @_;
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.
@ -164,9 +185,11 @@ sub EXISTS
sub FIRSTKEY
{
my ($self, $idx) = ($_[$[], 0);
my @attrs = @{$self->{"_oc_order_"}};
my $key;
my (@attrs, $key);
return unless defined($self->{"_oc_order_"});
@attrs = @{$self->{"_oc_order_"}};
while ($idx < $self->{"_oc_numattr_"})
{
$key = $attrs[$idx++];
@ -185,11 +208,13 @@ sub FIRSTKEY
#
sub NEXTKEY
{
my $self = $_[$[];
my $idx = $self->{"_oc_keyidx_"};
my @attrs = @{$self->{"_oc_order_"}};
my $key;
my ($self) = $_[$[];
my ($idx) = $self->{"_oc_keyidx_"};
my (@attrs, $key);
return unless defined($self->{"_oc_order_"});
@attrs = @{$self->{"_oc_order_"}};
while ($idx < $self->{"_oc_numattr_"})
{
$key = $attrs[$idx++];
@ -199,6 +224,7 @@ sub NEXTKEY
}
$self->{"_oc_keyidx_"} = $idx;
return unless (defined($key) && ($key ne ""));
return if ($key =~ /^_.+_$/);
return if defined($self->{"_${key}_deleted_"});
return $key;
@ -216,11 +242,12 @@ sub attrModified
return 0 unless (defined($attr) && ($attr ne ""));
return 0 unless defined($self->{$attr});
return 0 if defined($self->{"_${attr}_deleted_"});
return 0 if ($attr eq "dn");
@{$self->{"_self_obj_"}->{"_${attr}_save_"}} = @{$self->{$attr}}
$self->{"_${attr}_save_"} = [ @{$self->{$attr}} ]
unless defined($self->{"_${attr}_save_"});
$self->{"_self_obj_"}->{"_${attr}_modified_"} = 1;
delete $self->{"_self_obj_"}->{"_${attr}_deleted_"}
$self->{"_${attr}_modified_"} = 1;
delete $self->{"_${attr}_deleted_"}
if defined($self->{"_${attr}_deleted_"});
@ -239,17 +266,18 @@ sub attrClean
my ($self, $attr) = ($_[$[], lc $_[$[ + 1]);
return 0 unless (defined($attr) && ($attr ne ""));
return 0 if ($attr eq "dn");
delete $self->{"_self_obj_"}->{"_${attr}_modified_"}
delete $self->{"_${attr}_modified_"}
if defined($self->{"_${attr}_modified_"});
delete $self->{"_self_obj_"}->{"_${attr}_deleted_"}
delete $self->{"_${attr}_deleted_"}
if defined($self->{"_${attr}_deleted_"});
if (defined($self->{"_${attr}_save_"}))
{
undef @{$self->{"_self_obj_"}->{"_${attr}_save_"}};
delete $self->{"_self_obj_"}->{"_${attr}_save_"};
undef @{$self->{"_${attr}_save_"}};
delete $self->{"_${attr}_save_"};
}
}
@ -314,13 +342,56 @@ sub remove
return 0 unless (defined($attr) && ($attr ne ""));
return 0 unless defined($self->{$attr});
$self->{"_self_obj_"}->{"_${attr}_deleted_"} = 1;
$self->{"_${attr}_deleted_"} = 1;
return 1;
}
*delete = \*remove;
#############################################################################
# Move (rename) an attribute, return TRUE or FALSE depending on the outcome.
# The first argument is the name of the old attribute (e.g. CN), and the last
# argument is the new name (e.g. SN). Note that the "new" attribute can not
# already exist, and the old attribute must exist.
#
# The "force" argument can be used to override the check if the new
# attribute already exists. This is potentially dangerous.
#
sub move
{
my ($self, $old, $new, $force) = ($_[$[], lc $_[$[ + 1], lc $_[$[ + 2],
$_[$[ + 3]);
return 0 if ($self->isAttr($new) && (!defined($force) || !$force));
return 0 unless $self->isAttr($old);
$self->setValues($new, @{$self->{$old}}) || return 0;
$self->remove($old);
return 1;
}
*rename = \*move;
#############################################################################
# Copy an attribute, return TRUE or FALSE depending on the outcome. This
# is almost identical to the move method, except we don't delete the source.
#
sub copy
{
my ($self, $old, $new, $force) = ($_[$[], lc $_[$[ + 1], lc $_[$[ + 2],
$_[$[ + 3]);
return 0 if ($self->isAttr($new) && (!defined($force) || !$force));
return 0 unless $self->isAttr($old);
$self->setValues($new, @{$self->{$old}}) || return 0;
return 1;
}
#############################################################################
# Undo a remove(), or set of removeValues() fairly useless, to restore an
# attribute to it's original state. This is fairly useless, but hey...
@ -331,16 +402,17 @@ sub unRemove
return 0 unless (defined($attr) && ($attr ne ""));
return 0 unless defined($self->{$attr});
return 0 if ($attr eq "dn");
# ToDo: We need to verify that this sucker works...
delete $self->{"_self_obj_"}->{"_${attr}_deleted_"};
delete $self->{"_${attr}_deleted_"};
if (defined($self->{"_${attr}_save_"}))
{
undef @{$self->{"_self_obj_"}->{$attr}};
delete $self->{"_self_obj_"}->{$attr};
@{$self->{"_self_obj_"}->{$attr}} = @{$self->{"_${attr}_save_"}};
undef @{$self->{"_self_obj_"}->{"_${attr}_save_"}};
delete $self->{"_self_obj_"}->{"_${attr}_save_"};
undef @{$self->{$attr}};
delete $self->{$attr};
$self->{$attr} = [ @{$self->{"_${attr}_save_"}} ];
undef @{$self->{"_${attr}_save_"}};
delete $self->{"_${attr}_save_"};
}
return 1;
@ -357,30 +429,32 @@ sub removeValue
{
my ($self, $attr, $val, $norm) = ($_[$[], lc $_[$[ + 1], $_[$[ + 2],
$_[$[ + 3]);
my $i = 0;
my ($i) = 0;
my ($attrval);
local $_;
return 0 unless (defined($val) && ($val ne ""));
return 0 unless (defined($attr) && ($attr ne ""));
return 0 unless defined($self->{$attr});
return 0 if ($attr eq "dn");
$val = normalizeDN($val) if (defined($norm) && $norm);
@{$self->{"_self_obj_"}->{"_${attr}_save_"}} = @{$self->{$attr}} unless
$self->{"_${attr}_save_"} = [ @{$self->{$attr}} ] unless
defined($self->{"_${attr}_save_"});
foreach (@{$self->{$attr}})
foreach $attrval (@{$self->{$attr}})
{
$_ = normalizeDN($_) if (defined($norm) && $norm);
$_ = ((defined($norm) && $norm) ? normalizeDN($attrval) : $attrval);
if ($_ eq $val)
{
splice(@{$self->{$attr}}, $i, 1);
if ($self->size($attr) > 0)
{
$self->{"_self_obj_"}->{"_${attr}_modified_"} = 1;
$self->{"_${attr}_modified_"} = 1;
}
else
{
$self->{"_self_obj_"}->{"_${attr}_deleted_"} = 1;
$self->{"_${attr}_deleted_"} = 1;
}
return 1;
@ -412,41 +486,43 @@ sub removeDNValue
#
sub addValue
{
my $self = shift;
my ($self) = shift;
my ($attr, $val, $force, $norm) = (lc $_[$[], $_[$[ + 1], $_[$[ + 2],
$_[$[ + 3]);
my ($attrval);
local $_;
return 0 unless (defined($val) && ($val ne ""));
return 0 unless (defined($attr) && ($attr ne ""));
return 0 if ($attr eq "dn");
if (defined($self->{$attr}) && (!defined($force) || !$force))
{
my $nval = $val;
my ($nval) = $val;
$nval = normalizeDN($val) if (defined($norm) && $norm);
foreach (@{$self->{$attr}})
foreach $attrval (@{$self->{$attr}})
{
$_ = normalizeDN($_) if (defined($norm) && $norm);
$_ = ((defined($norm) && $norm) ? normalizeDN($attrval) : $attrval);
return 0 if ($_ eq $nval);
}
}
if (defined($self->{$attr}))
{
@{$self->{"_self_obj_"}->{"_${attr}_save_"}} = @{$self->{$attr}}
$self->{"_${attr}_save_"} = [ @{$self->{$attr}} ]
unless defined($self->{"_${attr}_save_"});
}
else
{
@{$self->{"_self_obj_"}->{"_${attr}_save_"}} = ()
$self->{"_${attr}_save_"} = []
unless defined($self->{"_${attr}_save_"});
}
$self->{"_self_obj_"}->{"_${attr}_modified_"} = 1;
$self->{"_${attr}_modified_"} = 1;
if (defined($self->{"_${attr}_deleted_"}))
{
delete $self->{"_self_obj_"}->{"_${attr}_deleted_"};
delete $self->{"_${attr}_deleted_"};
$self->{$attr} = [$val];
}
else
@ -455,7 +531,7 @@ sub addValue
}
# Potentially add the attribute to the OC order list.
if (($attr ne "dn") && !grep(/^$attr$/i, @{$self->{"_oc_order_"}}))
if (! grep(/^$attr$/i, @{$self->{"_oc_order_"}}))
{
push(@{$self->{"_oc_order_"}}, $attr);
$self->{"_oc_numattr_"}++;
@ -472,9 +548,9 @@ sub addValue
#
sub addDNValue
{
my $self = shift;
my ($self) = shift;
my ($attr, $val, $force, $norm) = (lc $_[$[], $_[$[ + 1], $_[$[ + 2],
$_[$[ + 2]);
$_[$[ + 3]);
$val = normalizeDN($val) if (defined($norm) && $norm);
return $self->addValue($attr, $val, $force, 1);
@ -486,20 +562,59 @@ sub addDNValue
# The arguments are the name of the attribute, and then one or more values,
# passed as scalar or an array (not pointer).
#
sub setValue
sub setValues
{
my ($self, $attr) = (shift, lc shift);
my @vals = @_;
my (@vals) = @_;
local $_;
return 0 unless (defined(@vals) && ($#vals >= $[));
return 0 unless (defined($attr) && ($attr ne ""));
return 0 if ($attr eq "dn");
$self->{"_self_obj_"}->{$attr} = [ @vals ];
$self->{"_self_obj_"}->{"_${attr}_modified_"} = 1;
if (defined($self->{$attr}))
{
$self->{"_self_obj_"}->{"_${attr}_save_"} = [ @{$self->{$attr}} ]
unless defined($self->{"_${attr}_save_"});
}
else
{
$self->{"_self_obj_"}->{"_${attr}_save_"} = [ ]
unless defined($self->{"_${attr}_save_"});
}
$self->{$attr} = [ @vals ];
$self->{"_${attr}_modified_"} = 1;
delete $self->{"_${attr}_deleted_"}
if defined($self->{"_${attr}_deleted_"});
if (! grep(/^$attr$/i, @{$self->{"_oc_order_"}}))
{
push(@{$self->{"_oc_order_"}}, $attr);
$self->{"_oc_numattr_"}++;
}
return 1;
}
*setValue = \*setValues;
#############################################################################
# Get the entire array of attribute values. This returns the array, not
# the pointer to the array...
#
sub getValues
{
my ($self, $attr) = (shift, lc shift);
return unless (defined($attr) && ($attr ne ""));
return unless defined($self->{$attr});
return @{$self->{$attr}};
}
*getValue = \*getValues;
#############################################################################
@ -509,6 +624,8 @@ sub setValue
sub hasValue
{
my ($self, $attr, $val, $nocase, $norm) = @_;
my ($attrval);
local $_;
return 0 unless (defined($val) && ($val ne ""));
return 0 unless (defined($attr) && ($attr ne ""));
@ -517,17 +634,17 @@ sub hasValue
$val = normalizeDN($val) if (defined($norm) && $norm);
if ($nocase)
{
foreach (@{$self->{$attr}})
foreach $attrval (@{$self->{$attr}})
{
$_ = normalizeDN($_) if (defined($norm) && $norm);
$_ = ((defined($norm) && $norm) ? normalizeDN($attrval) : $attrval);
return 1 if /^\Q$val\E$/i;
}
}
else
{
foreach (@{$self->{$attr}})
foreach $attrval (@{$self->{$attr}})
{
$_ = normalizeDN($_) if (defined($norm) && $norm);
$_ = ((defined($norm) && $norm) ? normalizeDN($attrval) : $attrval);
return 1 if /^\Q$val\E$/;
}
}
@ -555,6 +672,7 @@ sub hasDNValue
sub matchValue
{
my ($self, $attr, $reg, $nocase, $norm) = @_;
my ($attrval);
return 0 unless (defined($reg) && ($reg ne ""));
return 0 unless (defined($attr) && ($attr ne ""));
@ -562,17 +680,17 @@ sub matchValue
if ($nocase)
{
foreach (@{$self->{$attr}})
foreach $attrval (@{$self->{$attr}})
{
$_ = normalizeDN($_);
$_ = ((defined($norm) && $norm) ? normalizeDN($attrval) : $attrval);
return 1 if /$reg/i;
}
}
else
{
foreach (@{$self->{$attr}})
foreach $attrval (@{$self->{$attr}})
{
$_ = normalizeDN($_) if (defined($norm) && $norm);
$_ = ((defined($norm) && $norm) ? normalizeDN($attrval) : $attrval);
return 1 if /$reg/;
}
}
@ -602,7 +720,7 @@ sub setDN
return 0 unless (defined($val) && ($val ne ""));
$val = normalizeDN($val) if (defined($norm) && $norm);
$self->{"_self_obj_"}->{"dn"} = $val;
$self->{"dn"} = $val;
return 1;
}
@ -627,51 +745,74 @@ sub getDN
sub size
{
my ($self, $attr) = ($_[$[], lc $_[$[ + 1]);
my (@val);
return 0 unless (defined($attr) && ($attr ne ""));
return 0 unless defined($self->{$attr});
# This is ugly, can't we optimize this?
@val = @{$self->{$attr}};
return $#val + 1;
return scalar(@{$self->{$attr}});
}
#############################################################################
#
# Return TRUE if the attribute name is in the LDAP entry.
# Return LDIF entries.
#
sub exists
sub getLDIFrecords # called from LDIF.pm (at least)
{
my ($self, $attr) = ($_[$[], lc $_[$[ + 1]);
my ($self) = @_;
my (@record) = (dn => $self->getDN());
my ($attr, $values);
return 0 unless (defined($attr) && ($attr ne ""));
return 0 unless defined($self->{$attr});
return 1;
}
#############################################################################
# Print an entry, in LDIF format. This is idential to the Utils::printEntry
# function, but this is sort of neat... Note that the support for Base64
# encoding isn't finished.
#
sub printLDIF
{
my ($self, $base64) = @_;
my $attr;
print "dn: ", $self->getDN(),"\n";
foreach $attr (@{$self->{"_oc_order_"}})
while (($attr, $values) = each %$self)
{
next if ($attr =~ /^_.+_$/);
next if defined($self->{"_${attr}_deleted_"});
grep((print "$attr: $_\n"), @{$self->{$attr}});
next if "dn" eq lc $attr; # this shouldn't happen; should it?
push @record, ($attr => $values);
# This is dangerous: @record and %$self now both contain
# references to @$values. To avoid this, copy it:
# push @record, ($attr => [@$values]);
# But that's not necessary, because the array and its
# contents are not modified as a side-effect of getting
# other attributes, from this or other objects.
}
print "\n";
return \@record;
}
#############################################################################
# Print an entry, in LDIF format.
#
use vars qw($_no_LDIF_module $_tested_LDIF_module);
undef $_no_LDIF_module;
undef $_tested_LDIF_module;
sub printLDIF
{
my ($self) = @_;
if (not defined($_tested_LDIF_module))
{
eval {require Mozilla::LDAP::LDIF; Mozilla::LDAP::LDIF->VERSION(0.07)};
$_no_LDIF_module = $@;
$_tested_LDIF_module = 1;
}
if ($_no_LDIF_module)
{
my ($record) = $self->getLDIFrecords();
my ($attr, $values);
while (($attr, $values) = splice @$record, 0, 2)
{
grep((print "$attr: $_\n"), @$values);
}
print "\n";
}
else
{
Mozilla::LDAP::LDIF::put_LDIF(select(), 78, $self);
}
}
@ -777,6 +918,32 @@ modifications and updates to your LDAP entries.
=over 13
=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<addValue>
Add a value to an attribute. If the attribute value already exists, or we
couldn't add the value for any other reason, we'll return FALSE (0),
otherwise we return TRUE (1). The first two arguments are the attribute
name, and the value to add.
The optional third argument is a flag, indicating that we want to add the
attribute without checking for duplicates. This is useful if you know the
values are unique already, or if you perhaps want to allow duplicates for
a particular attribute. To add a CN to an existing entry/attribute, do:
$entry->addValue("cn", "Leif Hedstrom");
=item B<attrModified>
This is an internal function, that can be used to force the API to
@ -787,22 +954,59 @@ fix the API. Example
$entry->attrModified("cn");
=item B<isModified>
=item B<copy>
This is a somewhat more useful method, which will return the internal
modification status of a particular attribute. The argument is the name of
the attribute, and the return value is True or False. If the attribute has
been modified, in any way, we return True (1), otherwise we return False
(0). For example:
Copy the value of one attribute to another. Requires at least two
arguments. The first argument is the name of the attribute to copy, and
the second argument is the name of the new attribute to copy to. The new
attribute can not currently exist in the entry, else the copy will fail.
There is an optional third argument (a boolean flag), which, when set to
1, will force an
override and copy to the new attribute even if it already exists. Returns TRUE if the copy
was successful.
if ($entry->isModified("cn")) { # do something }
$entry->copy("cn", "description");
=item B<isDeleted>
=item B<exists>
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
Return TRUE if the specified attribute is defined in the LDAP entry. This
is useful to know if an entry has a particular attribute, regardless of
the value. For instance:
if (! $entry->isDeleted("cn")) { # do something }
if ($entry->exists("jpegphoto")) { # do something special }
=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<getValues>
Returns an entire array of values for the attribute specified. Note that
this returns an array, and not a pointer to an array.
@someArray = $entry->getValues("description");
=item B<hasValue>
Return TRUE or FALSE if the attribute has the specified value. A typical
usage is to see if an entry is of a certain object class, e.g.
if ($entry->hasValue("objectclass", "person", 1)) { # do something }
The (optional) third argument indicates if the string comparison should be
case insensitive or not, and the (optional) fourth argument indicats
wheter we should normalize the string as if it was a DN. The first two
arguments are the name and value of the attribute, respectively.
=item B<hasDNValue>
Exactly like B<hasValue>, except we assume the attribute values are DN
attributes.
=item B<isAttr>
@ -819,6 +1023,64 @@ The code section will only be executed if these criterias are true:
underscore character (_).
2. The attribute has one or more values in the entry.
=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<isModified>
This is a somewhat more useful method, which will return the internal
modification status of a particular attribute. The argument is the name of
the attribute, and the return value is True or False. If the attribute has
been modified, in any way, we return True (1), otherwise we return False
(0). For example:
if ($entry->isModified("cn")) { # do something }
=item B<matchValue>
This is very similar to B<hasValue>, except it does a regular expression
match instead of a full string match. It takes the same arguments,
including the optional third argument to specify case insensitive
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<move>
Identical to the copy method, except the original attribute is
deleted once the move to the new attribute is complete.
$entry->move("cn", "sn");
=item B<printLDIF>
Print the entry in a format called LDIF (LDAP Data Interchange
Format, RFC xxxx). An example of an LDIF entry is:
dn: uid=leif,ou=people,dc=netscape,dc=com
objectclass: top
objectclass: person
objectclass: inetOrgPerson
uid: leif
cn: Leif Hedstrom
mail: leif@netscape.com
The above would be the result of
$entry->printLDIF();
If you need to write to a file, open and then select() it.
For more useful LDIF functionality, check out the
Mozilla::LDAP::LDIF.pm module.
=item B<remove>
This will remove the entire attribute, including all it's values, from the
@ -852,82 +1114,11 @@ in all LDAP entries. For example
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
couldn't add the value for any other reason, we'll return FALSE (0),
otherwise we return TRUE (1). The first two arguments are the attribute
name, and the value to add.
The optional third argument is a flag, indicating that we want to add the
attribute without checking for duplicates. This is useful if you know the
values are unique already, or if you perhaps want to allow duplicates for
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
usage is to see if an entry is of a certain object class, e.g.
if ($entry->hasValue("objectclass", "person", 1)) { # do something }
The (optional) third argument indicates if the string comparison should be
case insensitive or not, and the (optional) fourth argument indicats
wheter we should normalize the string as if it was a DN. The first two
arguments are the name and value of the attribute, respectively.
=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
match instead of a full string match. It takes the same arguments,
including the optional third argument to specify case insensitive
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>
Set the DN to the specified value. Only do this on new entries, it will
not work well if you try to do this on an existing entry. If you wish to
renamed an entry, use the Mozilla::Conn::modifyRDN method instead.
rename an entry, use the Mozilla::Conn::modifyRDN method instead.
Eventually we'll provide a complete "rename" method. To set the DN for a
newly created entry, we can do
@ -937,14 +1128,20 @@ 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>
=item B<setValues>
Return the DN for the entry. For instance
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<setValues()>. If you know
exactly what the new values should be like, you can use this method like
print "The DN is: ", $entry->getDN(), "\n";
$entry->setValues("cn", "Leif Hedstrom", "The Swede");
$entry->setValues("mail", @mailAddresses);
Just like B<setDN>, this method also has an optional argument, which
indicates we should normalize the DN before returning it to the caller.
or if it's a single value attribute,
$entry->setValues("uidNumber", "12345");
=item B<size>
@ -956,35 +1153,6 @@ Return the number of values for a particular attribute. For instance
This will set C<$numVals> to two (2). The only argument is the name of the
attribute, and the return value is the size of the value array.
=item B<exists>
Return TRUE if the specified attribute is defined in the LDAP entry. This
is useful to know if an entry has a particular attribute, regardless of
the value. For instance:
if ($entry->exists("jpegphoto")) { # do something special }
=item B<printLDIF>
Print the entry (on STDOUT) in a format called LDIF (LDAP Data Interchange
Format, RFC xxxx). An example of an LDIF entry is:
dn: uid=leif,ou=people,dc=netscape,dc=com
objectclass: top
objectclass: person
objectclass: inetOrgPerson
uid: leif
cn: Leif Hedstrom
mail: leif@netscape.com
The above would be the result of
$entry->printLDIF();
If you need to write to a file, close STDOUT, and open up a file with that
file handle instead. For more useful LDIF functionality, check out the
Mozilla::LDAP::LDIF.pm module.
=back
=head2 Deleting entries

1294
directory/perldap/LDIF.pm
Просмотреть файл

Разница между файлами не показана из-за своего большого размера Загрузить разницу

11
directory/perldap/MANIFEST
Просмотреть файл

@ -4,7 +4,7 @@ API.xs
MANIFEST
Makefile.PL
constant.h
test.pl
oldtest.pl
typemap
Entry.pm
Conn.pm
@ -12,6 +12,8 @@ LDIF.pm
Utils.pm
README
INSTALL
CREDITS
RELEASE
MPL-1.0.txt
test_api/search.pl
test_api/write.pl
@ -19,6 +21,11 @@ test_api/api.pl
t/conn.pl
t/entry.pl
t/ChangeLog
t/api.t
t/conn.t
t/entry.t
t/ldif.t
t/utils.t
examples/ChangeLog
examples/lfinger.pl
examples/qsearch.pl
@ -30,4 +37,4 @@ examples/modattr.pl
examples/rename.pl
examples/psoftsync.pl
examples/changes2ldif.pl
install-bin
examples/rand_mods.pl

67
directory/perldap/Makefile.PL
Просмотреть файл

@ -1,5 +1,5 @@
#############################################################################
# $Id: Makefile.PL,v 1.14 1999-01-21 23:52:42 leif%netscape.com Exp $
# $Id: Makefile.PL,v 1.15 1999-08-24 22:30: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
@ -133,19 +133,23 @@ if (!$silent)
}
# Include directories etc.
$my_includes = "";
$my_includes .= " -I$include_ldap" unless ($include_ldap eq "/usr/include");
# Add system dependant stuff here...
@extras = ();
if ($osname =~ /mswin/i)
{
$myextlib = "$lib_ldap\\$ldaplib[0]";
if ($lber_lib)
{
$myextlib .= " $lib_ldap\\$lberlib[0]";
}
$my_extlib = "$lib_ldap\\$ldaplib[0]";
$my_extlib .= " $lib_ldap\\$lberlib[0]" if $lber_lib;
push(@extras, 'dynamic_lib' => {
'OTHERLDFLAGS' => "kernel32.lib oldnames.lib" });
} else {
$myextlib = "";
$my_extlib = "";
}
@extras = ();
push(@extras,
CAPI => 'TRUE')
if ($] >= 5.005 and $^O eq 'MSWin32'
@ -154,20 +158,37 @@ push(@extras,
push(@extras,
ABSTRACT => 'Perl methods for LDAP C API calls',
AUTHOR => 'Netscape Communications Corp., Inc. and Clayton Donley')
if ($ExtUtils::MakeMaker::Version >= 5.4301);
if ($] >= 5.005);
#
# Ok, let's do it!
#
WriteMakefile(
'NAME' => 'Mozilla::LDAP::API',
'DISTNAME' => 'PerLDAP',
'VERSION_FROM' => 'API.pm',
($include_ldap ne "/usr/include" ? (
'INC' => "-I$include_ldap",
) : (
'INC' => "",
)),
'LIBS' => [$lib_line],
'MYEXTLIB' => $myextlib,
'DEFINE' => "$v3_def $ssl_def",
'XSOPT' => "-nolinenumbers",
@extras
'NAME' => 'Mozilla::LDAP::API',
'DISTNAME' => 'PerLDAP',
'VERSION_FROM' => 'API.pm',
'INC' => $my_includes,
'LIBS' => [$lib_line],
'MYEXTLIB' => $my_extlib,
'DEFINE' => "$v3_def $ssl_def",
'XSOPT' => "-nolinenumbers",
@extras
);
#
# Generate a "make HTML" target
#
sub MY::postamble
{
'
.SUFFIXES: .pm .html
.PHONY: html
.pm.html:
pod2html --netscape $< > $@
html: Entry.html Conn.html Utils.html API.html LDIF.html $(FIRST_MAKEFILE)
@rm -f pod2html-itemcache pod2html-dircache
'
}

66
directory/perldap/README
Просмотреть файл

@ -1,6 +1,6 @@
#############################################################################
# #
# PerLDAP v1.0 - A Perl Developers' Kit for LDAP #
# PerLDAP v1.4 - A Perl Developers' Kit for LDAP #
# #
#############################################################################
@ -23,57 +23,6 @@ involvement, PerLDAP will continue to evolve to include additional
functionality in future releases.
Installing PerLDAP Binaries
===========================
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, 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, 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.1
6. Execute the following command in as the super-user (root):
perl install-bin
On Windows NT:
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.1
5. Execute the following command:
perl install-bin
Compiling the PerLDAP Sources
=============================
@ -81,8 +30,8 @@ The source to PerLDAP is available on the Mozilla site at:
http://www.mozilla.org/directory/
You can either retrieve the .tar file with the source distribution, or use
CVS to checkout the module directly. The name of the CVS module is
You can either retrieve the .tar/zip file with the source distribution, or
use CVS to checkout the module directly. The name of the CVS module is
PerLDAP, and it checks out the directory
mozilla/directory/perldap
@ -91,13 +40,15 @@ Further instructions for using CVS and Mozilla is available at
http://www.mozilla.org/cvs.html
and an FAQ is at
and an FAQ for PerLDAP 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.
in the source distribution. The latest stable release of PerLDAP is
v1.4, the next version is planned to be v2.0 (development continues on the
v1.9 development branch).
Getting Started
@ -176,8 +127,5 @@ Known Bugs
There are a number of issues still outstanding at the time of release. Most
of these are already in the process of being resolved.
- There is a possible memory leak in the search routines. The OO layer
is also more memory than it should.
- The Rebind operation on NT does NOT work properly when set to a Perl
function. This is being investigated.
- Some of the documentation is incomplete.

79
directory/perldap/RELEASE Normal file
Просмотреть файл

@ -0,0 +1,79 @@
#############################################################################
# #
# PerLDAP Release Notes #
# #
#############################################################################
VERSION 1.4 - AUGUST 18, 1999
=============================
This is primarily a bug fix release, however there are 5 new methods
introduced as well. Brief descriptions follow in this document. To get
full examples and a larger summary, see the PerLDAP Programmer's Guide.
New Methods Added
-----------------
Entry.pm:
* getValues() - returns the array of values.
* move() - move one attribute to another, and delete the original.
* copy() - copy one attribute to another.
Conn.pm:
* browse() - makes it easy to browse an entry.
* compare() - compare an attribute value against a DN/entry
without having to do the search.
Bug Fixes and other changes
---------------------------
Entry.pm:
* addDNValue() - fixed wrong index for norm.
* matchValue() - fixed missing normalization in half of case statement.
* setValue() - remove _delete_ flag if set, fix for saving state.
* STORE - fixed not ignoring the internal instance variables properly.
* Fixed numerous bugs for large attribute sets.
* Fixed bug 4368 ("exists vs. EXISTS").
* Fixed several loop bugs.
* Removed all _self_obj_ references, it's obsolete in this
version.
* We support each() and keys() now on the Entry object, to loop
through all attribute names (types).
Conn.pm:
* close() - fixed memory leak.
* modifyRDN() - fixed problem where we weren't updating the
appropriate DN in the self object.
* Fixed bug 3342 (problems adding entries with binary data).
* getErrorCode()/getErrorString() - return LDAP_SUCCESS if no
LDAP connection handle.
* add() - fixed code to handle hash array as docs indicate.
* update() - optimization for "replace" vs "add/delete", we try to
use whatever LDAPMod is most efficient.
LDIF.pm:
* Complete rewrite, by John Kristian <kristian@netscape.com>.
API.xs:
* Fixed memory allocation problems, replacing all memory management
routines. This solves all known issues with ActiveState Perl.
* More safety checks around calls to *_free().
Miscellaneous
-------------
* Various other optimizations on tests and such.
* Fixed most (all?) known memory leaks.
* Fixed a lot of problems with Makefile.PL, adding some new targets
(like "make html"). Add a skeleton to "make test".
* Fixed numerous small bugs, as reported to Mozilla.
* We produce less warnings now, and try to "use strict" when
appropriate.
* We have a new versioning scheme, conforming to standard
Perl. We'll change this again when Perl's new versioning system
is in place (allowing versions like 1.2.3).

43
directory/perldap/Utils.pm
Просмотреть файл

@ -1,5 +1,5 @@
#############################################################################
# $Id: Utils.pm,v 1.12 1999-03-22 04:13:02 leif%netscape.com Exp $
# $Id: Utils.pm,v 1.13 1999-08-24 22:30:48 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,13 +26,16 @@
package Mozilla::LDAP::Utils;
use Mozilla::LDAP::API qw(:constant);
use Mozilla::LDAP::API 1.4 qw(:constant);
use Mozilla::LDAP::Conn;
use vars qw(@ISA %EXPORT_TAGS);
use Exporter;
require Exporter;
use strict;
use vars qw($VERSION @ISA %EXPORT_TAGS);
@ISA = qw(Exporter);
$VERSION = "1.4";
%EXPORT_TAGS = (
all => [qw(normalizeDN
isUrl
@ -87,7 +90,8 @@ sub isURL
sub printEntry
{
my $entry = $_[0];
my $attr;
my ($attr);
local $_;
print "dn: ", $entry->{"dn"},"\n";
@ -112,9 +116,9 @@ sub printEntry
#
sub encodeBase64
{
my $res = "";
my $eol = "$_[1]";
my $padding;
my ($res) = "";
my ($eol) = "$_[1]";
my ($padding);
pos($_[0]) = 0; # ensure start at the beginning
while ($_[0] =~ /(.{1,45})/gs) {
@ -140,9 +144,9 @@ sub encodeBase64
#
sub decodeBase64
{
my $str = shift;
my $res = "";
my $len;
my ($str) = shift;
my ($res) = "";
my ($len);
$str =~ tr|A-Za-z0-9+=/||cd;
Carp::croak("Base64 decoder requires string length to be a multiple of 4")
@ -165,7 +169,7 @@ sub decodeBase64
#
sub str2Scope
{
my $str = $_[0];
my ($str) = $_[0];
return $str if ($str =~ /^[0-9]+$/);
@ -192,8 +196,8 @@ sub str2Scope
#
sub askPassword
{
my $prompt = $_[0];
my $hasReadKey = 0;
my ($prompt) = $_[0];
my ($hasReadKey) = 0;
eval "use Term::ReadKey";
$hasReadKey=1 unless ($@);
@ -225,7 +229,7 @@ sub askPassword
sub ldapArgs
{
my ($bind, $base) = @_;
my %ld;
my (%ld);
$main::opt_v = $main::opt_n if defined($main::opt_n);
$main::opt_p = LDAPS_PORT if (!defined($main::opt_p) &&
@ -256,9 +260,9 @@ sub ldapArgs
#
sub unixCrypt
{
my $ascii =
my ($ascii) =
"./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
my $salt = substr($ascii, rand(62), 1) . substr($ascii, rand(62), 1);
my ($salt) = substr($ascii, rand(62), 1) . substr($ascii, rand(62), 1);
srand(time ^ $$);
crypt($_[0], $salt);
@ -272,11 +276,12 @@ sub unixCrypt
sub userCredentials
{
my ($ld) = @_;
my ($conn, $entry, $pswd);
my ($conn, $entry, $pswd, $search);
if ($ld->{"bind"} eq "")
{
my $base = $ld->{"base"} || $ld->{"root"};
my ($base) = $ld->{"base"} || $ld->{"root"};
$conn = new Mozilla::LDAP::Conn($ld);
die "Could't connect to LDAP server " . $ld->{"host"} unless $conn;

4
directory/perldap/examples/ChangeLog
Просмотреть файл

@ -1,3 +1,7 @@
1999-06-30 Leif Hedstrom <leif@netscape.com>
* rmentry.pl: Added support for "-p".
1999-01-05 Leif Hedstrom <leif@netscape.com>
* psoftsync.pl (delAttr): Fixed annoying bug where I missed to

135
directory/perldap/examples/rand_mods.pl Executable file
Просмотреть файл

@ -0,0 +1,135 @@
#!/usr/bin/perl5
#################################################################################
# $Id: rand_mods.pl,v 1.2 1999-08-24 22:30:51 leif%netscape.com Exp $
#
# The contents of this file are subject to the Netscape 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/NPL/
#
# 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 Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998 Netscape
# Communications Corporation. All Rights Reserved.
#
# SYNOPSIS:
# Modify an attribute for one or more entries, or possibly delete it.
#
# USAGE:
# rand_mods [-adnvW] -b base -h host -D bind DN -w pwd -P cert filter loops
# attribute ...
#
#################################################################################
#################################################################################
# Modules we need. Note that we depend heavily on the Ldapp module,
# which needs to be built from the C code. It also requires an LDAP SDK.
#
use Getopt::Std; # To parse command line arguments.
use Mozilla::LDAP::Conn; # Main "OO" layer for LDAP
use Mozilla::LDAP::Utils; # LULU, utilities.
use Carp;
use strict;
no strict "vars";
#################################################################################
# Constants, shouldn't have to edit these...
#
$APPNAM = "rand_mods";
$USAGE = "$APPNAM [-dnvW] -b base -h host -D bind -w pswd filter loops attr ...";
$AUTHOR = "Leif Hedstrom <leif\@netscape.com>";
#################################################################################
# Check arguments, and configure some parameters accordingly..
#
if (!getopts('adnvWb:h:D:p:s:w:P:'))
{
print "usage: $APPNAM $USAGE\n";
exit;
}
%ld = Mozilla::LDAP::Utils::ldapArgs();
#################################################################################
# Instantiate an LDAP object, which also binds to the LDAP server.
#
if (!getopts('b:h:D:p:s:w:P:'))
{
print "usage: $APPNAM $USAGE\n";
exit;
}
%ld = Mozilla::LDAP::Utils::ldapArgs();
$conn = new Mozilla::LDAP::Conn(\%ld);
croak "Could't connect to LDAP server $ld{host}" unless $conn;
#################################################################################
# Parse some extra argumens
#
my $srch, $loop;
my (@attrs) = ("givenName", "sn");
if (! ($srch = shift(@ARGV)))
{
print "Usage: $APPNAME $USAGE\n";
exit;
}
$srch = "(&(!(objectclass=nscpHideThis))(uid=*))" if ($srch eq "");
if (! ($loops = shift(@ARGV)))
{
print "Usage: $APPNAME $USAGE\n";
exit;
}
@attrs = @ARGV if ($#ARGV > $[);
$num_attrs = $#attrs;
#################################################################################
# Find all the argument
#
my $num = 0;
$entry = $conn->search($ld{root}, $ld{scope}, $srch, 0, ("0.0"));
while ($entry)
{
push(@users, $entry->getDN());
$num++;
$entry = $conn->nextEntry();
}
print "Found $num users, randomizing changes now...\n";
srand(time ^ $$);
my $tmp, $tmp2, $dn, $loop2;
while ($loops--)
{
$dn = $users[rand($num)];
print "$loops loops left...\n" if (($loops % 100) == 0);
$entry = $conn->browse($dn, @attrs);
if ($entry)
{
$loop2 = $num_attrs + 1;
while ($loop2--)
{
$tmp = $entry->{$attrs[$loop2]}[0];
$tmp2 = rand($num_attrs);
$entry->{$attrs[$loop2]} = [ $entry->{$attrs[$tmp2]}[0] ];
$entry->{$attrs[$tmp2]} = [ $tmp] ;
$entry->printLDIF();
}
$conn->update($entry);
}
}

7
directory/perldap/examples/rmentry.pl
Просмотреть файл

@ -1,6 +1,6 @@
#!/usr/bin/perl5
#############################################################################
# $Id: rmentry.pl,v 1.4 1999-01-21 23:52:47 leif%netscape.com Exp $
# $Id: rmentry.pl,v 1.5 1999-08-24 22:30:51 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
@ -36,7 +36,8 @@ use Mozilla::LDAP::Utils; # LULU, utilities.
# Constants, shouldn't have to edit these...
#
$APPNAM = "rmentry";
$USAGE = "$APPNAM [-nvI] -b base -h host -D bind -w pswd -P cert filter ...";
$USAGE = "$APPNAM [-nvI] -b base -h host -p port -D bind -w pswd" .
"-P cert filter ...";
@ATTRIBUTES = ("uid");
@ -44,7 +45,7 @@ $USAGE = "$APPNAM [-nvI] -b base -h host -D bind -w pswd -P cert filter ...";
#################################################################################
# Check arguments, and configure some parameters accordingly..
#
if (!getopts('nvIb:h:D:w:P:'))
if (!getopts('nvIb:h:p:D:w:P:'))
{
print "usage: $APPNAM $USAGE\n";
exit;

162
directory/perldap/oldtest.pl Normal file
Просмотреть файл

@ -0,0 +1,162 @@
#############################################################################
# $Id: oldtest.pl,v 1.2 1999-08-24 22:30:48 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
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
#
#############################################################################
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN { $| = 1; print "1..8\n"; }
END {print "modinit - not ok\n" unless $loaded;}
use Mozilla::LDAP::API qw(:constant :api :ssl);
$loaded = 1;
print "modinit - ok\n";
######################### End of black magic.
$attrs = [];
$ldap_host = $ENV{"LDAPHOST"};
$filter = $ENV{"TESTFILTER"};
$BASEDN = $ENV{"LDAPBASE"};
if (!$ldap_host)
{
print "\nEnter LDAP Server: ";
chomp($ldap_host = <>);
}
if (!$filter)
{
print "Enter Search Filter (ex. uid=abc123): ";
chomp($filter = <>);
}
if (!$BASEDN)
{
print "Enter LDAP Search Base (ex. o=Org, c=US): ";
chomp($BASEDN = <>);
}
print "\n";
##
## Initialize LDAP Connection
##
if (($ld = ldap_init($ldap_host,LDAP_PORT)) == -1)
{
print "open - not ok\n";
exit -1;
}
print "open - ok\n";
##
## Bind as DN, PASSWORD (NULL,NULL) on LDAP connection $ld
##
if (ldap_simple_bind_s($ld,"","") != LDAP_SUCCESS)
{
ldap_perror($ld,"bind_s");
print "bind - not ok\n";
exit -1;
}
print "bind - ok\n";
##
## ldap_search_s - Synchronous Search
##
if (ldap_search_s($ld,$BASEDN,LDAP_SCOPE_SUBTREE,$filter,$attrs,0,$result) != LDAP_SUCCESS)
{
ldap_perror($ld,"search_s");
print "search - not ok\n";
}
print "search - ok\n";
##
## ldap_count_entries - Count Matched Entries
##
if (($count = ldap_count_entries($ld,$result)) == -1)
{
ldap_perror($ld,"count_entry");
print "count - not ok\n";
}
print "count - ok - $count\n";
##
## first_entry - Get First Matched Entry
## next_entry - Get Next Matched Entry
##
for ($ent = ldap_first_entry($ld,$result); $ent; $ent = ldap_next_entry($ld,$ent))
{
##
## ldap_get_dn - Get DN for Matched Entries
##
if (($dn = ldap_get_dn($ld,$ent)) ne "")
{
print "getdn - ok - $dn\n";
} else {
ldap_perror($ld,"get_dn");
print "getdn - not ok\n";
}
for ($attr = ldap_first_attribute($ld,$ent,$ber); $attr; $attr = ldap_next_attribute($ld,$ent,$ber))
{
print "firstatt - ok - $attr\n";
##
## ldap_get_values
##
@vals = ldap_get_values($ld,$ent,$attr);
if ($#vals >= 0)
{
foreach $val (@vals)
{
print "getvals - ok - $val\n";
}
} else {
print "getvals - not ok\n";
}
}
}
##
## Unbind LDAP Connection
##
ldap_unbind($ld);

8
directory/perldap/t/ChangeLog
Просмотреть файл

@ -1,10 +1,14 @@
1999-08-06 Leif Hedstrom <leif@netscape.com>
* conn.pl: Added support for browse() and compare().
1999-03-19 Leif Hedstrom <leif@netscape.com>
* conn.pl (attributeEQ): Added test for add() with a hash array.
* conn.pl: Added test for add() with a hash array.
1999-01-05 Leif Hedstrom <leif@netscape.com>
* entry.pl: New script, to test all Entry:: methods.
* conn.pl (attributeEQ): Added test for modifyRDN().
* conn.pl: Added test for modifyRDN().

4
directory/perldap/t/api.t Normal file
Просмотреть файл

@ -0,0 +1,4 @@
print "This is not a real test, yet...\n";
print "1..1\n";
print "ok 1\n";

Двоичные данные
directory/perldap/t/conn.pl
Просмотреть файл

Двоичный файл не отображается.

4
directory/perldap/t/conn.t Normal file
Просмотреть файл

@ -0,0 +1,4 @@
print "This is not a real test, yet...\n";
print "1..1\n";
print "ok 1\n";

4
directory/perldap/t/entry.t Normal file
Просмотреть файл

@ -0,0 +1,4 @@
print "This is not a real test, yet...\n";
print "1..1\n";
print "ok 1\n";

4
directory/perldap/t/ldif.t Normal file
Просмотреть файл

@ -0,0 +1,4 @@
print "This is not a real test, yet...\n";
print "1..1\n";
print "ok 1\n";

4
directory/perldap/t/utils.t Normal file
Просмотреть файл

@ -0,0 +1,4 @@
print "This is not a real test, yet...\n";
print "1..1\n";
print "ok 1\n";