git.sur5r.net Git - openldap/blob - 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  * $Id: neoXldap.c,v 1.5 1999/08/03 05:23:03 kunkee 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@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 #define ldap_memfree(p) free(p)
  80 #ifdef LDAP_OPT_ERROR_NUMBER
  81 #define ldap_get_lderrno(ld)    (ldap_get_option(ld, LDAP_OPT_ERROR_NUMBER, &lderrno), lderrno)
  82 #else
  83 #define ldap_get_lderrno(ld) (ld->ld_errno)
  84 #endif
  85 #define LDAP_ERR_STRING(ld)  \
  86         ldap_err2string(ldap_get_lderrno(ld))
  87 #elif defined( LDAP_OPT_SIZELIMIT )
  88        /*
  89        ** Netscape SDK w/ ldap_set_option, ldap_get_option
  90        */
  91 #define LDAP_ERR_STRING(ld)  \
  92         ldap_err2string(ldap_get_lderrno(ldap))
  93 #else
  94        /* U-Mich/OpenLDAP 1.x API */
  95        /* RFC-1823 w/ changes */
  96 #define UMICH_LDAP 1
  97 #define ldap_memfree(p) free(p)
  98 #define ldap_ber_free(p, n) ber_free(p, n)
  99 #define ldap_value_free_len(bvals) ber_bvecfree(bvals)
 100 #define ldap_get_lderrno(ld) (ld->ld_errno)
 101 #define LDAP_ERR_STRING(ld)  \
 102         ldap_err2string(ld->ld_errno)
 103 #endif
 104
 105 typedef struct ldaptclobj {
 106     LDAP        *ldap;
 107     int         caching;        /* flag 1/0 if caching is enabled */
 108     long        timeout;        /* timeout from last cache enable */
 109     long        maxmem;         /* maxmem from last cache enable */
 110     Tcl_Obj     *trapCmdObj;    /* error handler */
 111     int         *traplist;      /* list of errorCodes to trap */
 112     int         flags;
 113 } LDAPTCL;
 114
 115
 116 #define LDAPTCL_INTERRCODES     0x001
 117
 118 #include "ldaptclerr.h"
 119
 120 static
 121 LDAP_SetErrorCode(LDAPTCL *ldaptcl, int code, Tcl_Interp *interp)
 122 {
 123     char shortbuf[16];
 124     char *errp;
 125     int   lderrno;
 126
 127     if (code == -1)
 128         code = ldap_get_lderrno(ldaptcl->ldap);
 129     if ((ldaptcl->flags & LDAPTCL_INTERRCODES) || code > LDAPTCL_MAXERR ||
 130       ldaptclerrorcode[code] == NULL) {
 131         sprintf(shortbuf, "0x%03x", code);
 132         errp = shortbuf;
 133     } else
 134         errp = ldaptclerrorcode[code];
 135
 136     Tcl_SetErrorCode(interp, errp, NULL);
 137     if (ldaptcl->trapCmdObj) {
 138         int *i;
 139         Tcl_Obj *cmdObj;
 140         if (ldaptcl->traplist != NULL) {
 141             for (i = ldaptcl->traplist; *i && *i != code; i++)
 142                 ;
 143             if (*i == 0) return;
 144         }
 145         (void) Tcl_EvalObj(interp, ldaptcl->trapCmdObj);
 146     }
 147 }
 148
 149 static
 150 LDAP_ErrorStringToCode(Tcl_Interp *interp, char *s)
 151 {
 152     int offset;
 153     int code;
 154
 155     offset = (strncasecmp(s, "LDAP_", 5) == 0) ? 0 : 5;
 156     for (code = 0; code < LDAPTCL_MAXERR; code++) {
 157         if (!ldaptclerrorcode[code]) continue;
 158         if (strcasecmp(s, ldaptclerrorcode[code]+offset) == 0)
 159             return code;
 160     }
 161     Tcl_ResetResult(interp);
 162     Tcl_AppendResult(interp, s, " is an invalid code", (char *) NULL);
 163     return -1;
 164 }
 165
 166 /*-----------------------------------------------------------------------------
 167  * LDAP_ProcessOneSearchResult --
 168  *
 169  *   Process one result return from an LDAP search.
 170  *
 171  * Paramaters:
 172  *   o interp -            Tcl interpreter; Errors are returned in result.
 173  *   o ldap -              LDAP structure pointer.
 174  *   o entry -             LDAP message pointer.
 175  *   o destArrayNameObj -  Name of Tcl array in which to store attributes.
 176  *   o evalCodeObj -       Tcl_Obj pointer to code to eval against this result.
 177  * Returns:
 178  *   o TCL_OK if processing succeeded..
 179  *   o TCL_ERROR if an error occured, with error message in interp.
 180  *-----------------------------------------------------------------------------
 181  */
 182 int
 183 LDAP_ProcessOneSearchResult (interp, ldap, entry, destArrayNameObj, evalCodeObj)
 184     Tcl_Interp     *interp;
 185     LDAP           *ldap;
 186     LDAPMessage    *entry;
 187     Tcl_Obj        *destArrayNameObj;
 188     Tcl_Obj        *evalCodeObj;
 189 {
 190     char           *attributeName;
 191     Tcl_Obj        *attributeNameObj;
 192     Tcl_Obj        *attributeDataObj;
 193     int             i;
 194     BerElement     *ber;
 195     struct berval **bvals;
 196     char           *dn;
 197     int             lderrno;
 198
 199     Tcl_UnsetVar (interp, Tcl_GetStringFromObj (destArrayNameObj, NULL), 0);
 200
 201     dn = ldap_get_dn(ldap, entry);
 202     if (dn != NULL) {
 203         if (Tcl_SetVar2(interp,         /* set dn */
 204                        Tcl_GetStringFromObj(destArrayNameObj, NULL),
 205                        "dn",
 206                        dn,
 207                        TCL_LEAVE_ERR_MSG) == NULL)
 208             return TCL_ERROR;
 209         ldap_memfree(dn);
 210     }
 211     attributeNameObj = Tcl_NewObj();
 212     Tcl_IncrRefCount (attributeNameObj);
 213     for (attributeName = ldap_first_attribute (ldap, entry, &ber);
 214       attributeName != NULL;
 215       attributeName = ldap_next_attribute(ldap, entry, ber)) {
 216
 217         bvals = ldap_get_values_len(ldap, entry, attributeName);
 218
 219         if (bvals != NULL) {
 220             /* Note here that the U.of.M. ldap will return a null bvals
 221                when the last attribute value has been deleted, but still
 222                retains the attributeName.  Even though this is documented
 223                as an error, we ignore it to present a consistent interface
 224                with Netscape's server
 225             */
 226             attributeDataObj = Tcl_NewObj();
 227             Tcl_SetStringObj(attributeNameObj, attributeName, -1);
 228             for (i = 0; bvals[i] != NULL; i++) {
 229                 Tcl_Obj *singleAttributeValueObj;
 230
 231                 singleAttributeValueObj = Tcl_NewStringObj(bvals[i]->bv_val, bvals[i]->bv_len);
 232                 if (Tcl_ListObjAppendElement (interp,
 233                                               attributeDataObj,
 234                                               singleAttributeValueObj)
 235                   == TCL_ERROR) {
 236                     ber_free(ber, 0);
 237                     return TCL_ERROR;
 238                 }
 239             }
 240
 241             ldap_value_free_len(bvals);
 242
 243             if (Tcl_ObjSetVar2 (interp,
 244                                 destArrayNameObj,
 245                                 attributeNameObj,
 246                                 attributeDataObj,
 247                                 TCL_LEAVE_ERR_MSG) == NULL) {
 248                 return TCL_ERROR;
 249             }
 250         }
 251     }
 252     Tcl_DecrRefCount (attributeNameObj);
 253     return Tcl_EvalObj (interp, evalCodeObj);
 254 }
 255
 256 /*-----------------------------------------------------------------------------
 257  * LDAP_PerformSearch --
 258  *
 259  *   Perform an LDAP search.
 260  *
 261  * Paramaters:
 262  *   o interp -            Tcl interpreter; Errors are returned in result.
 263  *   o ldap -              LDAP structure pointer.
 264  *   o base -              Base DN from which to perform search.
 265  *   o scope -             LDAP search scope, must be one of LDAP_SCOPE_BASE,
 266  *                         LDAP_SCOPE_ONELEVEL, or LDAP_SCOPE_SUBTREE.
 267  *   o attrs -             Pointer to array of char * pointers of desired
 268  *                         attribute names, or NULL for all attributes.
 269  *   o filtpatt            LDAP filter pattern.
 270  *   o value               Value to get sprintf'ed into filter pattern.
 271  *   o destArrayNameObj -  Name of Tcl array in which to store attributes.
 272  *   o evalCodeObj -       Tcl_Obj pointer to code to eval against this result.
 273  * Returns:
 274  *   o TCL_OK if processing succeeded..
 275  *   o TCL_ERROR if an error occured, with error message in interp.
 276  *-----------------------------------------------------------------------------
 277  */
 278 int
 279 LDAP_PerformSearch (interp, ldaptcl, base, scope, attrs, filtpatt, value,
 280         destArrayNameObj, evalCodeObj, timeout_p, all, sortattr)
 281     Tcl_Interp     *interp;
 282     LDAPTCL        *ldaptcl;
 283     char           *base;
 284     int             scope;
 285     char          **attrs;
 286     char           *filtpatt;
 287     char           *value;
 288     Tcl_Obj        *destArrayNameObj;
 289     Tcl_Obj        *evalCodeObj;
 290     struct timeval *timeout_p;
 291     int             all;
 292     char           *sortattr;
 293 {
 294     LDAP         *ldap = ldaptcl->ldap;
 295     char          filter[BUFSIZ];
 296     int           resultCode;
 297     int           errorCode;
 298     int           abandon;
 299     int           tclResult = TCL_OK;
 300     int           msgid;
 301     LDAPMessage  *resultMessage = 0;
 302     LDAPMessage  *entryMessage = 0;
 303     char          *sortKey;
 304
 305     int           lderrno;
 306
 307     sprintf(filter, filtpatt, value);
 308
 309     fflush(stderr);
 310     if ((msgid = ldap_search (ldap, base, scope, filter, attrs, 0)) == -1) {
 311         Tcl_AppendResult (interp,
 312                                 "LDAP start search error: ",
 313                                         LDAP_ERR_STRING(ldap),
 314                                 (char *)NULL);
 315         LDAP_SetErrorCode(ldaptcl, -1, interp);
 316         return TCL_ERROR;
 317     }
 318
 319     abandon = 0;
 320     if (sortattr)
 321         all = 1;
 322     tclResult = TCL_OK;
 323     while (!abandon) {
 324         resultCode = ldap_result (ldap, msgid, all, timeout_p, &resultMessage);
 325         if (resultCode != LDAP_RES_SEARCH_RESULT &&
 326             resultCode != LDAP_RES_SEARCH_ENTRY)
 327                 break;
 328
 329         if (sortattr) {
 330             sortKey = (strcasecmp(sortattr, "dn") == 0) ? NULL : sortattr;
 331             ldap_sort_entries(ldap, &resultMessage, sortKey, strcasecmp);
 332         }
 333         entryMessage = ldap_first_entry(ldap, resultMessage);
 334
 335         while (entryMessage) {
 336             tclResult = LDAP_ProcessOneSearchResult  (interp,
 337                                     ldap,
 338                                     entryMessage,
 339                                     destArrayNameObj,
 340                                     evalCodeObj);
 341             if (tclResult != TCL_OK) {
 342                 if (tclResult == TCL_CONTINUE) {
 343                     tclResult = TCL_OK;
 344                 } else if (tclResult == TCL_BREAK) {
 345                     tclResult = TCL_OK;
 346                     abandon = 1;
 347                     break;
 348                 } else if (tclResult == TCL_ERROR) {
 349                     char msg[100];
 350                     sprintf(msg, "\n    (\"search\" body line %d)",
 351                             interp->errorLine);
 352                     Tcl_AddObjErrorInfo(interp, msg, -1);
 353                     abandon = 1;
 354                     break;
 355                 } else {
 356                     abandon = 1;
 357                     break;
 358                 }
 359             }
 360             entryMessage = ldap_next_entry(ldap, entryMessage);
 361         }
 362         if (resultCode == LDAP_RES_SEARCH_RESULT || all)
 363             break;
 364         if (resultMessage)
 365         ldap_msgfree(resultMessage);
 366         resultMessage = NULL;
 367     }
 368     if (abandon) {
 369         if (resultMessage)
 370             ldap_msgfree(resultMessage);
 371         if (resultCode == LDAP_RES_SEARCH_ENTRY)
 372             ldap_abandon(ldap, msgid);
 373         return tclResult;
 374     }
 375     if (resultCode == -1) {
 376         Tcl_ResetResult (interp);
 377         Tcl_AppendResult (interp,
 378                                 "LDAP result search error: ",
 379                                 LDAP_ERR_STRING(ldap),
 380                                 (char *)NULL);
 381         LDAP_SetErrorCode(ldaptcl, -1, interp);
 382         return TCL_ERROR;
 383     }
 384
 385     if ((errorCode = ldap_result2error (ldap, resultMessage, 0))
 386       != LDAP_SUCCESS) {
 387       Tcl_ResetResult (interp);
 388       Tcl_AppendResult (interp,
 389                               "LDAP search error: ",
 390                               ldap_err2string(errorCode),
 391                               (char *)NULL);
 392       if (resultMessage)
 393           ldap_msgfree(resultMessage);
 394       LDAP_SetErrorCode(ldaptcl, errorCode, interp);
 395       return TCL_ERROR;
 396     }
 397     if (resultMessage)
 398         ldap_msgfree(resultMessage);
 399     return tclResult;
 400 }
 401
 402 /*-----------------------------------------------------------------------------
 403  * NeoX_LdapTargetObjCmd --
 404  *
 405  * Implements the body of commands created by Neo_LdapObjCmd.
 406  *
 407  * Results:
 408  *      A standard Tcl result.
 409  *
 410  * Side effects:
 411  *      See the user documentation.
 412  *-----------------------------------------------------------------------------
 413  */
 414 int
 415 NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
 416     ClientData    clientData;
 417     Tcl_Interp   *interp;
 418     int           objc;
 419     Tcl_Obj      *CONST objv[];
 420 {
 421     char         *command;
 422     char         *subCommand;
 423     LDAPTCL      *ldaptcl = (LDAPTCL *)clientData;
 424     LDAP         *ldap = ldaptcl->ldap;
 425     char         *dn;
 426     int           is_add = 0;
 427     int           is_add_or_modify = 0;
 428     int           mod_op = 0;
 429     char         *m, *s, *errmsg;
 430     int          errcode;
 431     int          tclResult;
 432
 433     Tcl_Obj      *resultObj = Tcl_GetObjResult (interp);
 434
 435     if (objc < 2)
 436        return TclX_WrongArgs (interp,
 437                               objv [0],
 438                               "subcommand [args...]");
 439
 440     command = Tcl_GetStringFromObj (objv[0], NULL);
 441     subCommand = Tcl_GetStringFromObj (objv[1], NULL);
 442
 443     /* object bind authtype name password */
 444     if (STREQU (subCommand, "bind")) {
 445         char     *binddn;
 446         char     *passwd;
 447         int       stringLength;
 448         char     *ldap_authString;
 449         int       ldap_authInt;
 450
 451         if (objc != 5)
 452             return TclX_WrongArgs (interp, objv [0], "bind authtype dn passwd");
 453
 454         ldap_authString = Tcl_GetStringFromObj (objv[2], NULL);
 455
 456         if (STREQU (ldap_authString, "simple")) {
 457             ldap_authInt = LDAP_AUTH_SIMPLE;
 458         }
 459 #ifdef UMICH_LDAP
 460         else if (STREQU (ldap_authString, "kerberos_ldap")) {
 461             ldap_authInt = LDAP_AUTH_KRBV41;
 462         } else if (STREQU (ldap_authString, "kerberos_dsa")) {
 463             ldap_authInt = LDAP_AUTH_KRBV42;
 464         } else if (STREQU (ldap_authString, "kerberos_both")) {
 465             ldap_authInt = LDAP_AUTH_KRBV4;
 466         }
 467 #endif
 468         else {
 469             Tcl_AppendStringsToObj (resultObj,
 470                                     "\"",
 471                                     command,
 472                                     " ",
 473                                     subCommand,
 474 #ifdef UMICH_LDAP
 475                                     "\" authtype must be one of \"simple\", ",
 476                                     "\"kerberos_ldap\", \"kerberos_dsa\" ",
 477                                     "or \"kerberos_both\"",
 478 #else
 479                                     "\" authtype must be \"simple\", ",
 480 #endif
 481                                     (char *)NULL);
 482             return TCL_ERROR;
 483         }
 484
 485         binddn = Tcl_GetStringFromObj (objv[3], &stringLength);
 486         if (stringLength == 0)
 487             binddn = NULL;
 488
 489         passwd = Tcl_GetStringFromObj (objv[4], &stringLength);
 490         if (stringLength == 0)
 491             passwd = NULL;
 492
 493 /*  ldap_bind_s(ldap, dn, pw, method) */
 494
 495 #ifdef UMICH_LDAP
 496 #define LDAP_BIND(ldap, dn, pw, method) \
 497   ldap_bind_s(ldap, dn, pw, method)
 498 #else
 499 #define LDAP_BIND(ldap, dn, pw, method) \
 500   ldap_simple_bind_s(ldap, dn, pw)
 501 #endif
 502         if ((errcode = LDAP_BIND (ldap,
 503                          binddn,
 504                          passwd,
 505                          ldap_authInt)) != LDAP_SUCCESS) {
 506
 507             Tcl_AppendStringsToObj (resultObj,
 508                                     "LDAP bind error: ",
 509                                     ldap_err2string(errcode),
 510                                     (char *)NULL);
 511             LDAP_SetErrorCode(ldaptcl, errcode, interp);
 512             return TCL_ERROR;
 513         }
 514         return TCL_OK;
 515     }
 516
 517     if (STREQU (subCommand, "unbind")) {
 518         if (objc != 2)
 519             return TclX_WrongArgs (interp, objv [0], "unbind");
 520
 521        return Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], NULL));
 522     }
 523
 524     /* object delete dn */
 525     if (STREQU (subCommand, "delete")) {
 526         if (objc != 3)
 527             return TclX_WrongArgs (interp, objv [0], "delete dn");
 528
 529        dn = Tcl_GetStringFromObj (objv [2], NULL);
 530        if ((errcode = ldap_delete_s(ldap, dn)) != LDAP_SUCCESS) {
 531            Tcl_AppendStringsToObj (resultObj,
 532                                    "LDAP delete error: ",
 533                                    ldap_err2string(errcode),
 534                                    (char *)NULL);
 535            LDAP_SetErrorCode(ldaptcl, errcode, interp);
 536            return TCL_ERROR;
 537        }
 538        return TCL_OK;
 539     }
 540
 541     /* object rename_rdn dn rdn */
 542     /* object modify_rdn dn rdn */
 543     if (STREQU (subCommand, "rename_rdn") || STREQU (subCommand, "modify_rdn")) {
 544         char    *rdn;
 545         int      deleteOldRdn;
 546
 547         if (objc != 4)
 548             return TclX_WrongArgs (interp,
 549                                    objv [0],
 550                                    "delete_rdn|modify_rdn dn rdn");
 551
 552         dn = Tcl_GetStringFromObj (objv [2], NULL);
 553         rdn = Tcl_GetStringFromObj (objv [3], NULL);
 554
 555         deleteOldRdn = (*subCommand == 'r');
 556
 557         if ((errcode = ldap_modrdn2_s (ldap, dn, rdn, deleteOldRdn)) != LDAP_SUCCESS) {
 558             Tcl_AppendStringsToObj (resultObj,
 559                                     "LDAP ",
 560                                     subCommand,
 561                                     " error: ",
 562                                     ldap_err2string(errcode),
 563                                     (char *)NULL);
 564             LDAP_SetErrorCode(ldaptcl, errcode, interp);
 565             return TCL_ERROR;
 566         }
 567         return TCL_OK;
 568     }
 569
 570     /* object add dn attributePairList */
 571     /* object add_attributes dn attributePairList */
 572     /* object replace_attributes dn attributePairList */
 573     /* object delete_attributes dn attributePairList */
 574
 575     if (STREQU (subCommand, "add")) {
 576         is_add = 1;
 577         is_add_or_modify = 1;
 578     } else {
 579         is_add = 0;
 580         if (STREQU (subCommand, "add_attributes")) {
 581             is_add_or_modify = 1;
 582             mod_op = LDAP_MOD_ADD;
 583         } else if (STREQU (subCommand, "replace_attributes")) {
 584             is_add_or_modify = 1;
 585             mod_op = LDAP_MOD_REPLACE;
 586         } else if (STREQU (subCommand, "delete_attributes")) {
 587             is_add_or_modify = 1;
 588             mod_op = LDAP_MOD_DELETE;
 589         }
 590     }
 591
 592     if (is_add_or_modify) {
 593         int          result;
 594         LDAPMod    **modArray;
 595         LDAPMod     *mod;
 596         char       **valPtrs = NULL;
 597         int          attribObjc;
 598         Tcl_Obj    **attribObjv;
 599         int          valuesObjc;
 600         Tcl_Obj    **valuesObjv;
 601         int          nPairs;
 602         int          i;
 603         int          j;
 604
 605         Tcl_Obj      *resultObj = Tcl_GetObjResult (interp);
 606
 607         if (objc != 4) {
 608             Tcl_AppendStringsToObj (resultObj,
 609                                     "wrong # args: ",
 610                                     Tcl_GetStringFromObj (objv [0], NULL),
 611                                     " ",
 612                                     subCommand,
 613                                     " dn attributePairList",
 614                                     (char *)NULL);
 615             return TCL_ERROR;
 616         }
 617
 618         dn = Tcl_GetStringFromObj (objv [2], NULL);
 619
 620         if (Tcl_ListObjGetElements (interp, objv [3], &attribObjc, &attribObjv)
 621           == TCL_ERROR) {
 622            return TCL_ERROR;
 623         }
 624
 625         if (attribObjc & 1) {
 626             Tcl_AppendStringsToObj (resultObj,
 627                                     "attribute list does not contain an ",
 628                                     "even number of key-value elements",
 629                                     (char *)NULL);
 630             return TCL_ERROR;
 631         }
 632
 633         nPairs = attribObjc / 2;
 634
 635         modArray = (LDAPMod **)malloc (sizeof(LDAPMod *) * (nPairs + 1));
 636         modArray[nPairs] = (LDAPMod *) NULL;
 637
 638         for (i = 0; i < nPairs; i++) {
 639             mod = modArray[i] = (LDAPMod *) malloc (sizeof(LDAPMod));
 640             mod->mod_op = mod_op;
 641             mod->mod_type = Tcl_GetStringFromObj (attribObjv [i * 2], NULL);
 642
 643             if (Tcl_ListObjGetElements (interp, attribObjv [i * 2 + 1], &valuesObjc, &valuesObjv) == TCL_ERROR) {
 644                 /* FIX: cleanup memory here */
 645                 return TCL_ERROR;
 646             }
 647
 648             valPtrs = mod->mod_vals.modv_strvals = \
 649                 (char **)malloc (sizeof (char *) * (valuesObjc + 1));
 650             valPtrs[valuesObjc] = (char *)NULL;
 651
 652             for (j = 0; j < valuesObjc; j++) {
 653                 valPtrs [j] = Tcl_GetStringFromObj (valuesObjv[j], NULL);
 654
 655                 /* If it's "delete" and value is an empty string, make
 656                  * value be NULL to indicate entire attribute is to be
 657                  * deleted */
 658                 if ((*valPtrs [j] == '\0')
 659                     && (mod->mod_op == LDAP_MOD_DELETE || mod->mod_op == LDAP_MOD_REPLACE)) {
 660                         valPtrs [j] = NULL;
 661                 }
 662             }
 663         }
 664
 665         if (is_add) {
 666             result = ldap_add_s (ldap, dn, modArray);
 667         } else {
 668             result = ldap_modify_s (ldap, dn, modArray);
 669             if (ldaptcl->caching)
 670                 ldap_uncache_entry (ldap, dn);
 671         }
 672
 673         /* free the modArray elements, then the modArray itself. */
 674         for (i = 0; i < nPairs; i++) {
 675             free ((char *) modArray[i]->mod_vals.modv_strvals);
 676             free ((char *) modArray[i]);
 677         }
 678         free ((char *) modArray);
 679
 680         /* FIX: memory cleanup required all over the place here */
 681         if (result != LDAP_SUCCESS) {
 682             Tcl_AppendStringsToObj (resultObj,
 683                                     "LDAP ",
 684                                     subCommand,
 685                                     " error: ",
 686                                     ldap_err2string(result),
 687                                     (char *)NULL);
 688             LDAP_SetErrorCode(ldaptcl, result, interp);
 689             return TCL_ERROR;
 690         }
 691         return TCL_OK;
 692     }
 693
 694     /* object search controlArray dn pattern */
 695     if (STREQU (subCommand, "search")) {
 696         char        *controlArrayName;
 697         Tcl_Obj     *controlArrayNameObj;
 698
 699         char        *scopeString;
 700         int          scope;
 701
 702         char        *derefString;
 703         int          deref;
 704
 705         char        *baseString;
 706
 707         char       **attributesArray;
 708         char        *attributesString;
 709         int          attributesArgc;
 710
 711         char        *filterPatternString;
 712
 713         char        *timeoutString;
 714         double       timeoutTime;
 715         struct timeval timeout, *timeout_p;
 716
 717         char        *paramString;
 718         int          cacheThis = -1;
 719         int          all = 0;
 720
 721         char        *sortattr;
 722
 723         Tcl_Obj     *destArrayNameObj;
 724         Tcl_Obj     *evalCodeObj;
 725
 726         if (objc != 5)
 727             return TclX_WrongArgs (interp,
 728                                    objv [0],
 729                                    "search controlArray destArray code");
 730
 731         controlArrayNameObj = objv [2];
 732         controlArrayName = Tcl_GetStringFromObj (controlArrayNameObj, NULL);
 733
 734         destArrayNameObj = objv [3];
 735
 736         evalCodeObj = objv [4];
 737
 738         baseString = Tcl_GetVar2 (interp,
 739                                   controlArrayName,
 740                                   "base",
 741                                   0);
 742
 743         if (baseString == (char *)NULL) {
 744             Tcl_AppendStringsToObj (resultObj,
 745                                     "required element \"base\" ",
 746                                     "is missing from ldap control array \"",
 747                                     controlArrayName,
 748                                     "\"",
 749                                     (char *)NULL);
 750             return TCL_ERROR;
 751         }
 752
 753         filterPatternString = Tcl_GetVar2 (interp,
 754                                            controlArrayName,
 755                                            "filter",
 756                                            0);
 757         if (filterPatternString == (char *)NULL) {
 758             filterPatternString = "(objectclass=*)";
 759         }
 760
 761         /* Fetch scope setting from control array.
 762          * If it doesn't exist, default to subtree scoping.
 763          */
 764         scopeString = Tcl_GetVar2 (interp, controlArrayName, "scope", 0);
 765         if (scopeString == NULL) {
 766             scope = LDAP_SCOPE_SUBTREE;
 767         } else {
 768             if (STREQU(scopeString, "base"))
 769                 scope = LDAP_SCOPE_BASE;
 770             else if (STRNEQU(scopeString, "one", 3))
 771                 scope = LDAP_SCOPE_ONELEVEL;
 772             else if (STRNEQU(scopeString, "sub", 3))
 773                 scope = LDAP_SCOPE_SUBTREE;
 774             else {
 775                 Tcl_AppendStringsToObj (resultObj,
 776                                         "\"scope\" element of \"",
 777                                         controlArrayName,
 778                                         "\" array is not one of ",
 779                                         "\"base\", \"onelevel\", ",
 780                                         "or \"subtree\"",
 781                                       (char *) NULL);
 782                 return TCL_ERROR;
 783             }
 784         }
 785
 786         /* Fetch dereference control setting from control array.
 787          * If it doesn't exist, default to never dereference. */
 788         derefString = Tcl_GetVar2 (interp,
 789                                    controlArrayName,
 790                                    "deref",
 791                                    0);
 792
 793         if (derefString == (char *)NULL) {
 794             deref = LDAP_DEREF_NEVER;
 795         } else {
 796             if (STREQU(derefString, "never"))
 797                 deref = LDAP_DEREF_NEVER;
 798             else if (STREQU(derefString, "search"))
 799                 deref = LDAP_DEREF_SEARCHING;
 800             else if (STREQU(derefString, "find") == 0)
 801                 deref = LDAP_DEREF_FINDING;
 802             else if (STREQU(derefString, "always"))
 803                 deref = LDAP_DEREF_ALWAYS;
 804             else {
 805                 Tcl_AppendStringsToObj (resultObj,
 806                                         "\"deref\" element of \"",
 807                                         controlArrayName,
 808                                         "\" array is not one of ",
 809                                         "\"never\", \"search\", \"find\", ",
 810                                         "or \"always\"",
 811                                         (char *) NULL);
 812                 return TCL_ERROR;
 813             }
 814         }
 815
 816         /* Fetch list of attribute names from control array.
 817          * If entry doesn't exist, default to NULL (all).
 818          */
 819         attributesString = Tcl_GetVar2 (interp,
 820                                         controlArrayName,
 821                                         "attributes",
 822                                         0);
 823         if (attributesString == (char *)NULL) {
 824             attributesArray = NULL;
 825         } else {
 826             if ((Tcl_SplitList (interp,
 827                                 attributesString,
 828                                 &attributesArgc,
 829                                 &attributesArray)) != TCL_OK) {
 830                 return TCL_ERROR;
 831             }
 832         }
 833
 834         /* Fetch timeout value if there is one
 835          */
 836         timeoutString = Tcl_GetVar2 (interp,
 837                                         controlArrayName,
 838                                         "timeout",
 839                                         0);
 840         timeout.tv_usec = 0;
 841         if (timeoutString == (char *)NULL) {
 842             timeout_p = NULL;
 843             timeout.tv_sec = 0;
 844         } else {
 845             if (Tcl_GetDouble(interp, timeoutString, &timeoutTime) != TCL_OK)
 846                 return TCL_ERROR;
 847             timeout.tv_sec = floor(timeoutTime);
 848             timeout.tv_usec = (timeoutTime-timeout.tv_sec) * 1000000;
 849             timeout_p = &timeout;
 850         }
 851
 852         paramString = Tcl_GetVar2 (interp, controlArrayName, "cache", 0);
 853         if (paramString) {
 854             if (Tcl_GetInt(interp, paramString, &cacheThis) == TCL_ERROR)
 855                 return TCL_ERROR;
 856         }
 857
 858         paramString = Tcl_GetVar2 (interp, controlArrayName, "all", 0);
 859         if (paramString) {
 860             if (Tcl_GetInt(interp, paramString, &all) == TCL_ERROR)
 861                 return TCL_ERROR;
 862         }
 863
 864         sortattr = Tcl_GetVar2 (interp, controlArrayName, "sort", 0);
 865
 866 #ifdef UMICH_LDAP
 867         ldap->ld_deref = deref;
 868         ldap->ld_timelimit = 0;
 869         ldap->ld_sizelimit = 0;
 870         ldap->ld_options = 0;
 871 #endif
 872
 873         /* Caching control within the search: if the "cache" control array */
 874         /* value is set, disable/enable caching accordingly */
 875
 876 #if 0
 877         if (cacheThis >= 0 && ldaptcl->caching != cacheThis) {
 878             if (cacheThis) {
 879                 if (ldaptcl->timeout == 0) {
 880                     Tcl_SetStringObj(resultObj, "Caching never before enabled, I have no timeout value to use", -1);
 881                     return TCL_ERROR;
 882                 }
 883                 ldap_enable_cache(ldap, ldaptcl->timeout, ldaptcl->maxmem);
 884             }
 885             else
 886                 ldap_disable_cache(ldap);
 887         }
 888 #endif
 889         tclResult = LDAP_PerformSearch (interp,
 890                                     ldaptcl,
 891                                     baseString,
 892                                     scope,
 893                                     attributesArray,
 894                                     filterPatternString,
 895                                     "",
 896                                     destArrayNameObj,
 897                                     evalCodeObj,
 898                                     timeout_p,
 899                                     all,
 900                                     sortattr);
 901         /* Following the search, if we changed the caching behavior, change */
 902         /* it back. */
 903 #if 0
 904         if (cacheThis >= 0 && ldaptcl->caching != cacheThis) {
 905             if (cacheThis)
 906                 ldap_disable_cache(ldap);
 907             else
 908                 ldap_enable_cache(ldap, ldaptcl->timeout, ldaptcl->maxmem);
 909         }
 910 #endif
 911         return tclResult;
 912     }
 913
 914 #if defined(UMICH_LDAP) || (defined(OPEN_LDAP) && !defined(LDAP_API_VERSION))
 915     if (STREQU (subCommand, "cache")) {
 916         char *cacheCommand;
 917
 918         if (objc < 3)
 919           badargs:
 920             return TclX_WrongArgs (interp,
 921                                    objv [0],
 922                                    "cache command [args...]");
 923
 924         cacheCommand = Tcl_GetStringFromObj (objv [2], NULL);
 925
 926         if (STREQU (cacheCommand, "uncache")) {
 927             char *dn;
 928
 929             if (objc != 4)
 930                 return TclX_WrongArgs (interp,
 931                                        objv [0],
 932                                        "cache uncache dn");
 933
 934             dn = Tcl_GetStringFromObj (objv [3], NULL);
 935             ldap_uncache_entry (ldap, dn);
 936             return TCL_OK;
 937         }
 938
 939         if (STREQU (cacheCommand, "enable")) {
 940             long   timeout = ldaptcl->timeout;
 941             long   maxmem = ldaptcl->maxmem;
 942
 943             if (objc > 5)
 944                 return TclX_WrongArgs (interp,
 945                                        objv [0],
 946                                        "cache enable ?timeout? ?maxmem?");
 947
 948             if (objc > 3) {
 949                 if (Tcl_GetLongFromObj (interp, objv [3], &timeout) == TCL_ERROR)
 950                     return TCL_ERROR;
 951             }
 952             if (timeout == 0) {
 953                 Tcl_SetStringObj(resultObj,
 954                     objc > 3 ? "timeouts must be greater than 0" :
 955                     "no previous timeout to reference", -1);
 956                 return TCL_ERROR;
 957             }
 958
 959             if (objc > 4)
 960                 if (Tcl_GetLongFromObj (interp, objv [4], &maxmem) == TCL_ERROR)
 961                     return TCL_ERROR;
 962
 963             if (ldap_enable_cache (ldap, timeout, maxmem) == -1) {
 964                 Tcl_AppendStringsToObj (resultObj,
 965                                         "LDAP cache enable error: ",
 966                                         LDAP_ERR_STRING(ldap),
 967                                         (char *)NULL);
 968                 LDAP_SetErrorCode(ldaptcl, -1, interp);
 969                 return TCL_ERROR;
 970             }
 971             ldaptcl->caching = 1;
 972             ldaptcl->timeout = timeout;
 973             ldaptcl->maxmem = maxmem;
 974             return TCL_OK;
 975         }
 976
 977         if (objc != 3) goto badargs;
 978
 979         if (STREQU (cacheCommand, "disable")) {
 980             ldap_disable_cache (ldap);
 981             ldaptcl->caching = 0;
 982             return TCL_OK;
 983         }
 984
 985         if (STREQU (cacheCommand, "destroy")) {
 986             ldap_destroy_cache (ldap);
 987             ldaptcl->caching = 0;
 988             return TCL_OK;
 989         }
 990
 991         if (STREQU (cacheCommand, "flush")) {
 992             ldap_flush_cache (ldap);
 993             return TCL_OK;
 994         }
 995
 996         if (STREQU (cacheCommand, "no_errors")) {
 997             ldap_set_cache_options (ldap, LDAP_CACHE_OPT_CACHENOERRS);
 998             return TCL_OK;
 999         }
1000
1001         if (STREQU (cacheCommand, "all_errors")) {
1002             ldap_set_cache_options (ldap, LDAP_CACHE_OPT_CACHEALLERRS);
1003             return TCL_OK;
1004         }
1005
1006         if (STREQU (cacheCommand, "size_errors")) {
1007             ldap_set_cache_options (ldap, 0);
1008             return TCL_OK;
1009         }
1010         Tcl_AppendStringsToObj (resultObj,
1011                                 "\"",
1012                                 command,
1013                                 " ",
1014                                 subCommand,
1015                                 "\" subcommand",
1016                                 " must be one of \"enable\", ",
1017                                 "\"disable\", ",
1018                                 "\"destroy\", \"flush\", \"uncache\", ",
1019                                 "\"no_errors\", \"size_errors\",",
1020                                 " or \"all_errors\"",
1021                                 (char *)NULL);
1022         return TCL_ERROR;
1023     }
1024 #endif
1025     if (STREQU (subCommand, "trap")) {
1026         Tcl_Obj *listObj, *resultObj;
1027         int *p, l, i, code;
1028
1029         if (objc > 4)
1030             return TclX_WrongArgs (interp, objv [0],
1031                                    "trap command ?errorCode-list?");
1032         if (objc == 2) {
1033             if (!ldaptcl->trapCmdObj)
1034                 return TCL_OK;
1035             resultObj = Tcl_NewListObj(0, NULL);
1036             Tcl_ListObjAppendElement(interp, resultObj, ldaptcl->trapCmdObj);
1037             if (ldaptcl->traplist) {
1038                 listObj = Tcl_NewObj();
1039                 for (p = ldaptcl->traplist; *p; p++) {
1040                     Tcl_ListObjAppendElement(interp, listObj,
1041                         Tcl_NewStringObj(ldaptclerrorcode[*p], -1));
1042                 }
1043                 Tcl_ListObjAppendElement(interp, resultObj, listObj);
1044             }
1045             Tcl_SetObjResult(interp, resultObj);
1046             return TCL_OK;
1047         }
1048         if (ldaptcl->trapCmdObj) {
1049             Tcl_DecrRefCount (ldaptcl->trapCmdObj);
1050             ldaptcl->trapCmdObj = NULL;
1051         }
1052         if (ldaptcl->traplist) {
1053             free(ldaptcl->traplist);
1054             ldaptcl->traplist = NULL;
1055         }
1056         Tcl_GetStringFromObj(objv[2], &l);
1057         if (l == 0)
1058             return TCL_OK;              /* just turn off trap */
1059         ldaptcl->trapCmdObj = objv[2];
1060         Tcl_IncrRefCount (ldaptcl->trapCmdObj);
1061         if (objc < 4)
1062             return TCL_OK;              /* no code list */
1063         if (Tcl_ListObjLength(interp, objv[3], &l) != TCL_OK)
1064             return TCL_ERROR;
1065         if (l == 0)
1066             return TCL_OK;              /* empty code list */
1067         ldaptcl->traplist = (int*)malloc(sizeof(int) * (l + 1));
1068         ldaptcl->traplist[l] = 0;
1069         for (i = 0; i < l; i++) {
1070             Tcl_ListObjIndex(interp, objv[3], i, &resultObj);
1071             code = LDAP_ErrorStringToCode(interp, Tcl_GetStringFromObj(resultObj, NULL));
1072             if (code == -1) {
1073                 free(ldaptcl->traplist);
1074                 ldaptcl->traplist = NULL;
1075                 return TCL_ERROR;
1076             }
1077             ldaptcl->traplist[i] = code;
1078         }
1079         return TCL_OK;
1080     }
1081     if (STREQU (subCommand, "trapcodes")) {
1082         int code;
1083         Tcl_Obj *resultObj;
1084         Tcl_Obj *stringObj;
1085         resultObj = Tcl_GetObjResult(interp);
1086
1087         for (code = 0; code < LDAPTCL_MAXERR; code++) {
1088             if (!ldaptclerrorcode[code]) continue;
1089             Tcl_ListObjAppendElement(interp, resultObj,
1090                         Tcl_NewStringObj(ldaptclerrorcode[code], -1));
1091         }
1092         return TCL_OK;
1093     }
1094 #ifdef LDAP_DEBUG
1095     if (STREQU (subCommand, "debug")) {
1096         if (objc != 3) {
1097             Tcl_AppendStringsToObj(resultObj, "Wrong # of arguments",
1098                 (char*)NULL);
1099             return TCL_ERROR;
1100         }
1101         return Tcl_GetIntFromObj(interp, objv[2], &ldap_debug);
1102     }
1103 #endif
1104
1105     /* FIX: this needs to enumerate all the possibilities */
1106     Tcl_AppendStringsToObj (resultObj,
1107                             "subcommand \"",
1108                             subCommand,
1109                             "\" must be one of \"add\", ",
1110                             "\"add_attributes\", ",
1111                             "\"bind\", \"cache\", \"delete\", ",
1112                             "\"delete_attributes\", \"modify\", ",
1113                             "\"modify_rdn\", \"rename_rdn\", ",
1114                             "\"replace_attributes\", ",
1115                             "\"search\" or \"unbind\".",
1116                             (char *)NULL);
1117     return TCL_ERROR;
1118 }
1119
1120 /*
1121  * Delete and LDAP command object
1122  *
1123  */
1124 static void
1125 NeoX_LdapObjDeleteCmd(clientData)
1126     ClientData    clientData;
1127 {
1128     LDAPTCL      *ldaptcl = (LDAPTCL *)clientData;
1129     LDAP         *ldap = ldaptcl->ldap;
1130
1131     if (ldaptcl->trapCmdObj)
1132         Tcl_DecrRefCount (ldaptcl->trapCmdObj);
1133     if (ldaptcl->traplist)
1134         free(ldaptcl->traplist);
1135     ldap_unbind(ldap);
1136     free((char*) ldaptcl);
1137 }
1138
1139 /*-----------------------------------------------------------------------------
1140  * NeoX_LdapObjCmd --
1141  *
1142  * Implements the `ldap' command:
1143  *    ldap open newObjName host [port]
1144  *    ldap init newObjName host [port]
1145  *
1146  * Results:
1147  *      A standard Tcl result.
1148  *
1149  * Side effects:
1150  *      See the user documentation.
1151  *-----------------------------------------------------------------------------
1152  */
1153 static int
1154 NeoX_LdapObjCmd (clientData, interp, objc, objv)
1155     ClientData    clientData;
1156     Tcl_Interp   *interp;
1157     int           objc;
1158     Tcl_Obj      *CONST objv[];
1159 {
1160     extern int    errno;
1161     char         *subCommand;
1162     char         *newCommand;
1163     char         *ldapHost;
1164     int           ldapPort = 389;
1165     LDAP         *ldap;
1166     LDAPTCL      *ldaptcl;
1167
1168     Tcl_Obj      *resultObj = Tcl_GetObjResult (interp);
1169
1170     if (objc < 3 || objc > 5)
1171         return TclX_WrongArgs (interp, objv [0],
1172                                "(open|init) new_command host [port]|explode dn");
1173
1174     subCommand = Tcl_GetStringFromObj (objv[1], NULL);
1175
1176     if (STREQU(subCommand, "explode")) {
1177         char *param;
1178         int nonames = 0;
1179         int list = 0;
1180         char **exploded, **p;
1181
1182         param = Tcl_GetStringFromObj (objv[2], NULL);
1183         if (param[0] == '-') {
1184             if (STREQU(param, "-nonames")) {
1185                 nonames = 1;
1186             } else if (STREQU(param, "-list")) {
1187                 list = 1;
1188             } else {
1189                 return TclX_WrongArgs (interp, objv [0], "explode ?-nonames|-list? dn");
1190             }
1191         }
1192         if (nonames || list)
1193             param = Tcl_GetStringFromObj (objv[3], NULL);
1194         exploded = ldap_explode_dn(param, nonames);
1195         for (p = exploded; *p; p++) {
1196             if (list) {
1197                 char *q = strchr(*p, '=');
1198                 if (!q) {
1199                     Tcl_SetObjLength(resultObj, 0);
1200                     Tcl_AppendStringsToObj(resultObj, "rdn ", *p,
1201                         " missing '='", NULL);
1202                     ldap_value_free(exploded);
1203                     return TCL_ERROR;
1204                 }
1205                 *q = '\0';
1206                 if (Tcl_ListObjAppendElement(interp, resultObj,
1207                         Tcl_NewStringObj(*p, -1)) != TCL_OK ||
1208                         Tcl_ListObjAppendElement(interp, resultObj,
1209                         Tcl_NewStringObj(q+1, -1)) != TCL_OK) {
1210                     ldap_value_free(exploded);
1211                     return TCL_ERROR;
1212                 }
1213             } else {
1214                 if (Tcl_ListObjAppendElement(interp, resultObj,
1215                         Tcl_NewStringObj(*p, -1))) {
1216                     ldap_value_free(exploded);
1217                     return TCL_ERROR;
1218                 }
1219             }
1220         }
1221         ldap_value_free(exploded);
1222         return TCL_OK;
1223     }
1224
1225 #ifdef UMICH_LDAP
1226     if (STREQU(subCommand, "friendly")) {
1227         char *friendly = ldap_dn2ufn(Tcl_GetStringFromObj(objv[2], NULL));
1228         Tcl_SetStringObj(resultObj, friendly, -1);
1229         free(friendly);
1230         return TCL_OK;
1231     }
1232 #endif
1233
1234     newCommand = Tcl_GetStringFromObj (objv[2], NULL);
1235     ldapHost = Tcl_GetStringFromObj (objv[3], NULL);
1236
1237     if (objc == 5) {
1238         if (Tcl_GetIntFromObj (interp, objv [4], &ldapPort) == TCL_ERROR) {
1239             Tcl_AppendStringsToObj (resultObj,
1240                                     "LDAP port number is non-numeric",
1241                                     (char *)NULL);
1242             return TCL_ERROR;
1243         }
1244     }
1245
1246     if (STREQU (subCommand, "open")) {
1247         ldap = ldap_open (ldapHost, ldapPort);
1248     } else if (STREQU (subCommand, "init")) {
1249         ldap = ldap_init (ldapHost, ldapPort);
1250     } else {
1251         Tcl_AppendStringsToObj (resultObj,
1252                                 "option was not \"open\" or \"init\"");
1253         return TCL_ERROR;
1254     }
1255
1256     if (ldap == (LDAP *)NULL) {
1257         Tcl_SetErrno(errno);
1258         Tcl_AppendStringsToObj (resultObj,
1259                                 Tcl_PosixError (interp),
1260                                 (char *)NULL);
1261         return TCL_ERROR;
1262     }
1263
1264 #if UMICH_LDAP
1265     ldap->ld_deref = LDAP_DEREF_NEVER;  /* Turn off alias dereferencing */
1266 #endif
1267
1268     ldaptcl = (LDAPTCL *) malloc(sizeof(LDAPTCL));
1269     ldaptcl->ldap = ldap;
1270     ldaptcl->caching = 0;
1271     ldaptcl->timeout = 0;
1272     ldaptcl->maxmem = 0;
1273     ldaptcl->trapCmdObj = NULL;
1274     ldaptcl->traplist = NULL;
1275     ldaptcl->flags = 0;
1276
1277     Tcl_CreateObjCommand (interp,
1278                           newCommand,
1279                           NeoX_LdapTargetObjCmd,
1280                           (ClientData) ldaptcl,
1281                           NeoX_LdapObjDeleteCmd);
1282     return TCL_OK;
1283 }
1284
1285 /*-----------------------------------------------------------------------------
1286  * Neo_initLDAP --
1287  *     Initialize the LDAP interface.
1288  *-----------------------------------------------------------------------------
1289  */
1290 int
1291 Ldaptcl_Init (interp)
1292 Tcl_Interp   *interp;
1293 {
1294     Tcl_CreateObjCommand (interp,
1295                           "ldap",
1296                           NeoX_LdapObjCmd,
1297                           (ClientData) NULL,
1298                           (Tcl_CmdDeleteProc*) NULL);
1299     Tcl_PkgProvide(interp, "Ldaptcl", VERSION);
1300     return TCL_OK;
1301 }