]> git.sur5r.net Git - openldap/blob - contrib/ldaptcl/neoXldap.c
In entry_decode, must null-terminate a_nvals array
[openldap] / contrib / ldaptcl / neoXldap.c
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$
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@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 #if 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 #if 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 }