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