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