Home | History | Annotate | Line # | Download | only in ldaptcl
neoXldap.c revision 1.1
      1  1.1  lukem /*
      2  1.1  lukem  * NeoSoft Tcl client extensions to Lightweight Directory Access Protocol.
      3  1.1  lukem  *
      4  1.1  lukem  * Copyright (c) 1998-1999 NeoSoft, Inc.
      5  1.1  lukem  * All Rights Reserved.
      6  1.1  lukem  *
      7  1.1  lukem  * This software may be used, modified, copied, distributed, and sold,
      8  1.1  lukem  * in both source and binary form provided that these copyrights are
      9  1.1  lukem  * retained and their terms are followed.
     10  1.1  lukem  *
     11  1.1  lukem  * Under no circumstances are the authors or NeoSoft Inc. responsible
     12  1.1  lukem  * for the proper functioning of this software, nor do the authors
     13  1.1  lukem  * assume any liability for damages incurred with its use.
     14  1.1  lukem  *
     15  1.1  lukem  * Redistribution and use in source and binary forms are permitted
     16  1.1  lukem  * provided that this notice is preserved and that due credit is given
     17  1.1  lukem  * to NeoSoft, Inc.
     18  1.1  lukem  *
     19  1.1  lukem  * NeoSoft, Inc. may not be used to endorse or promote products derived
     20  1.1  lukem  * from this software without specific prior written permission. This
     21  1.1  lukem  * software is provided ``as is'' without express or implied warranty.
     22  1.1  lukem  *
     23  1.1  lukem  * Requests for permission may be sent to NeoSoft Inc, 1770 St. James Place,
     24  1.1  lukem  * Suite 500, Houston, TX, 77056.
     25  1.1  lukem  *
     26  1.1  lukem  * $OpenLDAP: pkg/ldap/contrib/ldaptcl/neoXldap.c,v 1.17.10.1 2007/08/31 23:13:51 quanah Exp $
     27  1.1  lukem  *
     28  1.1  lukem  */
     29  1.1  lukem 
     30  1.1  lukem /*
     31  1.1  lukem  * This code was originally developed by Karl Lehenbauer to work with
     32  1.1  lukem  * Umich-3.3 LDAP.  It was debugged against the Netscape LDAP server
     33  1.1  lukem  * and their much more reliable SDK, and again backported to the
     34  1.1  lukem  * Umich-3.3 client code.  The UMICH_LDAP define is used to include
     35  1.1  lukem  * code that will work with the Umich-3.3 LDAP, but not with Netscape's
     36  1.1  lukem  * SDK.  OpenLDAP may support some of these, but they have not been tested.
     37  1.1  lukem  * Currently supported by Randy Kunkee (kunkee (at) OpenLDAP.org).
     38  1.1  lukem  */
     39  1.1  lukem 
     40  1.1  lukem /*
     41  1.1  lukem  * Add timeout to controlArray to set timeout for ldap_result.
     42  1.1  lukem  * 4/14/99 - Randy
     43  1.1  lukem  */
     44  1.1  lukem 
     45  1.1  lukem #include "tclExtend.h"
     46  1.1  lukem 
     47  1.1  lukem #include <lber.h>
     48  1.1  lukem #include <ldap.h>
     49  1.1  lukem #include <string.h>
     50  1.1  lukem #include <sys/time.h>
     51  1.1  lukem #include <math.h>
     52  1.1  lukem 
     53  1.1  lukem /*
     54  1.1  lukem  * Macros to do string compares.  They pre-check the first character before
     55  1.1  lukem  * checking of the strings are equal.
     56  1.1  lukem  */
     57  1.1  lukem 
     58  1.1  lukem #define STREQU(str1, str2) \
     59  1.1  lukem 	(((str1) [0] == (str2) [0]) && (strcmp (str1, str2) == 0))
     60  1.1  lukem #define STRNEQU(str1, str2, n) \
     61  1.1  lukem 	(((str1) [0] == (str2) [0]) && (strncmp (str1, str2, n) == 0))
     62  1.1  lukem 
     63  1.1  lukem /*
     64  1.1  lukem  * The following section defines some common macros used by the rest
     65  1.1  lukem  * of the code.  It's ugly, and can use some work.  This code was
     66  1.1  lukem  * originally developed to work with Umich-3.3 LDAP.  It was debugged
     67  1.1  lukem  * against the Netscape LDAP server and the much more reliable SDK,
     68  1.1  lukem  * and then again backported to the Umich-3.3 client code.
     69  1.1  lukem  */
     70  1.1  lukem #define OPEN_LDAP 1
     71  1.1  lukem #if defined(OPEN_LDAP)
     72  1.1  lukem        /* LDAP_API_VERSION must be defined per the current draft spec
     73  1.1  lukem        ** it's value will be assigned RFC number.  However, as
     74  1.1  lukem        ** no RFC is defined, it's value is currently implementation
     75  1.1  lukem        ** specific (though I would hope it's value is greater than 1823).
     76  1.1  lukem        ** In OpenLDAP 2.x-devel, its 2000 + the draft number, ie 2002.
     77  1.1  lukem        ** This section is for OPENLDAP.
     78  1.1  lukem        */
     79  1.1  lukem #ifndef LDAP_API_FEATURE_X_OPENLDAP
     80  1.1  lukem #define ldap_memfree(p) free(p)
     81  1.1  lukem #endif
     82  1.1  lukem #ifdef LDAP_OPT_ERROR_NUMBER
     83  1.1  lukem #define ldap_get_lderrno(ld)	(ldap_get_option(ld, LDAP_OPT_ERROR_NUMBER, &lderrno), lderrno)
     84  1.1  lukem #else
     85  1.1  lukem #define ldap_get_lderrno(ld) (ld->ld_errno)
     86  1.1  lukem #endif
     87  1.1  lukem #define LDAP_ERR_STRING(ld)  \
     88  1.1  lukem 	ldap_err2string(ldap_get_lderrno(ld))
     89  1.1  lukem #elif defined( LDAP_OPT_SIZELIMIT )
     90  1.1  lukem        /*
     91  1.1  lukem        ** Netscape SDK w/ ldap_set_option, ldap_get_option
     92  1.1  lukem        */
     93  1.1  lukem #define LDAP_ERR_STRING(ld)  \
     94  1.1  lukem 	ldap_err2string(ldap_get_lderrno(ldap))
     95  1.1  lukem #else
     96  1.1  lukem        /* U-Mich/OpenLDAP 1.x API */
     97  1.1  lukem        /* RFC-1823 w/ changes */
     98  1.1  lukem #define UMICH_LDAP 1
     99  1.1  lukem #define ldap_memfree(p) free(p)
    100  1.1  lukem #define ldap_ber_free(p, n) ber_free(p, n)
    101  1.1  lukem #define ldap_value_free_len(bvals) ber_bvecfree(bvals)
    102  1.1  lukem #define ldap_get_lderrno(ld) (ld->ld_errno)
    103  1.1  lukem #define LDAP_ERR_STRING(ld)  \
    104  1.1  lukem 	ldap_err2string(ld->ld_errno)
    105  1.1  lukem #endif
    106  1.1  lukem 
    107  1.1  lukem typedef struct ldaptclobj {
    108  1.1  lukem     LDAP	*ldap;
    109  1.1  lukem     int		caching;	/* flag 1/0 if caching is enabled */
    110  1.1  lukem     long	timeout;	/* timeout from last cache enable */
    111  1.1  lukem     long	maxmem;		/* maxmem from last cache enable */
    112  1.1  lukem     Tcl_Obj	*trapCmdObj;	/* error handler */
    113  1.1  lukem     int		*traplist;	/* list of errorCodes to trap */
    114  1.1  lukem     int		flags;
    115  1.1  lukem } LDAPTCL;
    116  1.1  lukem 
    117  1.1  lukem 
    118  1.1  lukem #define LDAPTCL_INTERRCODES	0x001
    119  1.1  lukem 
    120  1.1  lukem #include "ldaptclerr.h"
    121  1.1  lukem 
    122  1.1  lukem static
    123  1.1  lukem LDAP_SetErrorCode(LDAPTCL *ldaptcl, int code, Tcl_Interp *interp)
    124  1.1  lukem {
    125  1.1  lukem     char shortbuf[16];
    126  1.1  lukem     char *errp;
    127  1.1  lukem     int   lderrno;
    128  1.1  lukem 
    129  1.1  lukem     if (code == -1)
    130  1.1  lukem 	code = ldap_get_lderrno(ldaptcl->ldap);
    131  1.1  lukem     if ((ldaptcl->flags & LDAPTCL_INTERRCODES) || code > LDAPTCL_MAXERR ||
    132  1.1  lukem       ldaptclerrorcode[code] == NULL) {
    133  1.1  lukem 	sprintf(shortbuf, "0x%03x", code);
    134  1.1  lukem 	errp = shortbuf;
    135  1.1  lukem     } else
    136  1.1  lukem 	errp = ldaptclerrorcode[code];
    137  1.1  lukem 
    138  1.1  lukem     Tcl_SetErrorCode(interp, errp, NULL);
    139  1.1  lukem     if (ldaptcl->trapCmdObj) {
    140  1.1  lukem 	int *i;
    141  1.1  lukem 	Tcl_Obj *cmdObj;
    142  1.1  lukem 	if (ldaptcl->traplist != NULL) {
    143  1.1  lukem 	    for (i = ldaptcl->traplist; *i && *i != code; i++)
    144  1.1  lukem 		;
    145  1.1  lukem 	    if (*i == 0) return;
    146  1.1  lukem 	}
    147  1.1  lukem 	(void) Tcl_EvalObj(interp, ldaptcl->trapCmdObj);
    148  1.1  lukem     }
    149  1.1  lukem }
    150  1.1  lukem 
    151  1.1  lukem static
    152  1.1  lukem LDAP_ErrorStringToCode(Tcl_Interp *interp, char *s)
    153  1.1  lukem {
    154  1.1  lukem     int offset;
    155  1.1  lukem     int code;
    156  1.1  lukem 
    157  1.1  lukem     offset = (strncasecmp(s, "LDAP_", 5) == 0) ? 0 : 5;
    158  1.1  lukem     for (code = 0; code < LDAPTCL_MAXERR; code++) {
    159  1.1  lukem 	if (!ldaptclerrorcode[code]) continue;
    160  1.1  lukem 	if (strcasecmp(s, ldaptclerrorcode[code]+offset) == 0)
    161  1.1  lukem 	    return code;
    162  1.1  lukem     }
    163  1.1  lukem     Tcl_ResetResult(interp);
    164  1.1  lukem     Tcl_AppendResult(interp, s, " is an invalid code", (char *) NULL);
    165  1.1  lukem     return -1;
    166  1.1  lukem }
    167  1.1  lukem 
    168  1.1  lukem /*-----------------------------------------------------------------------------
    169  1.1  lukem  * LDAP_ProcessOneSearchResult --
    170  1.1  lukem  *
    171  1.1  lukem  *   Process one result return from an LDAP search.
    172  1.1  lukem  *
    173  1.1  lukem  * Paramaters:
    174  1.1  lukem  *   o interp -            Tcl interpreter; Errors are returned in result.
    175  1.1  lukem  *   o ldap -              LDAP structure pointer.
    176  1.1  lukem  *   o entry -             LDAP message pointer.
    177  1.1  lukem  *   o destArrayNameObj -  Name of Tcl array in which to store attributes.
    178  1.1  lukem  *   o evalCodeObj -       Tcl_Obj pointer to code to eval against this result.
    179  1.1  lukem  * Returns:
    180  1.1  lukem  *   o TCL_OK if processing succeeded..
    181  1.1  lukem  *   o TCL_ERROR if an error occured, with error message in interp.
    182  1.1  lukem  *-----------------------------------------------------------------------------
    183  1.1  lukem  */
    184  1.1  lukem int
    185  1.1  lukem LDAP_ProcessOneSearchResult (interp, ldap, entry, destArrayNameObj, evalCodeObj)
    186  1.1  lukem     Tcl_Interp     *interp;
    187  1.1  lukem     LDAP           *ldap;
    188  1.1  lukem     LDAPMessage    *entry;
    189  1.1  lukem     Tcl_Obj        *destArrayNameObj;
    190  1.1  lukem     Tcl_Obj        *evalCodeObj;
    191  1.1  lukem {
    192  1.1  lukem     char           *attributeName;
    193  1.1  lukem     Tcl_Obj        *attributeNameObj;
    194  1.1  lukem     Tcl_Obj        *attributeDataObj;
    195  1.1  lukem     int             i;
    196  1.1  lukem     BerElement     *ber;
    197  1.1  lukem     struct berval **bvals;
    198  1.1  lukem     char	   *dn;
    199  1.1  lukem     int		    lderrno;
    200  1.1  lukem 
    201  1.1  lukem     Tcl_UnsetVar (interp, Tcl_GetStringFromObj (destArrayNameObj, NULL), 0);
    202  1.1  lukem 
    203  1.1  lukem     dn = ldap_get_dn(ldap, entry);
    204  1.1  lukem     if (dn != NULL) {
    205  1.1  lukem 	if (Tcl_SetVar2(interp,		/* set dn */
    206  1.1  lukem 		       Tcl_GetStringFromObj(destArrayNameObj, NULL),
    207  1.1  lukem 		       "dn",
    208  1.1  lukem 		       dn,
    209  1.1  lukem 		       TCL_LEAVE_ERR_MSG) == NULL)
    210  1.1  lukem 	    return TCL_ERROR;
    211  1.1  lukem 	ldap_memfree(dn);
    212  1.1  lukem     }
    213  1.1  lukem     attributeNameObj = Tcl_NewObj();
    214  1.1  lukem     Tcl_IncrRefCount (attributeNameObj);
    215  1.1  lukem 
    216  1.1  lukem     /* Note that attributeName below is allocated for OL2+ libldap, so it
    217  1.1  lukem        must be freed with ldap_memfree().  Test below is admittedly a hack.
    218  1.1  lukem     */
    219  1.1  lukem 
    220  1.1  lukem     for (attributeName = ldap_first_attribute (ldap, entry, &ber);
    221  1.1  lukem       attributeName != NULL;
    222  1.1  lukem       attributeName = ldap_next_attribute(ldap, entry, ber)) {
    223  1.1  lukem 
    224  1.1  lukem 	bvals = ldap_get_values_len(ldap, entry, attributeName);
    225  1.1  lukem 
    226  1.1  lukem 	if (bvals != NULL) {
    227  1.1  lukem 	    /* Note here that the U.of.M. ldap will return a null bvals
    228  1.1  lukem 	       when the last attribute value has been deleted, but still
    229  1.1  lukem 	       retains the attributeName.  Even though this is documented
    230  1.1  lukem 	       as an error, we ignore it to present a consistent interface
    231  1.1  lukem 	       with Netscape's server
    232  1.1  lukem 	    */
    233  1.1  lukem 	    attributeDataObj = Tcl_NewObj();
    234  1.1  lukem 	    Tcl_SetStringObj(attributeNameObj, attributeName, -1);
    235  1.1  lukem #if LDAP_API_VERSION >= 2004
    236  1.1  lukem 	    ldap_memfree(attributeName);	/* free if newer API */
    237  1.1  lukem #endif
    238  1.1  lukem 	    for (i = 0; bvals[i] != NULL; i++) {
    239  1.1  lukem 		Tcl_Obj *singleAttributeValueObj;
    240  1.1  lukem 
    241  1.1  lukem 		singleAttributeValueObj = Tcl_NewStringObj(bvals[i]->bv_val, bvals[i]->bv_len);
    242  1.1  lukem 		if (Tcl_ListObjAppendElement (interp,
    243  1.1  lukem 					      attributeDataObj,
    244  1.1  lukem 					      singleAttributeValueObj)
    245  1.1  lukem 		  == TCL_ERROR) {
    246  1.1  lukem 		    ber_free(ber, 0);
    247  1.1  lukem 		    return TCL_ERROR;
    248  1.1  lukem 		}
    249  1.1  lukem 	    }
    250  1.1  lukem 
    251  1.1  lukem 	    ldap_value_free_len(bvals);
    252  1.1  lukem 
    253  1.1  lukem 	    if (Tcl_ObjSetVar2 (interp,
    254  1.1  lukem 				destArrayNameObj,
    255  1.1  lukem 				attributeNameObj,
    256  1.1  lukem 				attributeDataObj,
    257  1.1  lukem 				TCL_LEAVE_ERR_MSG) == NULL) {
    258  1.1  lukem 		return TCL_ERROR;
    259  1.1  lukem 	    }
    260  1.1  lukem 	}
    261  1.1  lukem     }
    262  1.1  lukem     Tcl_DecrRefCount (attributeNameObj);
    263  1.1  lukem     return Tcl_EvalObj (interp, evalCodeObj);
    264  1.1  lukem }
    265  1.1  lukem 
    266  1.1  lukem /*-----------------------------------------------------------------------------
    267  1.1  lukem  * LDAP_PerformSearch --
    268  1.1  lukem  *
    269  1.1  lukem  *   Perform an LDAP search.
    270  1.1  lukem  *
    271  1.1  lukem  * Paramaters:
    272  1.1  lukem  *   o interp -            Tcl interpreter; Errors are returned in result.
    273  1.1  lukem  *   o ldap -              LDAP structure pointer.
    274  1.1  lukem  *   o base -              Base DN from which to perform search.
    275  1.1  lukem  *   o scope -             LDAP search scope, must be one of LDAP_SCOPE_BASE,
    276  1.1  lukem  *                         LDAP_SCOPE_ONELEVEL, or LDAP_SCOPE_SUBTREE.
    277  1.1  lukem  *   o attrs -             Pointer to array of char * pointers of desired
    278  1.1  lukem  *                         attribute names, or NULL for all attributes.
    279  1.1  lukem  *   o filtpatt            LDAP filter pattern.
    280  1.1  lukem  *   o value               Value to get sprintf'ed into filter pattern.
    281  1.1  lukem  *   o destArrayNameObj -  Name of Tcl array in which to store attributes.
    282  1.1  lukem  *   o evalCodeObj -       Tcl_Obj pointer to code to eval against this result.
    283  1.1  lukem  * Returns:
    284  1.1  lukem  *   o TCL_OK if processing succeeded..
    285  1.1  lukem  *   o TCL_ERROR if an error occured, with error message in interp.
    286  1.1  lukem  *-----------------------------------------------------------------------------
    287  1.1  lukem  */
    288  1.1  lukem int
    289  1.1  lukem LDAP_PerformSearch (interp, ldaptcl, base, scope, attrs, filtpatt, value,
    290  1.1  lukem 	destArrayNameObj, evalCodeObj, timeout_p, all, sortattr)
    291  1.1  lukem     Tcl_Interp     *interp;
    292  1.1  lukem     LDAPTCL        *ldaptcl;
    293  1.1  lukem     char           *base;
    294  1.1  lukem     int             scope;
    295  1.1  lukem     char          **attrs;
    296  1.1  lukem     char           *filtpatt;
    297  1.1  lukem     char           *value;
    298  1.1  lukem     Tcl_Obj        *destArrayNameObj;
    299  1.1  lukem     Tcl_Obj        *evalCodeObj;
    300  1.1  lukem     struct timeval *timeout_p;
    301  1.1  lukem     int		    all;
    302  1.1  lukem     char	   *sortattr;
    303  1.1  lukem {
    304  1.1  lukem     LDAP	 *ldap = ldaptcl->ldap;
    305  1.1  lukem     char          filter[BUFSIZ];
    306  1.1  lukem     int           resultCode;
    307  1.1  lukem     int           errorCode;
    308  1.1  lukem     int		  abandon;
    309  1.1  lukem     int		  tclResult = TCL_OK;
    310  1.1  lukem     int		  msgid;
    311  1.1  lukem     LDAPMessage  *resultMessage = 0;
    312  1.1  lukem     LDAPMessage  *entryMessage = 0;
    313  1.1  lukem     char	  *sortKey;
    314  1.1  lukem 
    315  1.1  lukem     int		  lderrno;
    316  1.1  lukem 
    317  1.1  lukem     sprintf(filter, filtpatt, value);
    318  1.1  lukem 
    319  1.1  lukem     fflush(stderr);
    320  1.1  lukem     if ((msgid = ldap_search (ldap, base, scope, filter, attrs, 0)) == -1) {
    321  1.1  lukem 	Tcl_AppendResult (interp,
    322  1.1  lukem 			        "LDAP start search error: ",
    323  1.1  lukem 					LDAP_ERR_STRING(ldap),
    324  1.1  lukem 			        (char *)NULL);
    325  1.1  lukem 	LDAP_SetErrorCode(ldaptcl, -1, interp);
    326  1.1  lukem 	return TCL_ERROR;
    327  1.1  lukem     }
    328  1.1  lukem 
    329  1.1  lukem     abandon = 0;
    330  1.1  lukem     if (sortattr)
    331  1.1  lukem 	all = 1;
    332  1.1  lukem     tclResult = TCL_OK;
    333  1.1  lukem     while (!abandon) {
    334  1.1  lukem 	resultCode = ldap_result (ldap, msgid, all, timeout_p, &resultMessage);
    335  1.1  lukem 	if (resultCode != LDAP_RES_SEARCH_RESULT &&
    336  1.1  lukem 	    resultCode != LDAP_RES_SEARCH_ENTRY)
    337  1.1  lukem 		break;
    338  1.1  lukem 
    339  1.1  lukem 	if (sortattr) {
    340  1.1  lukem 	    sortKey = (strcasecmp(sortattr, "dn") == 0) ? NULL : sortattr;
    341  1.1  lukem 	    ldap_sort_entries(ldap, &resultMessage, sortKey, strcasecmp);
    342  1.1  lukem 	}
    343  1.1  lukem 	entryMessage = ldap_first_entry(ldap, resultMessage);
    344  1.1  lukem 
    345  1.1  lukem 	while (entryMessage) {
    346  1.1  lukem 	    tclResult = LDAP_ProcessOneSearchResult  (interp,
    347  1.1  lukem 				    ldap,
    348  1.1  lukem 				    entryMessage,
    349  1.1  lukem 				    destArrayNameObj,
    350  1.1  lukem 				    evalCodeObj);
    351  1.1  lukem 	    if (tclResult != TCL_OK) {
    352  1.1  lukem 		if (tclResult == TCL_CONTINUE) {
    353  1.1  lukem 		    tclResult = TCL_OK;
    354  1.1  lukem 		} else if (tclResult == TCL_BREAK) {
    355  1.1  lukem 		    tclResult = TCL_OK;
    356  1.1  lukem 		    abandon = 1;
    357  1.1  lukem 		    break;
    358  1.1  lukem 		} else if (tclResult == TCL_ERROR) {
    359  1.1  lukem 		    char msg[100];
    360  1.1  lukem 		    sprintf(msg, "\n    (\"search\" body line %d)",
    361  1.1  lukem 			    interp->errorLine);
    362  1.1  lukem 		    Tcl_AddObjErrorInfo(interp, msg, -1);
    363  1.1  lukem 		    abandon = 1;
    364  1.1  lukem 		    break;
    365  1.1  lukem 		} else {
    366  1.1  lukem 		    abandon = 1;
    367  1.1  lukem 		    break;
    368  1.1  lukem 		}
    369  1.1  lukem 	    }
    370  1.1  lukem 	    entryMessage = ldap_next_entry(ldap, entryMessage);
    371  1.1  lukem 	}
    372  1.1  lukem 	if (resultCode == LDAP_RES_SEARCH_RESULT || all)
    373  1.1  lukem 	    break;
    374  1.1  lukem 	if (resultMessage)
    375  1.1  lukem  	ldap_msgfree(resultMessage);
    376  1.1  lukem 	resultMessage = NULL;
    377  1.1  lukem     }
    378  1.1  lukem     if (abandon) {
    379  1.1  lukem 	if (resultMessage)
    380  1.1  lukem 	    ldap_msgfree(resultMessage);
    381  1.1  lukem 	if (resultCode == LDAP_RES_SEARCH_ENTRY)
    382  1.1  lukem 	    ldap_abandon(ldap, msgid);
    383  1.1  lukem 	return tclResult;
    384  1.1  lukem     }
    385  1.1  lukem     if (resultCode == -1) {
    386  1.1  lukem 	Tcl_ResetResult (interp);
    387  1.1  lukem 	Tcl_AppendResult (interp,
    388  1.1  lukem 				"LDAP result search error: ",
    389  1.1  lukem 				LDAP_ERR_STRING(ldap),
    390  1.1  lukem 				(char *)NULL);
    391  1.1  lukem 	LDAP_SetErrorCode(ldaptcl, -1, interp);
    392  1.1  lukem 	return TCL_ERROR;
    393  1.1  lukem     }
    394  1.1  lukem 
    395  1.1  lukem     if ((errorCode = ldap_result2error (ldap, resultMessage, 0))
    396  1.1  lukem       != LDAP_SUCCESS) {
    397  1.1  lukem       Tcl_ResetResult (interp);
    398  1.1  lukem       Tcl_AppendResult (interp,
    399  1.1  lukem 			      "LDAP search error: ",
    400  1.1  lukem 			      ldap_err2string(errorCode),
    401  1.1  lukem 			      (char *)NULL);
    402  1.1  lukem       if (resultMessage)
    403  1.1  lukem 	  ldap_msgfree(resultMessage);
    404  1.1  lukem       LDAP_SetErrorCode(ldaptcl, errorCode, interp);
    405  1.1  lukem       return TCL_ERROR;
    406  1.1  lukem     }
    407  1.1  lukem     if (resultMessage)
    408  1.1  lukem 	ldap_msgfree(resultMessage);
    409  1.1  lukem     return tclResult;
    410  1.1  lukem }
    411  1.1  lukem 
    412  1.1  lukem /*-----------------------------------------------------------------------------
    413  1.1  lukem  * NeoX_LdapTargetObjCmd --
    414  1.1  lukem  *
    415  1.1  lukem  * Implements the body of commands created by Neo_LdapObjCmd.
    416  1.1  lukem  *
    417  1.1  lukem  * Results:
    418  1.1  lukem  *      A standard Tcl result.
    419  1.1  lukem  *
    420  1.1  lukem  * Side effects:
    421  1.1  lukem  *      See the user documentation.
    422  1.1  lukem  *-----------------------------------------------------------------------------
    423  1.1  lukem  */
    424  1.1  lukem int
    425  1.1  lukem NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
    426  1.1  lukem     ClientData    clientData;
    427  1.1  lukem     Tcl_Interp   *interp;
    428  1.1  lukem     int           objc;
    429  1.1  lukem     Tcl_Obj      *CONST objv[];
    430  1.1  lukem {
    431  1.1  lukem     char         *command;
    432  1.1  lukem     char         *subCommand;
    433  1.1  lukem     LDAPTCL      *ldaptcl = (LDAPTCL *)clientData;
    434  1.1  lukem     LDAP         *ldap = ldaptcl->ldap;
    435  1.1  lukem     char         *dn;
    436  1.1  lukem     int           is_add = 0;
    437  1.1  lukem     int           is_add_or_modify = 0;
    438  1.1  lukem     int           mod_op = 0;
    439  1.1  lukem     char	 *m, *s, *errmsg;
    440  1.1  lukem     int		 errcode;
    441  1.1  lukem     int		 tclResult;
    442  1.1  lukem     int		 lderrno;	/* might be used by LDAP_ERR_STRING macro */
    443  1.1  lukem 
    444  1.1  lukem     Tcl_Obj      *resultObj = Tcl_GetObjResult (interp);
    445  1.1  lukem 
    446  1.1  lukem     if (objc < 2) {
    447  1.1  lukem 	Tcl_WrongNumArgs (interp, 1, objv, "subcommand [args...]");
    448  1.1  lukem 	return TCL_ERROR;
    449  1.1  lukem     }
    450  1.1  lukem 
    451  1.1  lukem     command = Tcl_GetStringFromObj (objv[0], NULL);
    452  1.1  lukem     subCommand = Tcl_GetStringFromObj (objv[1], NULL);
    453  1.1  lukem 
    454  1.1  lukem     /* object bind authtype name password */
    455  1.1  lukem     if (STREQU (subCommand, "bind")) {
    456  1.1  lukem 	char     *binddn;
    457  1.1  lukem 	char     *passwd;
    458  1.1  lukem 	int       stringLength;
    459  1.1  lukem 	char     *ldap_authString;
    460  1.1  lukem 	int       ldap_authInt;
    461  1.1  lukem 
    462  1.1  lukem 	if (objc != 5) {
    463  1.1  lukem 	    Tcl_WrongNumArgs (interp, 2, objv, "authtype dn passwd");
    464  1.1  lukem 	    return TCL_ERROR;
    465  1.1  lukem 	}
    466  1.1  lukem 
    467  1.1  lukem 	ldap_authString = Tcl_GetStringFromObj (objv[2], NULL);
    468  1.1  lukem 
    469  1.1  lukem 	if (STREQU (ldap_authString, "simple")) {
    470  1.1  lukem 	    ldap_authInt = LDAP_AUTH_SIMPLE;
    471  1.1  lukem 	}
    472  1.1  lukem #ifdef UMICH_LDAP
    473  1.1  lukem 	else if (STREQU (ldap_authString, "kerberos_ldap")) {
    474  1.1  lukem 	    ldap_authInt = LDAP_AUTH_KRBV41;
    475  1.1  lukem 	} else if (STREQU (ldap_authString, "kerberos_dsa")) {
    476  1.1  lukem 	    ldap_authInt = LDAP_AUTH_KRBV42;
    477  1.1  lukem 	} else if (STREQU (ldap_authString, "kerberos_both")) {
    478  1.1  lukem 	    ldap_authInt = LDAP_AUTH_KRBV4;
    479  1.1  lukem 	}
    480  1.1  lukem #endif
    481  1.1  lukem 	else {
    482  1.1  lukem 	    Tcl_AppendStringsToObj (resultObj,
    483  1.1  lukem 				    "\"",
    484  1.1  lukem 				    command,
    485  1.1  lukem 				    " ",
    486  1.1  lukem 				    subCommand,
    487  1.1  lukem #ifdef UMICH_LDAP
    488  1.1  lukem 				    "\" authtype must be one of \"simple\", ",
    489  1.1  lukem 				    "\"kerberos_ldap\", \"kerberos_dsa\" ",
    490  1.1  lukem 				    "or \"kerberos_both\"",
    491  1.1  lukem #else
    492  1.1  lukem 				    "\" authtype must be \"simple\", ",
    493  1.1  lukem #endif
    494  1.1  lukem 				    (char *)NULL);
    495  1.1  lukem 	    return TCL_ERROR;
    496  1.1  lukem 	}
    497  1.1  lukem 
    498  1.1  lukem 	binddn = Tcl_GetStringFromObj (objv[3], &stringLength);
    499  1.1  lukem 	if (stringLength == 0)
    500  1.1  lukem 	    binddn = NULL;
    501  1.1  lukem 
    502  1.1  lukem 	passwd = Tcl_GetStringFromObj (objv[4], &stringLength);
    503  1.1  lukem 	if (stringLength == 0)
    504  1.1  lukem 	    passwd = NULL;
    505  1.1  lukem 
    506  1.1  lukem /*  ldap_bind_s(ldap, dn, pw, method) */
    507  1.1  lukem 
    508  1.1  lukem #ifdef UMICH_LDAP
    509  1.1  lukem #define LDAP_BIND(ldap, dn, pw, method) \
    510  1.1  lukem   ldap_bind_s(ldap, dn, pw, method)
    511  1.1  lukem #else
    512  1.1  lukem #define LDAP_BIND(ldap, dn, pw, method) \
    513  1.1  lukem   ldap_simple_bind_s(ldap, dn, pw)
    514  1.1  lukem #endif
    515  1.1  lukem 	if ((errcode = LDAP_BIND (ldap,
    516  1.1  lukem 			 binddn,
    517  1.1  lukem 			 passwd,
    518  1.1  lukem 			 ldap_authInt)) != LDAP_SUCCESS) {
    519  1.1  lukem 
    520  1.1  lukem 	    Tcl_AppendStringsToObj (resultObj,
    521  1.1  lukem 			            "LDAP bind error: ",
    522  1.1  lukem 				    ldap_err2string(errcode),
    523  1.1  lukem 				    (char *)NULL);
    524  1.1  lukem 	    LDAP_SetErrorCode(ldaptcl, errcode, interp);
    525  1.1  lukem 	    return TCL_ERROR;
    526  1.1  lukem 	}
    527  1.1  lukem 	return TCL_OK;
    528  1.1  lukem     }
    529  1.1  lukem 
    530  1.1  lukem     if (STREQU (subCommand, "unbind")) {
    531  1.1  lukem 	if (objc != 2) {
    532  1.1  lukem 	    Tcl_WrongNumArgs (interp, 2, objv, "");
    533  1.1  lukem 	    return TCL_ERROR;
    534  1.1  lukem 	}
    535  1.1  lukem 
    536  1.1  lukem        return Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], NULL));
    537  1.1  lukem     }
    538  1.1  lukem 
    539  1.1  lukem     /* object delete dn */
    540  1.1  lukem     if (STREQU (subCommand, "delete")) {
    541  1.1  lukem 	if (objc != 3) {
    542  1.1  lukem 	    Tcl_WrongNumArgs (interp, 2, objv, "dn");
    543  1.1  lukem 	    return TCL_ERROR;
    544  1.1  lukem 	}
    545  1.1  lukem 
    546  1.1  lukem        dn = Tcl_GetStringFromObj (objv [2], NULL);
    547  1.1  lukem        if ((errcode = ldap_delete_s(ldap, dn)) != LDAP_SUCCESS) {
    548  1.1  lukem 	   Tcl_AppendStringsToObj (resultObj,
    549  1.1  lukem 			           "LDAP delete error: ",
    550  1.1  lukem 				   ldap_err2string(errcode),
    551  1.1  lukem 				   (char *)NULL);
    552  1.1  lukem 	   LDAP_SetErrorCode(ldaptcl, errcode, interp);
    553  1.1  lukem 	   return TCL_ERROR;
    554  1.1  lukem        }
    555  1.1  lukem        return TCL_OK;
    556  1.1  lukem     }
    557  1.1  lukem 
    558  1.1  lukem     /* object rename_rdn dn rdn */
    559  1.1  lukem     /* object modify_rdn dn rdn */
    560  1.1  lukem     if (STREQU (subCommand, "rename_rdn") || STREQU (subCommand, "modify_rdn")) {
    561  1.1  lukem 	char    *rdn;
    562  1.1  lukem 	int      deleteOldRdn;
    563  1.1  lukem 
    564  1.1  lukem 	if (objc != 4) {
    565  1.1  lukem 	    Tcl_WrongNumArgs (interp, 2, objv, "dn rdn");
    566  1.1  lukem 	    return TCL_ERROR;
    567  1.1  lukem 	}
    568  1.1  lukem 
    569  1.1  lukem 	dn = Tcl_GetStringFromObj (objv [2], NULL);
    570  1.1  lukem 	rdn = Tcl_GetStringFromObj (objv [3], NULL);
    571  1.1  lukem 
    572  1.1  lukem 	deleteOldRdn = (*subCommand == 'r');
    573  1.1  lukem 
    574  1.1  lukem 	if ((errcode = ldap_modrdn2_s (ldap, dn, rdn, deleteOldRdn)) != LDAP_SUCCESS) {
    575  1.1  lukem 	    Tcl_AppendStringsToObj (resultObj,
    576  1.1  lukem 				    "LDAP ",
    577  1.1  lukem 				    subCommand,
    578  1.1  lukem 				    " error: ",
    579  1.1  lukem 				    ldap_err2string(errcode),
    580  1.1  lukem 				    (char *)NULL);
    581  1.1  lukem 	    LDAP_SetErrorCode(ldaptcl, errcode, interp);
    582  1.1  lukem 	    return TCL_ERROR;
    583  1.1  lukem 	}
    584  1.1  lukem 	return TCL_OK;
    585  1.1  lukem     }
    586  1.1  lukem 
    587  1.1  lukem     /* object add dn attributePairList */
    588  1.1  lukem     /* object add_attributes dn attributePairList */
    589  1.1  lukem     /* object replace_attributes dn attributePairList */
    590  1.1  lukem     /* object delete_attributes dn attributePairList */
    591  1.1  lukem 
    592  1.1  lukem     if (STREQU (subCommand, "add")) {
    593  1.1  lukem 	is_add = 1;
    594  1.1  lukem 	is_add_or_modify = 1;
    595  1.1  lukem     } else {
    596  1.1  lukem 	is_add = 0;
    597  1.1  lukem 	if (STREQU (subCommand, "add_attributes")) {
    598  1.1  lukem 	    is_add_or_modify = 1;
    599  1.1  lukem 	    mod_op = LDAP_MOD_ADD;
    600  1.1  lukem 	} else if (STREQU (subCommand, "replace_attributes")) {
    601  1.1  lukem 	    is_add_or_modify = 1;
    602  1.1  lukem 	    mod_op = LDAP_MOD_REPLACE;
    603  1.1  lukem 	} else if (STREQU (subCommand, "delete_attributes")) {
    604  1.1  lukem 	    is_add_or_modify = 1;
    605  1.1  lukem 	    mod_op = LDAP_MOD_DELETE;
    606  1.1  lukem 	}
    607  1.1  lukem     }
    608  1.1  lukem 
    609  1.1  lukem     if (is_add_or_modify) {
    610  1.1  lukem 	int          result;
    611  1.1  lukem 	LDAPMod    **modArray;
    612  1.1  lukem 	LDAPMod     *mod;
    613  1.1  lukem 	char       **valPtrs = NULL;
    614  1.1  lukem 	int          attribObjc;
    615  1.1  lukem 	Tcl_Obj    **attribObjv;
    616  1.1  lukem 	int          valuesObjc;
    617  1.1  lukem 	Tcl_Obj    **valuesObjv;
    618  1.1  lukem 	int          nPairs, allPairs;
    619  1.1  lukem 	int          i;
    620  1.1  lukem 	int          j;
    621  1.1  lukem 	int	     pairIndex;
    622  1.1  lukem 	int	     modIndex;
    623  1.1  lukem 
    624  1.1  lukem 	Tcl_Obj      *resultObj = Tcl_GetObjResult (interp);
    625  1.1  lukem 
    626  1.1  lukem 	if (objc < 4 || objc > 4 && is_add || is_add == 0 && objc&1) {
    627  1.1  lukem 	    Tcl_AppendStringsToObj (resultObj,
    628  1.1  lukem 				    "wrong # args: ",
    629  1.1  lukem 				    Tcl_GetStringFromObj (objv [0], NULL),
    630  1.1  lukem 				    " ",
    631  1.1  lukem 				    subCommand,
    632  1.1  lukem 				    " dn attributePairList",
    633  1.1  lukem 				    (char *)NULL);
    634  1.1  lukem 	    if (!is_add)
    635  1.1  lukem 		Tcl_AppendStringsToObj (resultObj,
    636  1.1  lukem 		    " ?[add|delete|replace] attributePairList ...?", (char *)NULL);
    637  1.1  lukem 	    return TCL_ERROR;
    638  1.1  lukem 	}
    639  1.1  lukem 
    640  1.1  lukem 	dn = Tcl_GetStringFromObj (objv [2], NULL);
    641  1.1  lukem 
    642  1.1  lukem 	allPairs = 0;
    643  1.1  lukem 	for (i = 3; i < objc; i += 2) {
    644  1.1  lukem 	    if (Tcl_ListObjLength (interp, objv[i], &j) == TCL_ERROR)
    645  1.1  lukem 		return TCL_ERROR;
    646  1.1  lukem 	    if (j & 1) {
    647  1.1  lukem 		Tcl_AppendStringsToObj (resultObj,
    648  1.1  lukem 					"attribute list does not contain an ",
    649  1.1  lukem 					"even number of key-value elements",
    650  1.1  lukem 					(char *)NULL);
    651  1.1  lukem 		return TCL_ERROR;
    652  1.1  lukem 	    }
    653  1.1  lukem 	    allPairs += j / 2;
    654  1.1  lukem 	}
    655  1.1  lukem 
    656  1.1  lukem 	modArray = (LDAPMod **)malloc (sizeof(LDAPMod *) * (allPairs + 1));
    657  1.1  lukem 
    658  1.1  lukem 	pairIndex = 3;
    659  1.1  lukem 	modIndex = 0;
    660  1.1  lukem 
    661  1.1  lukem 	do {
    662  1.1  lukem 
    663  1.1  lukem 	if (Tcl_ListObjGetElements (interp, objv [pairIndex], &attribObjc, &attribObjv)
    664  1.1  lukem 	  == TCL_ERROR) {
    665  1.1  lukem 	   mod_op = -1;
    666  1.1  lukem 	   goto badop;
    667  1.1  lukem 	}
    668  1.1  lukem 
    669  1.1  lukem 	nPairs = attribObjc / 2;
    670  1.1  lukem 
    671  1.1  lukem 	for (i = 0; i < nPairs; i++) {
    672  1.1  lukem 	    mod = modArray[modIndex++] = (LDAPMod *) malloc (sizeof(LDAPMod));
    673  1.1  lukem 	    mod->mod_op = mod_op;
    674  1.1  lukem 	    mod->mod_type = Tcl_GetStringFromObj (attribObjv [i * 2], NULL);
    675  1.1  lukem 
    676  1.1  lukem 	    if (Tcl_ListObjGetElements (interp, attribObjv [i * 2 + 1], &valuesObjc, &valuesObjv) == TCL_ERROR) {
    677  1.1  lukem 		/* FIX: cleanup memory here */
    678  1.1  lukem 		mod_op = -1;
    679  1.1  lukem 		goto badop;
    680  1.1  lukem 	    }
    681  1.1  lukem 
    682  1.1  lukem 	    valPtrs = mod->mod_vals.modv_strvals = \
    683  1.1  lukem 	        (char **)malloc (sizeof (char *) * (valuesObjc + 1));
    684  1.1  lukem 	    valPtrs[valuesObjc] = (char *)NULL;
    685  1.1  lukem 
    686  1.1  lukem 	    for (j = 0; j < valuesObjc; j++) {
    687  1.1  lukem 		valPtrs [j] = Tcl_GetStringFromObj (valuesObjv[j], NULL);
    688  1.1  lukem 
    689  1.1  lukem 		/* If it's "delete" and value is an empty string, make
    690  1.1  lukem 		 * value be NULL to indicate entire attribute is to be
    691  1.1  lukem 		 * deleted */
    692  1.1  lukem 		if ((*valPtrs [j] == '\0')
    693  1.1  lukem 		    && (mod->mod_op == LDAP_MOD_DELETE || mod->mod_op == LDAP_MOD_REPLACE)) {
    694  1.1  lukem 			valPtrs [j] = NULL;
    695  1.1  lukem 		}
    696  1.1  lukem 	    }
    697  1.1  lukem 	}
    698  1.1  lukem 
    699  1.1  lukem 	pairIndex += 2;
    700  1.1  lukem 	if (mod_op != -1 && pairIndex < objc) {
    701  1.1  lukem 	    subCommand = Tcl_GetStringFromObj (objv[pairIndex - 1], NULL);
    702  1.1  lukem 	    mod_op = -1;
    703  1.1  lukem 	    if (STREQU (subCommand, "add")) {
    704  1.1  lukem 		mod_op = LDAP_MOD_ADD;
    705  1.1  lukem 	    } else if (STREQU (subCommand, "replace")) {
    706  1.1  lukem 		mod_op = LDAP_MOD_REPLACE;
    707  1.1  lukem 	    } else if (STREQU (subCommand, "delete")) {
    708  1.1  lukem 		mod_op = LDAP_MOD_DELETE;
    709  1.1  lukem 	    }
    710  1.1  lukem 	    if (mod_op == -1) {
    711  1.1  lukem 		Tcl_SetStringObj (resultObj,
    712  1.1  lukem 			"Additional operators must be one of"
    713  1.1  lukem 			" add, replace, or delete", -1);
    714  1.1  lukem 		mod_op = -1;
    715  1.1  lukem 		goto badop;
    716  1.1  lukem 	    }
    717  1.1  lukem 	}
    718  1.1  lukem 
    719  1.1  lukem 	} while (mod_op != -1 && pairIndex < objc);
    720  1.1  lukem 	modArray[modIndex] = (LDAPMod *) NULL;
    721  1.1  lukem 
    722  1.1  lukem 	if (is_add) {
    723  1.1  lukem 	    result = ldap_add_s (ldap, dn, modArray);
    724  1.1  lukem 	} else {
    725  1.1  lukem 	    result = ldap_modify_s (ldap, dn, modArray);
    726  1.1  lukem 	    if (ldaptcl->caching)
    727  1.1  lukem 		ldap_uncache_entry (ldap, dn);
    728  1.1  lukem 	}
    729  1.1  lukem 
    730  1.1  lukem         /* free the modArray elements, then the modArray itself. */
    731  1.1  lukem badop:
    732  1.1  lukem 	for (i = 0; i < modIndex; i++) {
    733  1.1  lukem 	    free ((char *) modArray[i]->mod_vals.modv_strvals);
    734  1.1  lukem 	    free ((char *) modArray[i]);
    735  1.1  lukem 	}
    736  1.1  lukem 	free ((char *) modArray);
    737  1.1  lukem 
    738  1.1  lukem 	/* after modArray is allocated, mod_op = -1 upon error for cleanup */
    739  1.1  lukem 	if (mod_op == -1)
    740  1.1  lukem 	    return TCL_ERROR;
    741  1.1  lukem 
    742  1.1  lukem 	/* FIX: memory cleanup required all over the place here */
    743  1.1  lukem         if (result != LDAP_SUCCESS) {
    744  1.1  lukem 	    Tcl_AppendStringsToObj (resultObj,
    745  1.1  lukem 				    "LDAP ",
    746  1.1  lukem 				    subCommand,
    747  1.1  lukem 				    " error: ",
    748  1.1  lukem 				    ldap_err2string(result),
    749  1.1  lukem 				    (char *)NULL);
    750  1.1  lukem 	    LDAP_SetErrorCode(ldaptcl, result, interp);
    751  1.1  lukem 	    return TCL_ERROR;
    752  1.1  lukem 	}
    753  1.1  lukem 	return TCL_OK;
    754  1.1  lukem     }
    755  1.1  lukem 
    756  1.1  lukem     /* object search controlArray dn pattern */
    757  1.1  lukem     if (STREQU (subCommand, "search")) {
    758  1.1  lukem 	char        *controlArrayName;
    759  1.1  lukem 	Tcl_Obj     *controlArrayNameObj;
    760  1.1  lukem 
    761  1.1  lukem 	char        *scopeString;
    762  1.1  lukem 	int          scope;
    763  1.1  lukem 
    764  1.1  lukem 	char        *derefString;
    765  1.1  lukem 	int          deref;
    766  1.1  lukem 
    767  1.1  lukem 	char        *baseString;
    768  1.1  lukem 
    769  1.1  lukem 	char       **attributesArray;
    770  1.1  lukem 	char        *attributesString;
    771  1.1  lukem 	int          attributesArgc;
    772  1.1  lukem 
    773  1.1  lukem 	char        *filterPatternString;
    774  1.1  lukem 
    775  1.1  lukem 	char	    *timeoutString;
    776  1.1  lukem 	double 	     timeoutTime;
    777  1.1  lukem 	struct timeval timeout, *timeout_p;
    778  1.1  lukem 
    779  1.1  lukem 	char	    *paramString;
    780  1.1  lukem 	int	     cacheThis = -1;
    781  1.1  lukem 	int	     all = 0;
    782  1.1  lukem 
    783  1.1  lukem 	char	    *sortattr;
    784  1.1  lukem 
    785  1.1  lukem 	Tcl_Obj     *destArrayNameObj;
    786  1.1  lukem 	Tcl_Obj     *evalCodeObj;
    787  1.1  lukem 
    788  1.1  lukem 	if (objc != 5) {
    789  1.1  lukem 	    Tcl_WrongNumArgs (interp, 2, objv,
    790  1.1  lukem 				   "controlArray destArray code");
    791  1.1  lukem 	    return TCL_ERROR;
    792  1.1  lukem 	}
    793  1.1  lukem 
    794  1.1  lukem         controlArrayNameObj = objv [2];
    795  1.1  lukem 	controlArrayName = Tcl_GetStringFromObj (controlArrayNameObj, NULL);
    796  1.1  lukem 
    797  1.1  lukem 	destArrayNameObj = objv [3];
    798  1.1  lukem 
    799  1.1  lukem 	evalCodeObj = objv [4];
    800  1.1  lukem 
    801  1.1  lukem 	baseString = Tcl_GetVar2 (interp,
    802  1.1  lukem 				  controlArrayName,
    803  1.1  lukem 				  "base",
    804  1.1  lukem 				  0);
    805  1.1  lukem 
    806  1.1  lukem 	if (baseString == (char *)NULL) {
    807  1.1  lukem 	    Tcl_AppendStringsToObj (resultObj,
    808  1.1  lukem 				    "required element \"base\" ",
    809  1.1  lukem 				    "is missing from ldap control array \"",
    810  1.1  lukem 				    controlArrayName,
    811  1.1  lukem 				    "\"",
    812  1.1  lukem 				    (char *)NULL);
    813  1.1  lukem 	    return TCL_ERROR;
    814  1.1  lukem 	}
    815  1.1  lukem 
    816  1.1  lukem 	filterPatternString = Tcl_GetVar2 (interp,
    817  1.1  lukem 				           controlArrayName,
    818  1.1  lukem 				           "filter",
    819  1.1  lukem 				           0);
    820  1.1  lukem 	if (filterPatternString == (char *)NULL) {
    821  1.1  lukem 	    filterPatternString = "(objectclass=*)";
    822  1.1  lukem 	}
    823  1.1  lukem 
    824  1.1  lukem 	/* Fetch scope setting from control array.
    825  1.1  lukem 	 * If it doesn't exist, default to subtree scoping.
    826  1.1  lukem 	 */
    827  1.1  lukem 	scopeString = Tcl_GetVar2 (interp, controlArrayName, "scope", 0);
    828  1.1  lukem 	if (scopeString == NULL) {
    829  1.1  lukem 	    scope = LDAP_SCOPE_SUBTREE;
    830  1.1  lukem 	} else {
    831  1.1  lukem 	    if (STREQU(scopeString, "base"))
    832  1.1  lukem 		scope = LDAP_SCOPE_BASE;
    833  1.1  lukem 	    else if (STRNEQU(scopeString, "one", 3))
    834  1.1  lukem 		scope = LDAP_SCOPE_ONELEVEL;
    835  1.1  lukem 	    else if (STRNEQU(scopeString, "sub", 3))
    836  1.1  lukem 		scope = LDAP_SCOPE_SUBTREE;
    837  1.1  lukem 	    else {
    838  1.1  lukem 		Tcl_AppendStringsToObj (resultObj,
    839  1.1  lukem 				        "\"scope\" element of \"",
    840  1.1  lukem 				        controlArrayName,
    841  1.1  lukem 				        "\" array is not one of ",
    842  1.1  lukem 				        "\"base\", \"onelevel\", ",
    843  1.1  lukem 					"or \"subtree\"",
    844  1.1  lukem 				      (char *) NULL);
    845  1.1  lukem 		return TCL_ERROR;
    846  1.1  lukem 	    }
    847  1.1  lukem 	}
    848  1.1  lukem 
    849  1.1  lukem #ifdef LDAP_OPT_DEREF
    850  1.1  lukem 	/* Fetch dereference control setting from control array.
    851  1.1  lukem 	 * If it doesn't exist, default to never dereference. */
    852  1.1  lukem 	derefString = Tcl_GetVar2 (interp,
    853  1.1  lukem 				   controlArrayName,
    854  1.1  lukem 				   "deref",
    855  1.1  lukem 				   0);
    856  1.1  lukem 	if (derefString == (char *)NULL) {
    857  1.1  lukem 	    deref = LDAP_DEREF_NEVER;
    858  1.1  lukem 	} else {
    859  1.1  lukem 	    if (STREQU(derefString, "never"))
    860  1.1  lukem 		deref = LDAP_DEREF_NEVER;
    861  1.1  lukem 	    else if (STREQU(derefString, "search"))
    862  1.1  lukem 		deref = LDAP_DEREF_SEARCHING;
    863  1.1  lukem 	    else if (STREQU(derefString, "find"))
    864  1.1  lukem 		deref = LDAP_DEREF_FINDING;
    865  1.1  lukem 	    else if (STREQU(derefString, "always"))
    866  1.1  lukem 		deref = LDAP_DEREF_ALWAYS;
    867  1.1  lukem 	    else {
    868  1.1  lukem 		Tcl_AppendStringsToObj (resultObj,
    869  1.1  lukem 				        "\"deref\" element of \"",
    870  1.1  lukem 				        controlArrayName,
    871  1.1  lukem 				        "\" array is not one of ",
    872  1.1  lukem 				        "\"never\", \"search\", \"find\", ",
    873  1.1  lukem 				        "or \"always\"",
    874  1.1  lukem 				        (char *) NULL);
    875  1.1  lukem 		return TCL_ERROR;
    876  1.1  lukem 	    }
    877  1.1  lukem 	}
    878  1.1  lukem #endif
    879  1.1  lukem 
    880  1.1  lukem 	/* Fetch list of attribute names from control array.
    881  1.1  lukem 	 * If entry doesn't exist, default to NULL (all).
    882  1.1  lukem 	 */
    883  1.1  lukem 	attributesString = Tcl_GetVar2 (interp,
    884  1.1  lukem 				        controlArrayName,
    885  1.1  lukem 				        "attributes",
    886  1.1  lukem 				        0);
    887  1.1  lukem 	if (attributesString == (char *)NULL) {
    888  1.1  lukem 	    attributesArray = NULL;
    889  1.1  lukem 	} else {
    890  1.1  lukem 	    if ((Tcl_SplitList (interp,
    891  1.1  lukem 				attributesString,
    892  1.1  lukem 				&attributesArgc,
    893  1.1  lukem 				&attributesArray)) != TCL_OK) {
    894  1.1  lukem 		return TCL_ERROR;
    895  1.1  lukem 	    }
    896  1.1  lukem 	}
    897  1.1  lukem 
    898  1.1  lukem 	/* Fetch timeout value if there is one
    899  1.1  lukem 	 */
    900  1.1  lukem 	timeoutString = Tcl_GetVar2 (interp,
    901  1.1  lukem 				        controlArrayName,
    902  1.1  lukem 				        "timeout",
    903  1.1  lukem 				        0);
    904  1.1  lukem 	timeout.tv_usec = 0;
    905  1.1  lukem 	if (timeoutString == (char *)NULL) {
    906  1.1  lukem 	    timeout_p = NULL;
    907  1.1  lukem 	    timeout.tv_sec = 0;
    908  1.1  lukem 	} else {
    909  1.1  lukem 	    if (Tcl_GetDouble(interp, timeoutString, &timeoutTime) != TCL_OK)
    910  1.1  lukem 		return TCL_ERROR;
    911  1.1  lukem 	    timeout.tv_sec = floor(timeoutTime);
    912  1.1  lukem 	    timeout.tv_usec = (timeoutTime-timeout.tv_sec) * 1000000;
    913  1.1  lukem 	    timeout_p = &timeout;
    914  1.1  lukem 	}
    915  1.1  lukem 
    916  1.1  lukem 	paramString = Tcl_GetVar2 (interp, controlArrayName, "cache", 0);
    917  1.1  lukem 	if (paramString) {
    918  1.1  lukem 	    if (Tcl_GetInt(interp, paramString, &cacheThis) == TCL_ERROR)
    919  1.1  lukem 		return TCL_ERROR;
    920  1.1  lukem 	}
    921  1.1  lukem 
    922  1.1  lukem 	paramString = Tcl_GetVar2 (interp, controlArrayName, "all", 0);
    923  1.1  lukem 	if (paramString) {
    924  1.1  lukem 	    if (Tcl_GetInt(interp, paramString, &all) == TCL_ERROR)
    925  1.1  lukem 		return TCL_ERROR;
    926  1.1  lukem 	}
    927  1.1  lukem 
    928  1.1  lukem 	sortattr = Tcl_GetVar2 (interp, controlArrayName, "sort", 0);
    929  1.1  lukem 
    930  1.1  lukem #ifdef UMICH_LDAP
    931  1.1  lukem 	ldap->ld_deref = deref;
    932  1.1  lukem 	ldap->ld_timelimit = 0;
    933  1.1  lukem 	ldap->ld_sizelimit = 0;
    934  1.1  lukem 	ldap->ld_options = 0;
    935  1.1  lukem #endif
    936  1.1  lukem 
    937  1.1  lukem 	/* Caching control within the search: if the "cache" control array */
    938  1.1  lukem 	/* value is set, disable/enable caching accordingly */
    939  1.1  lukem 
    940  1.1  lukem #if 0
    941  1.1  lukem 	if (cacheThis >= 0 && ldaptcl->caching != cacheThis) {
    942  1.1  lukem 	    if (cacheThis) {
    943  1.1  lukem 		if (ldaptcl->timeout == 0) {
    944  1.1  lukem 		    Tcl_SetStringObj(resultObj, "Caching never before enabled, I have no timeout value to use", -1);
    945  1.1  lukem 		    return TCL_ERROR;
    946  1.1  lukem 		}
    947  1.1  lukem 		ldap_enable_cache(ldap, ldaptcl->timeout, ldaptcl->maxmem);
    948  1.1  lukem 	    }
    949  1.1  lukem 	    else
    950  1.1  lukem 		ldap_disable_cache(ldap);
    951  1.1  lukem 	}
    952  1.1  lukem #endif
    953  1.1  lukem 
    954  1.1  lukem #ifdef LDAP_OPT_DEREF
    955  1.1  lukem 	ldap_set_option(ldap, LDAP_OPT_DEREF, &deref);
    956  1.1  lukem #endif
    957  1.1  lukem 
    958  1.1  lukem 	tclResult = LDAP_PerformSearch (interp,
    959  1.1  lukem 			            ldaptcl,
    960  1.1  lukem 			            baseString,
    961  1.1  lukem 			            scope,
    962  1.1  lukem 			            attributesArray,
    963  1.1  lukem 			            filterPatternString,
    964  1.1  lukem 			            "",
    965  1.1  lukem 			            destArrayNameObj,
    966  1.1  lukem 			            evalCodeObj,
    967  1.1  lukem 				    timeout_p,
    968  1.1  lukem 				    all,
    969  1.1  lukem 				    sortattr);
    970  1.1  lukem 	/* Following the search, if we changed the caching behavior, change */
    971  1.1  lukem 	/* it back. */
    972  1.1  lukem #if 0
    973  1.1  lukem 	if (cacheThis >= 0 && ldaptcl->caching != cacheThis) {
    974  1.1  lukem 	    if (cacheThis)
    975  1.1  lukem 		ldap_disable_cache(ldap);
    976  1.1  lukem 	    else
    977  1.1  lukem 		ldap_enable_cache(ldap, ldaptcl->timeout, ldaptcl->maxmem);
    978  1.1  lukem 	}
    979  1.1  lukem #ifdef LDAP_OPT_DEREF
    980  1.1  lukem 	deref = LDAP_DEREF_NEVER;
    981  1.1  lukem 	ldap_set_option(ldap, LDAP_OPT_DEREF, &deref);
    982  1.1  lukem #endif
    983  1.1  lukem #endif
    984  1.1  lukem 	return tclResult;
    985  1.1  lukem     }
    986  1.1  lukem 
    987  1.1  lukem     /* object compare dn attr value */
    988  1.1  lukem     if (STREQU (subCommand, "compare")) {
    989  1.1  lukem 	char        *dn;
    990  1.1  lukem 	char	    *attr;
    991  1.1  lukem 	char	    *value;
    992  1.1  lukem 	int	     result;
    993  1.1  lukem 	int	     lderrno;
    994  1.1  lukem 
    995  1.1  lukem 	if (objc != 5) {
    996  1.1  lukem 	    Tcl_WrongNumArgs (interp,
    997  1.1  lukem 				   2, objv,
    998  1.1  lukem 				   "dn attribute value");
    999  1.1  lukem 	    return TCL_ERROR;
   1000  1.1  lukem 	}
   1001  1.1  lukem 
   1002  1.1  lukem 	dn = Tcl_GetStringFromObj (objv[2], NULL);
   1003  1.1  lukem 	attr = Tcl_GetStringFromObj (objv[3], NULL);
   1004  1.1  lukem 	value = Tcl_GetStringFromObj (objv[4], NULL);
   1005  1.1  lukem 
   1006  1.1  lukem 	result = ldap_compare_s (ldap, dn, attr, value);
   1007  1.1  lukem 	if (result == LDAP_COMPARE_TRUE || result == LDAP_COMPARE_FALSE) {
   1008  1.1  lukem 	    Tcl_SetBooleanObj(resultObj, result == LDAP_COMPARE_TRUE);
   1009  1.1  lukem 	    return TCL_OK;
   1010  1.1  lukem 	}
   1011  1.1  lukem 	LDAP_SetErrorCode(ldaptcl, result, interp);
   1012  1.1  lukem 	Tcl_AppendStringsToObj (resultObj,
   1013  1.1  lukem 				"LDAP compare error: ",
   1014  1.1  lukem 				LDAP_ERR_STRING(ldap),
   1015  1.1  lukem 				(char *)NULL);
   1016  1.1  lukem 	return TCL_ERROR;
   1017  1.1  lukem     }
   1018  1.1  lukem 
   1019  1.1  lukem     if (STREQU (subCommand, "cache")) {
   1020  1.1  lukem #if defined(UMICH_LDAP) || (defined(OPEN_LDAP) && !defined(LDAP_API_VERSION))
   1021  1.1  lukem 	char *cacheCommand;
   1022  1.1  lukem 
   1023  1.1  lukem 	if (objc < 3) {
   1024  1.1  lukem 	  badargs:
   1025  1.1  lukem 	    Tcl_WrongNumArgs (interp, 2, objv [0], "command [args...]");
   1026  1.1  lukem 	    return TCL_ERROR;
   1027  1.1  lukem 	}
   1028  1.1  lukem 
   1029  1.1  lukem 	cacheCommand = Tcl_GetStringFromObj (objv [2], NULL);
   1030  1.1  lukem 
   1031  1.1  lukem 	if (STREQU (cacheCommand, "uncache")) {
   1032  1.1  lukem 	    char *dn;
   1033  1.1  lukem 
   1034  1.1  lukem 	    if (objc != 4) {
   1035  1.1  lukem 		Tcl_WrongNumArgs (interp,
   1036  1.1  lukem 				       3, objv,
   1037  1.1  lukem 				       "dn");
   1038  1.1  lukem 		return TCL_ERROR;
   1039  1.1  lukem 	    }
   1040  1.1  lukem 
   1041  1.1  lukem             dn = Tcl_GetStringFromObj (objv [3], NULL);
   1042  1.1  lukem 	    ldap_uncache_entry (ldap, dn);
   1043  1.1  lukem 	    return TCL_OK;
   1044  1.1  lukem 	}
   1045  1.1  lukem 
   1046  1.1  lukem 	if (STREQU (cacheCommand, "enable")) {
   1047  1.1  lukem 	    long   timeout = ldaptcl->timeout;
   1048  1.1  lukem 	    long   maxmem = ldaptcl->maxmem;
   1049  1.1  lukem 
   1050  1.1  lukem 	    if (objc > 5) {
   1051  1.1  lukem 		Tcl_WrongNumArgs (interp, 3, objv, "?timeout? ?maxmem?");
   1052  1.1  lukem 		return TCL_ERROR;
   1053  1.1  lukem 	    }
   1054  1.1  lukem 
   1055  1.1  lukem 	    if (objc > 3) {
   1056  1.1  lukem 		if (Tcl_GetLongFromObj (interp, objv [3], &timeout) == TCL_ERROR)
   1057  1.1  lukem 		    return TCL_ERROR;
   1058  1.1  lukem 	    }
   1059  1.1  lukem 	    if (timeout == 0) {
   1060  1.1  lukem 		Tcl_SetStringObj(resultObj,
   1061  1.1  lukem 		    objc > 3 ? "timeouts must be greater than 0" :
   1062  1.1  lukem 		    "no previous timeout to reference", -1);
   1063  1.1  lukem 		return TCL_ERROR;
   1064  1.1  lukem 	    }
   1065  1.1  lukem 
   1066  1.1  lukem 	    if (objc > 4)
   1067  1.1  lukem 		if (Tcl_GetLongFromObj (interp, objv [4], &maxmem) == TCL_ERROR)
   1068  1.1  lukem 		    return TCL_ERROR;
   1069  1.1  lukem 
   1070  1.1  lukem 	    if (ldap_enable_cache (ldap, timeout, maxmem) == -1) {
   1071  1.1  lukem 		Tcl_AppendStringsToObj (resultObj,
   1072  1.1  lukem 					"LDAP cache enable error: ",
   1073  1.1  lukem 					LDAP_ERR_STRING(ldap),
   1074  1.1  lukem 					(char *)NULL);
   1075  1.1  lukem 		LDAP_SetErrorCode(ldaptcl, -1, interp);
   1076  1.1  lukem 		return TCL_ERROR;
   1077  1.1  lukem 	    }
   1078  1.1  lukem 	    ldaptcl->caching = 1;
   1079  1.1  lukem 	    ldaptcl->timeout = timeout;
   1080  1.1  lukem 	    ldaptcl->maxmem = maxmem;
   1081  1.1  lukem 	    return TCL_OK;
   1082  1.1  lukem 	}
   1083  1.1  lukem 
   1084  1.1  lukem 	if (objc != 3) goto badargs;
   1085  1.1  lukem 
   1086  1.1  lukem 	if (STREQU (cacheCommand, "disable")) {
   1087  1.1  lukem 	    ldap_disable_cache (ldap);
   1088  1.1  lukem 	    ldaptcl->caching = 0;
   1089  1.1  lukem 	    return TCL_OK;
   1090  1.1  lukem 	}
   1091  1.1  lukem 
   1092  1.1  lukem 	if (STREQU (cacheCommand, "destroy")) {
   1093  1.1  lukem 	    ldap_destroy_cache (ldap);
   1094  1.1  lukem 	    ldaptcl->caching = 0;
   1095  1.1  lukem 	    return TCL_OK;
   1096  1.1  lukem 	}
   1097  1.1  lukem 
   1098  1.1  lukem 	if (STREQU (cacheCommand, "flush")) {
   1099  1.1  lukem 	    ldap_flush_cache (ldap);
   1100  1.1  lukem 	    return TCL_OK;
   1101  1.1  lukem 	}
   1102  1.1  lukem 
   1103  1.1  lukem 	if (STREQU (cacheCommand, "no_errors")) {
   1104  1.1  lukem 	    ldap_set_cache_options (ldap, LDAP_CACHE_OPT_CACHENOERRS);
   1105  1.1  lukem 	    return TCL_OK;
   1106  1.1  lukem 	}
   1107  1.1  lukem 
   1108  1.1  lukem 	if (STREQU (cacheCommand, "all_errors")) {
   1109  1.1  lukem 	    ldap_set_cache_options (ldap, LDAP_CACHE_OPT_CACHEALLERRS);
   1110  1.1  lukem 	    return TCL_OK;
   1111  1.1  lukem 	}
   1112  1.1  lukem 
   1113  1.1  lukem 	if (STREQU (cacheCommand, "size_errors")) {
   1114  1.1  lukem 	    ldap_set_cache_options (ldap, 0);
   1115  1.1  lukem 	    return TCL_OK;
   1116  1.1  lukem 	}
   1117  1.1  lukem 	Tcl_AppendStringsToObj (resultObj,
   1118  1.1  lukem 				"\"",
   1119  1.1  lukem 				command,
   1120  1.1  lukem 				" ",
   1121  1.1  lukem 				subCommand,
   1122  1.1  lukem 				"\" subcommand",
   1123  1.1  lukem 				" must be one of \"enable\", ",
   1124  1.1  lukem 				"\"disable\", ",
   1125  1.1  lukem 				"\"destroy\", \"flush\", \"uncache\", ",
   1126  1.1  lukem 				"\"no_errors\", \"size_errors\",",
   1127  1.1  lukem 				" or \"all_errors\"",
   1128  1.1  lukem 				(char *)NULL);
   1129  1.1  lukem 	return TCL_ERROR;
   1130  1.1  lukem #else
   1131  1.1  lukem 	return TCL_OK;
   1132  1.1  lukem #endif
   1133  1.1  lukem     }
   1134  1.1  lukem     if (STREQU (subCommand, "trap")) {
   1135  1.1  lukem 	Tcl_Obj *listObj, *resultObj;
   1136  1.1  lukem 	int *p, l, i, code;
   1137  1.1  lukem 
   1138  1.1  lukem 	if (objc > 4) {
   1139  1.1  lukem 	    Tcl_WrongNumArgs (interp, 2, objv,
   1140  1.1  lukem 				   "command ?errorCode-list?");
   1141  1.1  lukem 	    return TCL_ERROR;
   1142  1.1  lukem 	}
   1143  1.1  lukem 	if (objc == 2) {
   1144  1.1  lukem 	    if (!ldaptcl->trapCmdObj)
   1145  1.1  lukem 		return TCL_OK;
   1146  1.1  lukem 	    resultObj = Tcl_NewListObj(0, NULL);
   1147  1.1  lukem 	    Tcl_ListObjAppendElement(interp, resultObj, ldaptcl->trapCmdObj);
   1148  1.1  lukem 	    if (ldaptcl->traplist) {
   1149  1.1  lukem 		listObj = Tcl_NewObj();
   1150  1.1  lukem 		for (p = ldaptcl->traplist; *p; p++) {
   1151  1.1  lukem 		    Tcl_ListObjAppendElement(interp, listObj,
   1152  1.1  lukem 			Tcl_NewStringObj(ldaptclerrorcode[*p], -1));
   1153  1.1  lukem 		}
   1154  1.1  lukem 		Tcl_ListObjAppendElement(interp, resultObj, listObj);
   1155  1.1  lukem 	    }
   1156  1.1  lukem 	    Tcl_SetObjResult(interp, resultObj);
   1157  1.1  lukem 	    return TCL_OK;
   1158  1.1  lukem 	}
   1159  1.1  lukem 	if (ldaptcl->trapCmdObj) {
   1160  1.1  lukem 	    Tcl_DecrRefCount (ldaptcl->trapCmdObj);
   1161  1.1  lukem 	    ldaptcl->trapCmdObj = NULL;
   1162  1.1  lukem 	}
   1163  1.1  lukem 	if (ldaptcl->traplist) {
   1164  1.1  lukem 	    free(ldaptcl->traplist);
   1165  1.1  lukem 	    ldaptcl->traplist = NULL;
   1166  1.1  lukem 	}
   1167  1.1  lukem 	Tcl_GetStringFromObj(objv[2], &l);
   1168  1.1  lukem 	if (l == 0)
   1169  1.1  lukem 	    return TCL_OK;		/* just turn off trap */
   1170  1.1  lukem 	ldaptcl->trapCmdObj = objv[2];
   1171  1.1  lukem 	Tcl_IncrRefCount (ldaptcl->trapCmdObj);
   1172  1.1  lukem 	if (objc < 4)
   1173  1.1  lukem 	    return TCL_OK;		/* no code list */
   1174  1.1  lukem 	if (Tcl_ListObjLength(interp, objv[3], &l) != TCL_OK)
   1175  1.1  lukem 	    return TCL_ERROR;
   1176  1.1  lukem 	if (l == 0)
   1177  1.1  lukem 	    return TCL_OK;		/* empty code list */
   1178  1.1  lukem 	ldaptcl->traplist = (int*)malloc(sizeof(int) * (l + 1));
   1179  1.1  lukem 	ldaptcl->traplist[l] = 0;
   1180  1.1  lukem 	for (i = 0; i < l; i++) {
   1181  1.1  lukem 	    Tcl_ListObjIndex(interp, objv[3], i, &resultObj);
   1182  1.1  lukem 	    code = LDAP_ErrorStringToCode(interp, Tcl_GetStringFromObj(resultObj, NULL));
   1183  1.1  lukem 	    if (code == -1) {
   1184  1.1  lukem 		free(ldaptcl->traplist);
   1185  1.1  lukem 		ldaptcl->traplist = NULL;
   1186  1.1  lukem 		return TCL_ERROR;
   1187  1.1  lukem 	    }
   1188  1.1  lukem 	    ldaptcl->traplist[i] = code;
   1189  1.1  lukem 	}
   1190  1.1  lukem 	return TCL_OK;
   1191  1.1  lukem     }
   1192  1.1  lukem     if (STREQU (subCommand, "trapcodes")) {
   1193  1.1  lukem 	int code;
   1194  1.1  lukem 	Tcl_Obj *resultObj;
   1195  1.1  lukem 	Tcl_Obj *stringObj;
   1196  1.1  lukem 	resultObj = Tcl_GetObjResult(interp);
   1197  1.1  lukem 
   1198  1.1  lukem 	for (code = 0; code < LDAPTCL_MAXERR; code++) {
   1199  1.1  lukem 	    if (!ldaptclerrorcode[code]) continue;
   1200  1.1  lukem 	    Tcl_ListObjAppendElement(interp, resultObj,
   1201  1.1  lukem 			Tcl_NewStringObj(ldaptclerrorcode[code], -1));
   1202  1.1  lukem 	}
   1203  1.1  lukem 	return TCL_OK;
   1204  1.1  lukem     }
   1205  1.1  lukem #ifdef LDAP_DEBUG
   1206  1.1  lukem     if (STREQU (subCommand, "debug")) {
   1207  1.1  lukem 	if (objc != 3) {
   1208  1.1  lukem 	    Tcl_AppendStringsToObj(resultObj, "Wrong # of arguments",
   1209  1.1  lukem 		(char*)NULL);
   1210  1.1  lukem 	    return TCL_ERROR;
   1211  1.1  lukem 	}
   1212  1.1  lukem 	return Tcl_GetIntFromObj(interp, objv[2], &ldap_debug);
   1213  1.1  lukem     }
   1214  1.1  lukem #endif
   1215  1.1  lukem 
   1216  1.1  lukem     /* FIX: this needs to enumerate all the possibilities */
   1217  1.1  lukem     Tcl_AppendStringsToObj (resultObj,
   1218  1.1  lukem 	                    "subcommand \"",
   1219  1.1  lukem 			    subCommand,
   1220  1.1  lukem 			    "\" must be one of \"add\", ",
   1221  1.1  lukem 			    "\"add_attributes\", ",
   1222  1.1  lukem 			    "\"bind\", \"cache\", \"delete\", ",
   1223  1.1  lukem 			    "\"delete_attributes\", \"modify\", ",
   1224  1.1  lukem 			    "\"modify_rdn\", \"rename_rdn\", ",
   1225  1.1  lukem 			    "\"replace_attributes\", ",
   1226  1.1  lukem 			    "\"search\" or \"unbind\".",
   1227  1.1  lukem 	                    (char *)NULL);
   1228  1.1  lukem     return TCL_ERROR;
   1229  1.1  lukem }
   1230  1.1  lukem 
   1231  1.1  lukem /*
   1232  1.1  lukem  * Delete and LDAP command object
   1233  1.1  lukem  *
   1234  1.1  lukem  */
   1235  1.1  lukem static void
   1236  1.1  lukem NeoX_LdapObjDeleteCmd(clientData)
   1237  1.1  lukem     ClientData    clientData;
   1238  1.1  lukem {
   1239  1.1  lukem     LDAPTCL      *ldaptcl = (LDAPTCL *)clientData;
   1240  1.1  lukem     LDAP         *ldap = ldaptcl->ldap;
   1241  1.1  lukem 
   1242  1.1  lukem     if (ldaptcl->trapCmdObj)
   1243  1.1  lukem 	Tcl_DecrRefCount (ldaptcl->trapCmdObj);
   1244  1.1  lukem     if (ldaptcl->traplist)
   1245  1.1  lukem 	free(ldaptcl->traplist);
   1246  1.1  lukem     ldap_unbind(ldap);
   1247  1.1  lukem     free((char*) ldaptcl);
   1248  1.1  lukem }
   1249  1.1  lukem 
   1250  1.1  lukem /*-----------------------------------------------------------------------------
   1251  1.1  lukem  * NeoX_LdapObjCmd --
   1252  1.1  lukem  *
   1253  1.1  lukem  * Implements the `ldap' command:
   1254  1.1  lukem  *    ldap open newObjName host [port]
   1255  1.1  lukem  *    ldap init newObjName host [port]
   1256  1.1  lukem  *
   1257  1.1  lukem  * Results:
   1258  1.1  lukem  *      A standard Tcl result.
   1259  1.1  lukem  *
   1260  1.1  lukem  * Side effects:
   1261  1.1  lukem  *      See the user documentation.
   1262  1.1  lukem  *-----------------------------------------------------------------------------
   1263  1.1  lukem  */
   1264  1.1  lukem static int
   1265  1.1  lukem NeoX_LdapObjCmd (clientData, interp, objc, objv)
   1266  1.1  lukem     ClientData    clientData;
   1267  1.1  lukem     Tcl_Interp   *interp;
   1268  1.1  lukem     int           objc;
   1269  1.1  lukem     Tcl_Obj      *CONST objv[];
   1270  1.1  lukem {
   1271  1.1  lukem     extern int    errno;
   1272  1.1  lukem     char         *subCommand;
   1273  1.1  lukem     char         *newCommand;
   1274  1.1  lukem     char         *ldapHost;
   1275  1.1  lukem     int           ldapPort = LDAP_PORT;
   1276  1.1  lukem     LDAP         *ldap;
   1277  1.1  lukem     LDAPTCL	 *ldaptcl;
   1278  1.1  lukem 
   1279  1.1  lukem     Tcl_Obj      *resultObj = Tcl_GetObjResult (interp);
   1280  1.1  lukem 
   1281  1.1  lukem     if (objc < 3) {
   1282  1.1  lukem 	Tcl_WrongNumArgs (interp, 1, objv,
   1283  1.1  lukem 			       "(open|init) new_command host [port]|explode dn");
   1284  1.1  lukem 	return TCL_ERROR;
   1285  1.1  lukem     }
   1286  1.1  lukem 
   1287  1.1  lukem     subCommand = Tcl_GetStringFromObj (objv[1], NULL);
   1288  1.1  lukem 
   1289  1.1  lukem     if (STREQU(subCommand, "explode")) {
   1290  1.1  lukem 	char *param;
   1291  1.1  lukem 	int nonames = 0;
   1292  1.1  lukem 	int list = 0;
   1293  1.1  lukem 	char **exploded, **p;
   1294  1.1  lukem 
   1295  1.1  lukem 	param = Tcl_GetStringFromObj (objv[2], NULL);
   1296  1.1  lukem 	if (param[0] == '-') {
   1297  1.1  lukem 	    if (STREQU(param, "-nonames")) {
   1298  1.1  lukem 		nonames = 1;
   1299  1.1  lukem 	    } else if (STREQU(param, "-list")) {
   1300  1.1  lukem 		list = 1;
   1301  1.1  lukem 	    } else {
   1302  1.1  lukem 		Tcl_WrongNumArgs (interp, 1, objv, "explode ?-nonames|-list? dn");
   1303  1.1  lukem 		return TCL_ERROR;
   1304  1.1  lukem 	    }
   1305  1.1  lukem 	}
   1306  1.1  lukem 	if (nonames || list)
   1307  1.1  lukem 	    param = Tcl_GetStringFromObj (objv[3], NULL);
   1308  1.1  lukem 	exploded = ldap_explode_dn(param, nonames);
   1309  1.1  lukem 	for (p = exploded; *p; p++) {
   1310  1.1  lukem 	    if (list) {
   1311  1.1  lukem 		char *q = strchr(*p, '=');
   1312  1.1  lukem 		if (!q) {
   1313  1.1  lukem 		    Tcl_SetObjLength(resultObj, 0);
   1314  1.1  lukem 		    Tcl_AppendStringsToObj(resultObj, "rdn ", *p,
   1315  1.1  lukem 			" missing '='", NULL);
   1316  1.1  lukem 		    ldap_value_free(exploded);
   1317  1.1  lukem 		    return TCL_ERROR;
   1318  1.1  lukem 		}
   1319  1.1  lukem 		*q = '\0';
   1320  1.1  lukem 		if (Tcl_ListObjAppendElement(interp, resultObj,
   1321  1.1  lukem 			Tcl_NewStringObj(*p, -1)) != TCL_OK ||
   1322  1.1  lukem 			Tcl_ListObjAppendElement(interp, resultObj,
   1323  1.1  lukem 			Tcl_NewStringObj(q+1, -1)) != TCL_OK) {
   1324  1.1  lukem 		    ldap_value_free(exploded);
   1325  1.1  lukem 		    return TCL_ERROR;
   1326  1.1  lukem 		}
   1327  1.1  lukem 	    } else {
   1328  1.1  lukem 		if (Tcl_ListObjAppendElement(interp, resultObj,
   1329  1.1  lukem 			Tcl_NewStringObj(*p, -1))) {
   1330  1.1  lukem 		    ldap_value_free(exploded);
   1331  1.1  lukem 		    return TCL_ERROR;
   1332  1.1  lukem 		}
   1333  1.1  lukem 	    }
   1334  1.1  lukem 	}
   1335  1.1  lukem 	ldap_value_free(exploded);
   1336  1.1  lukem 	return TCL_OK;
   1337  1.1  lukem     }
   1338  1.1  lukem 
   1339  1.1  lukem #ifdef UMICH_LDAP
   1340  1.1  lukem     if (STREQU(subCommand, "friendly")) {
   1341  1.1  lukem 	char *friendly = ldap_dn2ufn(Tcl_GetStringFromObj(objv[2], NULL));
   1342  1.1  lukem 	Tcl_SetStringObj(resultObj, friendly, -1);
   1343  1.1  lukem 	free(friendly);
   1344  1.1  lukem 	return TCL_OK;
   1345  1.1  lukem     }
   1346  1.1  lukem #endif
   1347  1.1  lukem 
   1348  1.1  lukem     newCommand = Tcl_GetStringFromObj (objv[2], NULL);
   1349  1.1  lukem     ldapHost = Tcl_GetStringFromObj (objv[3], NULL);
   1350  1.1  lukem 
   1351  1.1  lukem     if (objc == 5) {
   1352  1.1  lukem 	if (Tcl_GetIntFromObj (interp, objv [4], &ldapPort) == TCL_ERROR) {
   1353  1.1  lukem 	    Tcl_AppendStringsToObj (resultObj,
   1354  1.1  lukem 				    "LDAP port number is non-numeric",
   1355  1.1  lukem 				    (char *)NULL);
   1356  1.1  lukem             return TCL_ERROR;
   1357  1.1  lukem 	}
   1358  1.1  lukem     }
   1359  1.1  lukem 
   1360  1.1  lukem     if (STREQU (subCommand, "open")) {
   1361  1.1  lukem 	ldap = ldap_open (ldapHost, ldapPort);
   1362  1.1  lukem     } else if (STREQU (subCommand, "init")) {
   1363  1.1  lukem 	int version = -1;
   1364  1.1  lukem 	int i;
   1365  1.1  lukem 	int value;
   1366  1.1  lukem 	char *subOption;
   1367  1.1  lukem 	char *subValue;
   1368  1.1  lukem 
   1369  1.1  lukem #if LDAPTCL_PROTOCOL_VERSION_DEFAULT
   1370  1.1  lukem 	version = LDAPTCL_PROTOCOL_VERSION_DEFAULT;
   1371  1.1  lukem #endif
   1372  1.1  lukem 
   1373  1.1  lukem 	for (i = 6; i < objc; i += 2)  {
   1374  1.1  lukem 	    subOption =  Tcl_GetStringFromObj(objv[i-1], NULL);
   1375  1.1  lukem 	    if (STREQU (subOption, "protocol_version")) {
   1376  1.1  lukem #ifdef LDAP_OPT_PROTOCOL_VERSION
   1377  1.1  lukem 		subValue = Tcl_GetStringFromObj(objv[i], NULL);
   1378  1.1  lukem 		if (STREQU (subValue, "2")) {
   1379  1.1  lukem 		    version = LDAP_VERSION2;
   1380  1.1  lukem 		}
   1381  1.1  lukem 		else if (STREQU (subValue, "3")) {
   1382  1.1  lukem #ifdef LDAP_VERSION3
   1383  1.1  lukem 		    version = LDAP_VERSION3;
   1384  1.1  lukem #else
   1385  1.1  lukem 		    Tcl_SetStringObj (resultObj, "protocol_version 3 not supported", -1);
   1386  1.1  lukem 		    return TCL_ERROR;
   1387  1.1  lukem #endif
   1388  1.1  lukem 		}
   1389  1.1  lukem 		else {
   1390  1.1  lukem 		    Tcl_SetStringObj (resultObj, "protocol_version must be '2' or '3'", -1);
   1391  1.1  lukem 		    return TCL_ERROR;
   1392  1.1  lukem 		}
   1393  1.1  lukem #else
   1394  1.1  lukem 		Tcl_SetStringObj (resultObj, "protocol_version not supported", -1);
   1395  1.1  lukem 		return TCL_ERROR;
   1396  1.1  lukem #endif
   1397  1.1  lukem 	    } else if (STREQU (subOption, "port")) {
   1398  1.1  lukem 		if (Tcl_GetIntFromObj (interp, objv [i], &ldapPort) == TCL_ERROR) {
   1399  1.1  lukem 		    Tcl_AppendStringsToObj (resultObj,
   1400  1.1  lukem 					    "LDAP port number is non-numeric",
   1401  1.1  lukem 					    (char *)NULL);
   1402  1.1  lukem 		    return TCL_ERROR;
   1403  1.1  lukem 		}
   1404  1.1  lukem 	    } else {
   1405  1.1  lukem 		Tcl_SetStringObj (resultObj, "valid options: protocol_version, port", -1);
   1406  1.1  lukem 		return TCL_ERROR;
   1407  1.1  lukem 	    }
   1408  1.1  lukem 	}
   1409  1.1  lukem 	ldap = ldap_init (ldapHost, ldapPort);
   1410  1.1  lukem 
   1411  1.1  lukem #ifdef LDAP_OPT_PROTOCOL_VERSION
   1412  1.1  lukem 	if (version != -1)
   1413  1.1  lukem 	    ldap_set_option(ldap, LDAP_OPT_PROTOCOL_VERSION, &version);
   1414  1.1  lukem #endif
   1415  1.1  lukem     } else {
   1416  1.1  lukem 	Tcl_AppendStringsToObj (resultObj,
   1417  1.1  lukem 				"option was not \"open\" or \"init\"");
   1418  1.1  lukem 	return TCL_ERROR;
   1419  1.1  lukem     }
   1420  1.1  lukem 
   1421  1.1  lukem     if (ldap == (LDAP *)NULL) {
   1422  1.1  lukem 	Tcl_SetErrno(errno);
   1423  1.1  lukem 	Tcl_AppendStringsToObj (resultObj,
   1424  1.1  lukem 				Tcl_PosixError (interp),
   1425  1.1  lukem 				(char *)NULL);
   1426  1.1  lukem 	return TCL_ERROR;
   1427  1.1  lukem     }
   1428  1.1  lukem 
   1429  1.1  lukem #ifdef UMICH_LDAP
   1430  1.1  lukem     ldap->ld_deref = LDAP_DEREF_NEVER;  /* Turn off alias dereferencing */
   1431  1.1  lukem #endif
   1432  1.1  lukem 
   1433  1.1  lukem     ldaptcl = (LDAPTCL *) malloc(sizeof(LDAPTCL));
   1434  1.1  lukem     ldaptcl->ldap = ldap;
   1435  1.1  lukem     ldaptcl->caching = 0;
   1436  1.1  lukem     ldaptcl->timeout = 0;
   1437  1.1  lukem     ldaptcl->maxmem = 0;
   1438  1.1  lukem     ldaptcl->trapCmdObj = NULL;
   1439  1.1  lukem     ldaptcl->traplist = NULL;
   1440  1.1  lukem     ldaptcl->flags = 0;
   1441  1.1  lukem 
   1442  1.1  lukem     Tcl_CreateObjCommand (interp,
   1443  1.1  lukem 			  newCommand,
   1444  1.1  lukem                           NeoX_LdapTargetObjCmd,
   1445  1.1  lukem                           (ClientData) ldaptcl,
   1446  1.1  lukem                           NeoX_LdapObjDeleteCmd);
   1447  1.1  lukem     return TCL_OK;
   1448  1.1  lukem }
   1449  1.1  lukem 
   1450  1.1  lukem /*-----------------------------------------------------------------------------
   1451  1.1  lukem  * Neo_initLDAP --
   1452  1.1  lukem  *     Initialize the LDAP interface.
   1453  1.1  lukem  *-----------------------------------------------------------------------------
   1454  1.1  lukem  */
   1455  1.1  lukem int
   1456  1.1  lukem Ldaptcl_Init (interp)
   1457  1.1  lukem Tcl_Interp   *interp;
   1458  1.1  lukem {
   1459  1.1  lukem     Tcl_CreateObjCommand (interp,
   1460  1.1  lukem 			  "ldap",
   1461  1.1  lukem                           NeoX_LdapObjCmd,
   1462  1.1  lukem                           (ClientData) NULL,
   1463  1.1  lukem                           (Tcl_CmdDeleteProc*) NULL);
   1464  1.1  lukem     /*
   1465  1.1  lukem     if (Neo_initLDAPX(interp) != TCL_OK)
   1466  1.1  lukem 	return TCL_ERROR;
   1467  1.1  lukem     */
   1468  1.1  lukem     Tcl_PkgProvide(interp, "Ldaptcl", VERSION);
   1469  1.1  lukem     return TCL_OK;
   1470  1.1  lukem }
   1471