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     Tcl_Obj      *resultObj;
 306     int           lderrno;
 307
 308     resultObj = Tcl_GetObjResult (interp);
 309
 310     sprintf(filter, filtpatt, value);
 311
 312     fflush(stderr);
 313     if ((msgid = ldap_search (ldap, base, scope, filter, attrs, 0)) == -1) {
 314         Tcl_AppendStringsToObj (resultObj,
 315                                 "LDAP start search error: ",
 316                                         LDAP_ERR_STRING(ldap),
 317                                 (char *)NULL);
 318         LDAP_SetErrorCode(ldaptcl, -1, interp);
 319         return TCL_ERROR;
 320     }
 321
 322     abandon = 0;
 323     if (sortattr)
 324         all = 1;
 325     tclResult = TCL_OK;
 326     while (!abandon) {
 327         resultCode = ldap_result (ldap, msgid, all, timeout_p, &resultMessage);
 328         if (resultCode != LDAP_RES_SEARCH_RESULT &&
 329             resultCode != LDAP_RES_SEARCH_ENTRY)
 330                 break;
 331
 332         if (sortattr) {
 333             sortKey = (strcasecmp(sortattr, "dn") == 0) ? NULL : sortattr;
 334             ldap_sort_entries(ldap, &resultMessage, sortKey, strcasecmp);
 335         }
 336         entryMessage = ldap_first_entry(ldap, resultMessage);
 337
 338         while (entryMessage) {
 339             tclResult = LDAP_ProcessOneSearchResult  (interp,
 340                                     ldap,
 341                                     entryMessage,
 342                                     destArrayNameObj,
 343                                     evalCodeObj);
 344             if (tclResult != TCL_OK) {
 345                 if (tclResult == TCL_CONTINUE) {
 346                     tclResult = TCL_OK;
 347                 } else if (tclResult == TCL_BREAK) {
 348                     tclResult = TCL_OK;
 349                     abandon = 1;
 350                     break;
 351                 } else if (tclResult == TCL_ERROR) {
 352                     char msg[100];
 353                     sprintf(msg, "\n    (\"search\" body line %d)",
 354                             interp->errorLine);
 355                     Tcl_AddObjErrorInfo(interp, msg, -1);
 356                     abandon = 1;
 357                     break;
 358                 } else {
 359                     abandon = 1;
 360                     break;
 361                 }
 362             }
 363             entryMessage = ldap_next_entry(ldap, entryMessage);
 364         }
 365         if (resultCode == LDAP_RES_SEARCH_RESULT || all)
 366             break;
 367         if (resultMessage)
 368         ldap_msgfree(resultMessage);
 369         resultMessage = NULL;
 370     }
 371     if (abandon) {
 372         if (resultMessage)
 373             ldap_msgfree(resultMessage);
 374         if (resultCode == LDAP_RES_SEARCH_ENTRY)
 375             ldap_abandon(ldap, msgid);
 376         return tclResult;
 377     }
 378     if (resultCode == -1) {
 379         Tcl_AppendStringsToObj (resultObj,
 380                                 "LDAP result search error: ",
 381                                 LDAP_ERR_STRING(ldap),
 382                                 (char *)NULL);
 383         LDAP_SetErrorCode(ldaptcl, -1, interp);
 384         return TCL_ERROR;
 385     }
 386     if (resultCode == 0) {
 387         Tcl_SetErrorCode (interp, "TIMEOUT", (char*) NULL);
 388         Tcl_SetStringObj (resultObj, "LDAP timeout retrieving results", -1);
 389         return TCL_ERROR;
 390     }
 391     /*
 392     if (resultCode == LDAP_RES_SEARCH_RESULT ||
 393         (all && resultCode == LDAP_RES_SEARCH_ENTRY))
 394             return tclResult;
 395     */
 396
 397     if ((errorCode = ldap_result2error (ldap, resultMessage, 0))
 398       != LDAP_SUCCESS) {
 399       Tcl_AppendStringsToObj (resultObj,
 400                               "LDAP search error: ",
 401                               ldap_err2string(errorCode),
 402                               (char *)NULL);
 403       if (resultMessage)
 404           ldap_msgfree(resultMessage);
 405       LDAP_SetErrorCode(ldaptcl, errorCode, interp);
 406       return TCL_ERROR;
 407     }
 408     if (resultMessage)
 409         ldap_msgfree(resultMessage);
 410     return tclResult;
 411 }
 412
 413 /*-----------------------------------------------------------------------------
 414  * NeoX_LdapTargetObjCmd --
 415  *
 416  * Implements the body of commands created by Neo_LdapObjCmd.
 417  *
 418  * Results:
 419  *      A standard Tcl result.
 420  *
 421  * Side effects:
 422  *      See the user documentation.
 423  *-----------------------------------------------------------------------------
 424  */
 425 int
 426 NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
 427     ClientData    clientData;
 428     Tcl_Interp   *interp;
 429     int           objc;
 430     Tcl_Obj      *CONST objv[];
 431 {
 432     char         *command;
 433     char         *subCommand;
 434     LDAPTCL      *ldaptcl = (LDAPTCL *)clientData;
 435     LDAP         *ldap = ldaptcl->ldap;
 436     char         *dn;
 437     int           is_add = 0;
 438     int           is_add_or_modify = 0;
 439     int           mod_op = 0;
 440     char         *m, *s, *errmsg;
 441     int          errcode;
 442     int          tclResult;
 443
 444     Tcl_Obj      *resultObj = Tcl_GetObjResult (interp);
 445
 446     if (objc < 2)
 447        return TclX_WrongArgs (interp,
 448                               objv [0],
 449                               "subcommand [args...]");
 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             return TclX_WrongArgs (interp, objv [0], "bind authtype dn passwd");
 464
 465         ldap_authString = Tcl_GetStringFromObj (objv[2], NULL);
 466
 467         if (STREQU (ldap_authString, "simple")) {
 468             ldap_authInt = LDAP_AUTH_SIMPLE;
 469         }
 470 #ifdef UMICH_LDAP
 471         else if (STREQU (ldap_authString, "kerberos_ldap")) {
 472             ldap_authInt = LDAP_AUTH_KRBV41;
 473         } else if (STREQU (ldap_authString, "kerberos_dsa")) {
 474             ldap_authInt = LDAP_AUTH_KRBV42;
 475         } else if (STREQU (ldap_authString, "kerberos_both")) {
 476             ldap_authInt = LDAP_AUTH_KRBV4;
 477         }
 478 #endif
 479         else {
 480             Tcl_AppendStringsToObj (resultObj,
 481                                     "\"",
 482                                     command,
 483                                     " ",
 484                                     subCommand,
 485 #ifdef UMICH_LDAP
 486                                     "\" authtype must be one of \"simple\", ",
 487                                     "\"kerberos_ldap\", \"kerberos_dsa\" ",
 488                                     "or \"kerberos_both\"",
 489 #else
 490                                     "\" authtype must be \"simple\", ",
 491 #endif
 492                                     (char *)NULL);
 493             return TCL_ERROR;
 494         }
 495
 496         binddn = Tcl_GetStringFromObj (objv[3], &stringLength);
 497         if (stringLength == 0)
 498             binddn = NULL;
 499
 500         passwd = Tcl_GetStringFromObj (objv[4], &stringLength);
 501         if (stringLength == 0)
 502             passwd = NULL;
 503
 504 /*  ldap_bind_s(ldap, dn, pw, method) */
 505
 506 #ifdef UMICH_LDAP
 507 #define LDAP_BIND(ldap, dn, pw, method) \
 508   ldap_bind_s(ldap, dn, pw, method)
 509 #else
 510 #define LDAP_BIND(ldap, dn, pw, method) \
 511   ldap_simple_bind_s(ldap, dn, pw)
 512 #endif
 513         if ((errcode = LDAP_BIND (ldap,
 514                          binddn,
 515                          passwd,
 516                          ldap_authInt)) != LDAP_SUCCESS) {
 517
 518             Tcl_AppendStringsToObj (resultObj,
 519                                     "LDAP bind error: ",
 520                                     ldap_err2string(errcode),
 521                                     (char *)NULL);
 522             LDAP_SetErrorCode(ldaptcl, errcode, interp);
 523             return TCL_ERROR;
 524         }
 525         return TCL_OK;
 526     }
 527
 528     if (STREQU (subCommand, "unbind")) {
 529         if (objc != 2)
 530             return TclX_WrongArgs (interp, objv [0], "unbind");
 531
 532        return Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], NULL));
 533     }
 534
 535     /* object delete dn */
 536     if (STREQU (subCommand, "delete")) {
 537         if (objc != 3)
 538             return TclX_WrongArgs (interp, objv [0], "delete dn");
 539
 540        dn = Tcl_GetStringFromObj (objv [2], NULL);
 541        if ((errcode = ldap_delete_s(ldap, dn)) != LDAP_SUCCESS) {
 542            Tcl_AppendStringsToObj (resultObj,
 543                                    "LDAP delete error: ",
 544                                    ldap_err2string(errcode),
 545                                    (char *)NULL);
 546            LDAP_SetErrorCode(ldaptcl, errcode, interp);
 547            return TCL_ERROR;
 548        }
 549        return TCL_OK;
 550     }
 551
 552     /* object rename_rdn dn rdn */
 553     /* object modify_rdn dn rdn */
 554     if (STREQU (subCommand, "rename_rdn") || STREQU (subCommand, "modify_rdn")) {
 555         char    *rdn;
 556         int      deleteOldRdn;
 557
 558         if (objc != 4)
 559             return TclX_WrongArgs (interp,
 560                                    objv [0],
 561                                    "delete_rdn|modify_rdn dn rdn");
 562
 563         dn = Tcl_GetStringFromObj (objv [2], NULL);
 564         rdn = Tcl_GetStringFromObj (objv [3], NULL);
 565
 566         deleteOldRdn = (*subCommand == 'r');
 567
 568         if ((errcode = ldap_modrdn2_s (ldap, dn, rdn, deleteOldRdn)) != LDAP_SUCCESS) {
 569             Tcl_AppendStringsToObj (resultObj,
 570                                     "LDAP ",
 571                                     subCommand,
 572                                     " error: ",
 573                                     ldap_err2string(errcode),
 574                                     (char *)NULL);
 575             LDAP_SetErrorCode(ldaptcl, errcode, interp);
 576             return TCL_ERROR;
 577         }
 578         return TCL_OK;
 579     }
 580
 581     /* object add dn attributePairList */
 582     /* object add_attributes dn attributePairList */
 583     /* object replace_attributes dn attributePairList */
 584     /* object delete_attributes dn attributePairList */
 585
 586     if (STREQU (subCommand, "add")) {
 587         is_add = 1;
 588         is_add_or_modify = 1;
 589     } else {
 590         is_add = 0;
 591         if (STREQU (subCommand, "add_attributes")) {
 592             is_add_or_modify = 1;
 593             mod_op = LDAP_MOD_ADD;
 594         } else if (STREQU (subCommand, "replace_attributes")) {
 595             is_add_or_modify = 1;
 596             mod_op = LDAP_MOD_REPLACE;
 597         } else if (STREQU (subCommand, "delete_attributes")) {
 598             is_add_or_modify = 1;
 599             mod_op = LDAP_MOD_DELETE;
 600         }
 601     }
 602
 603     if (is_add_or_modify) {
 604         int          result;
 605         LDAPMod    **modArray;
 606         LDAPMod     *mod;
 607         char       **valPtrs = NULL;
 608         int          attribObjc;
 609         Tcl_Obj    **attribObjv;
 610         int          valuesObjc;
 611         Tcl_Obj    **valuesObjv;
 612         int          nPairs;
 613         int          i;
 614         int          j;
 615
 616         Tcl_Obj      *resultObj = Tcl_GetObjResult (interp);
 617
 618         if (objc != 4) {
 619             Tcl_AppendStringsToObj (resultObj,
 620                                     "wrong # args: ",
 621                                     Tcl_GetStringFromObj (objv [0], NULL),
 622                                     " ",
 623                                     subCommand,
 624                                     " dn attributePairList",
 625                                     (char *)NULL);
 626             return TCL_ERROR;
 627         }
 628
 629         dn = Tcl_GetStringFromObj (objv [2], NULL);
 630
 631         if (Tcl_ListObjGetElements (interp, objv [3], &attribObjc, &attribObjv)
 632           == TCL_ERROR) {
 633            return TCL_ERROR;
 634         }
 635
 636         if (attribObjc & 1) {
 637             Tcl_AppendStringsToObj (resultObj,
 638                                     "attribute list does not contain an ",
 639                                     "even number of key-value elements",
 640                                     (char *)NULL);
 641             return TCL_ERROR;
 642         }
 643
 644         nPairs = attribObjc / 2;
 645
 646         modArray = (LDAPMod **)malloc (sizeof(LDAPMod *) * (nPairs + 1));
 647         modArray[nPairs] = (LDAPMod *) NULL;
 648
 649         for (i = 0; i < nPairs; i++) {
 650             mod = modArray[i] = (LDAPMod *) malloc (sizeof(LDAPMod));
 651             mod->mod_op = mod_op;
 652             mod->mod_type = Tcl_GetStringFromObj (attribObjv [i * 2], NULL);
 653
 654             if (Tcl_ListObjGetElements (interp, attribObjv [i * 2 + 1], &valuesObjc, &valuesObjv) == TCL_ERROR) {
 655                 /* FIX: cleanup memory here */
 656                 return TCL_ERROR;
 657             }
 658
 659             valPtrs = mod->mod_vals.modv_strvals = \
 660                 (char **)malloc (sizeof (char *) * (valuesObjc + 1));
 661             valPtrs[valuesObjc] = (char *)NULL;
 662
 663             for (j = 0; j < valuesObjc; j++) {
 664                 valPtrs [j] = Tcl_GetStringFromObj (valuesObjv[j], NULL);
 665
 666                 /* If it's "delete" and value is an empty string, make
 667                  * value be NULL to indicate entire attribute is to be
 668                  * deleted */
 669                 if ((*valPtrs [j] == '\0')
 670                     && (mod->mod_op == LDAP_MOD_DELETE || mod->mod_op == LDAP_MOD_REPLACE)) {
 671                         valPtrs [j] = NULL;
 672                 }
 673             }
 674         }
 675
 676         if (is_add) {
 677             result = ldap_add_s (ldap, dn, modArray);
 678         } else {
 679             result = ldap_modify_s (ldap, dn, modArray);
 680             if (ldaptcl->caching)
 681                 ldap_uncache_entry (ldap, dn);
 682         }
 683
 684         /* free the modArray elements, then the modArray itself. */
 685         for (i = 0; i < nPairs; i++) {
 686             free ((char *) modArray[i]->mod_vals.modv_strvals);
 687             free ((char *) modArray[i]);
 688         }
 689         free ((char *) modArray);
 690
 691         /* FIX: memory cleanup required all over the place here */
 692         if (result != LDAP_SUCCESS) {
 693             Tcl_AppendStringsToObj (resultObj,
 694                                     "LDAP ",
 695                                     subCommand,
 696                                     " error: ",
 697                                     ldap_err2string(result),
 698                                     (char *)NULL);
 699             LDAP_SetErrorCode(ldaptcl, result, interp);
 700             return TCL_ERROR;
 701         }
 702         return TCL_OK;
 703     }
 704
 705     /* object search controlArray dn pattern */
 706     if (STREQU (subCommand, "search")) {
 707         char        *controlArrayName;
 708         Tcl_Obj     *controlArrayNameObj;
 709
 710         char        *scopeString;
 711         int          scope;
 712
 713         char        *derefString;
 714         int          deref;
 715
 716         char        *baseString;
 717
 718         char       **attributesArray;
 719         char        *attributesString;
 720         int          attributesArgc;
 721
 722         char        *filterPatternString;
 723
 724         char        *timeoutString;
 725         double       timeoutTime;
 726         struct timeval timeout, *timeout_p;
 727
 728         char        *paramString;
 729         int          cacheThis = -1;
 730         int          all = 0;
 731
 732         char        *sortattr;
 733
 734         Tcl_Obj     *destArrayNameObj;
 735         Tcl_Obj     *evalCodeObj;
 736
 737         if (objc != 5)
 738             return TclX_WrongArgs (interp,
 739                                    objv [0],
 740                                    "search controlArray destArray code");
 741
 742         controlArrayNameObj = objv [2];
 743         controlArrayName = Tcl_GetStringFromObj (controlArrayNameObj, NULL);
 744
 745         destArrayNameObj = objv [3];
 746
 747         evalCodeObj = objv [4];
 748
 749         baseString = Tcl_GetVar2 (interp,
 750                                   controlArrayName,
 751                                   "base",
 752                                   0);
 753
 754         if (baseString == (char *)NULL) {
 755             Tcl_AppendStringsToObj (resultObj,
 756                                     "required element \"base\" ",
 757                                     "is missing from ldap control array \"",
 758                                     controlArrayName,
 759                                     "\"",
 760                                     (char *)NULL);
 761             return TCL_ERROR;
 762         }
 763
 764         filterPatternString = Tcl_GetVar2 (interp,
 765                                            controlArrayName,
 766                                            "filter",
 767                                            0);
 768         if (filterPatternString == (char *)NULL) {
 769             filterPatternString = "objectclass=*";
 770         }
 771
 772         /* Fetch scope setting from control array.
 773          * If it doesn't exist, default to subtree scoping.
 774          */
 775         scopeString = Tcl_GetVar2 (interp, controlArrayName, "scope", 0);
 776         if (scopeString == NULL) {
 777             scope = LDAP_SCOPE_SUBTREE;
 778         } else {
 779             if (STREQU(scopeString, "base"))
 780                 scope = LDAP_SCOPE_BASE;
 781             else if (STRNEQU(scopeString, "one", 3))
 782                 scope = LDAP_SCOPE_ONELEVEL;
 783             else if (STRNEQU(scopeString, "sub", 3))
 784                 scope = LDAP_SCOPE_SUBTREE;
 785             else {
 786                 Tcl_AppendStringsToObj (resultObj,
 787                                         "\"scope\" element of \"",
 788                                         controlArrayName,
 789                                         "\" array is not one of ",
 790                                         "\"base\", \"onelevel\", ",
 791                                         "or \"subtree\"",
 792                                       (char *) NULL);
 793                 return TCL_ERROR;
 794             }
 795         }
 796
 797         /* Fetch dereference control setting from control array.
 798          * If it doesn't exist, default to never dereference. */
 799         derefString = Tcl_GetVar2 (interp,
 800                                    controlArrayName,
 801                                    "deref",
 802                                    0);
 803
 804         if (derefString == (char *)NULL) {
 805             deref = LDAP_DEREF_NEVER;
 806         } else {
 807             if (STREQU(derefString, "never"))
 808                 deref = LDAP_DEREF_NEVER;
 809             else if (STREQU(derefString, "search"))
 810                 deref = LDAP_DEREF_SEARCHING;
 811             else if (STREQU(derefString, "find") == 0)
 812                 deref = LDAP_DEREF_FINDING;
 813             else if (STREQU(derefString, "always"))
 814                 deref = LDAP_DEREF_ALWAYS;
 815             else {
 816                 Tcl_AppendStringsToObj (resultObj,
 817                                         "\"deref\" element of \"",
 818                                         controlArrayName,
 819                                         "\" array is not one of ",
 820                                         "\"never\", \"search\", \"find\", ",
 821                                         "or \"always\"",
 822                                         (char *) NULL);
 823                 return TCL_ERROR;
 824             }
 825         }
 826
 827         /* Fetch list of attribute names from control array.
 828          * If entry doesn't exist, default to NULL (all).
 829          */
 830         attributesString = Tcl_GetVar2 (interp,
 831                                         controlArrayName,
 832                                         "attributes",
 833                                         0);
 834         if (attributesString == (char *)NULL) {
 835             attributesArray = NULL;
 836         } else {
 837             if ((Tcl_SplitList (interp,
 838                                 attributesString,
 839                                 &attributesArgc,
 840                                 &attributesArray)) != TCL_OK) {
 841                 return TCL_ERROR;
 842             }
 843         }
 844
 845         /* Fetch timeout value if there is one
 846          */
 847         timeoutString = Tcl_GetVar2 (interp,
 848                                         controlArrayName,
 849                                         "timeout",
 850                                         0);
 851         timeout.tv_usec = 0;
 852         if (timeoutString == (char *)NULL) {
 853             timeout_p = NULL;
 854             timeout.tv_sec = 0;
 855         } else {
 856             if (Tcl_GetDouble(interp, timeoutString, &timeoutTime) != TCL_OK)
 857                 return TCL_ERROR;
 858             timeout.tv_sec = floor(timeoutTime);
 859             timeout.tv_usec = (timeoutTime-timeout.tv_sec) * 1000000;
 860             timeout_p = &timeout;
 861         }
 862
 863         paramString = Tcl_GetVar2 (interp, controlArrayName, "cache", 0);
 864         if (paramString) {
 865             if (Tcl_GetInt(interp, paramString, &cacheThis) == TCL_ERROR)
 866                 return TCL_ERROR;
 867         }
 868
 869         paramString = Tcl_GetVar2 (interp, controlArrayName, "all", 0);
 870         if (paramString) {
 871             if (Tcl_GetInt(interp, paramString, &all) == TCL_ERROR)
 872                 return TCL_ERROR;
 873         }
 874
 875         sortattr = Tcl_GetVar2 (interp, controlArrayName, "sort", 0);
 876
 877 #ifdef UMICH_LDAP
 878         ldap->ld_deref = deref;
 879         ldap->ld_timelimit = 0;
 880         ldap->ld_sizelimit = 0;
 881         ldap->ld_options = 0;
 882 #endif
 883
 884         /* Caching control within the search: if the "cache" control array */
 885         /* value is set, disable/enable caching accordingly */
 886
 887 #if 0
 888         if (cacheThis >= 0 && ldaptcl->caching != cacheThis) {
 889             if (cacheThis) {
 890                 if (ldaptcl->timeout == 0) {
 891                     Tcl_SetStringObj(resultObj, "Caching never before enabled, I have no timeout value to use", -1);
 892                     return TCL_ERROR;
 893                 }
 894                 ldap_enable_cache(ldap, ldaptcl->timeout, ldaptcl->maxmem);
 895             }
 896             else
 897                 ldap_disable_cache(ldap);
 898         }
 899 #endif
 900         tclResult = LDAP_PerformSearch (interp,
 901                                     ldaptcl,
 902                                     baseString,
 903                                     scope,
 904                                     attributesArray,
 905                                     filterPatternString,
 906                                     "",
 907                                     destArrayNameObj,
 908                                     evalCodeObj,
 909                                     timeout_p,
 910                                     all,
 911                                     sortattr);
 912         /* Following the search, if we changed the caching behavior, change */
 913         /* it back. */
 914 #if 0
 915         if (cacheThis >= 0 && ldaptcl->caching != cacheThis) {
 916             if (cacheThis)
 917                 ldap_disable_cache(ldap);
 918             else
 919                 ldap_enable_cache(ldap, ldaptcl->timeout, ldaptcl->maxmem);
 920         }
 921 #endif
 922         return tclResult;
 923     }
 924
 925 #if defined(UMICH_LDAP) || (defined(OPEN_LDAP) && !defined(LDAP_API_VERSION))
 926     if (STREQU (subCommand, "cache")) {
 927         char *cacheCommand;
 928
 929         if (objc < 3)
 930           badargs:
 931             return TclX_WrongArgs (interp,
 932                                    objv [0],
 933                                    "cache command [args...]");
 934
 935         cacheCommand = Tcl_GetStringFromObj (objv [2], NULL);
 936
 937         if (STREQU (cacheCommand, "uncache")) {
 938             char *dn;
 939
 940             if (objc != 4)
 941                 return TclX_WrongArgs (interp,
 942                                        objv [0],
 943                                        "cache uncache dn");
 944
 945             dn = Tcl_GetStringFromObj (objv [3], NULL);
 946             ldap_uncache_entry (ldap, dn);
 947             return TCL_OK;
 948         }
 949
 950         if (STREQU (cacheCommand, "enable")) {
 951             long   timeout = ldaptcl->timeout;
 952             long   maxmem = ldaptcl->maxmem;
 953
 954             if (objc > 5)
 955                 return TclX_WrongArgs (interp,
 956                                        objv [0],
 957                                        "cache enable ?timeout? ?maxmem?");
 958
 959             if (objc > 3) {
 960                 if (Tcl_GetLongFromObj (interp, objv [3], &timeout) == TCL_ERROR)
 961                     return TCL_ERROR;
 962             }
 963             if (timeout == 0) {
 964                 Tcl_SetStringObj(resultObj,
 965                     objc > 3 ? "timeouts must be greater than 0" :
 966                     "no previous timeout to reference", -1);
 967                 return TCL_ERROR;
 968             }
 969
 970             if (objc > 4)
 971                 if (Tcl_GetLongFromObj (interp, objv [4], &maxmem) == TCL_ERROR)
 972                     return TCL_ERROR;
 973
 974             if (ldap_enable_cache (ldap, timeout, maxmem) == -1) {
 975                 Tcl_AppendStringsToObj (resultObj,
 976                                         "LDAP cache enable error: ",
 977                                         LDAP_ERR_STRING(ldap),
 978                                         (char *)NULL);
 979                 LDAP_SetErrorCode(ldaptcl, -1, interp);
 980                 return TCL_ERROR;
 981             }
 982             ldaptcl->caching = 1;
 983             ldaptcl->timeout = timeout;
 984             ldaptcl->maxmem = maxmem;
 985             return TCL_OK;
 986         }
 987
 988         if (objc != 3) goto badargs;
 989
 990         if (STREQU (cacheCommand, "disable")) {
 991             ldap_disable_cache (ldap);
 992             ldaptcl->caching = 0;
 993             return TCL_OK;
 994         }
 995
 996         if (STREQU (cacheCommand, "destroy")) {
 997             ldap_destroy_cache (ldap);
 998             ldaptcl->caching = 0;
 999             return TCL_OK;
1000         }
1001
1002         if (STREQU (cacheCommand, "flush")) {
1003             ldap_flush_cache (ldap);
1004             return TCL_OK;
1005         }
1006
1007         if (STREQU (cacheCommand, "no_errors")) {
1008             ldap_set_cache_options (ldap, LDAP_CACHE_OPT_CACHENOERRS);
1009             return TCL_OK;
1010         }
1011
1012         if (STREQU (cacheCommand, "all_errors")) {
1013             ldap_set_cache_options (ldap, LDAP_CACHE_OPT_CACHEALLERRS);
1014             return TCL_OK;
1015         }
1016
1017         if (STREQU (cacheCommand, "size_errors")) {
1018             ldap_set_cache_options (ldap, 0);
1019             return TCL_OK;
1020         }
1021         Tcl_AppendStringsToObj (resultObj,
1022                                 "\"",
1023                                 command,
1024                                 " ",
1025                                 subCommand,
1026                                 "\" subcommand",
1027                                 " must be one of \"enable\", ",
1028                                 "\"disable\", ",
1029                                 "\"destroy\", \"flush\", \"uncache\", ",
1030                                 "\"no_errors\", \"size_errors\",",
1031                                 " or \"all_errors\"",
1032                                 (char *)NULL);
1033         return TCL_ERROR;
1034     }
1035 #endif
1036     if (STREQU (subCommand, "trap")) {
1037         Tcl_Obj *listObj, *resultObj;
1038         int *p, l, i, code;
1039
1040         if (objc > 4)
1041             return TclX_WrongArgs (interp, objv [0],
1042                                    "trap command ?errorCode-list?");
1043         if (objc == 2) {
1044             if (!ldaptcl->trapCmdObj)
1045                 return TCL_OK;
1046             resultObj = Tcl_NewListObj(0, NULL);
1047             Tcl_ListObjAppendElement(interp, resultObj, ldaptcl->trapCmdObj);
1048             if (ldaptcl->traplist) {
1049                 listObj = Tcl_NewObj();
1050                 for (p = ldaptcl->traplist; *p; p++) {
1051                     Tcl_ListObjAppendElement(interp, listObj,
1052                         Tcl_NewStringObj(ldaptclerrorcode[*p], -1));
1053                 }
1054                 Tcl_ListObjAppendElement(interp, resultObj, listObj);
1055             }
1056             Tcl_SetObjResult(interp, resultObj);
1057             return TCL_OK;
1058         }
1059         if (ldaptcl->trapCmdObj) {
1060             Tcl_DecrRefCount (ldaptcl->trapCmdObj);
1061             ldaptcl->trapCmdObj = NULL;
1062         }
1063         if (ldaptcl->traplist) {
1064             free(ldaptcl->traplist);
1065             ldaptcl->traplist = NULL;
1066         }
1067         Tcl_GetStringFromObj(objv[2], &l);
1068         if (l == 0)
1069             return TCL_OK;              /* just turn off trap */
1070         ldaptcl->trapCmdObj = objv[2];
1071         Tcl_IncrRefCount (ldaptcl->trapCmdObj);
1072         if (objc < 4)
1073             return TCL_OK;              /* no code list */
1074         if (Tcl_ListObjLength(interp, objv[3], &l) != TCL_OK)
1075             return TCL_ERROR;
1076         if (l == 0)
1077             return TCL_OK;              /* empty code list */
1078         ldaptcl->traplist = (int*)malloc(sizeof(int) * (l + 1));
1079         ldaptcl->traplist[l] = 0;
1080         for (i = 0; i < l; i++) {
1081             Tcl_ListObjIndex(interp, objv[3], i, &resultObj);
1082             code = LDAP_ErrorStringToCode(interp, Tcl_GetStringFromObj(resultObj, NULL));
1083             if (code == -1) {
1084                 free(ldaptcl->traplist);
1085                 ldaptcl->traplist = NULL;
1086                 return TCL_ERROR;
1087             }
1088             ldaptcl->traplist[i] = code;
1089         }
1090         return TCL_OK;
1091     }
1092     if (STREQU (subCommand, "trapcodes")) {
1093         int code;
1094         Tcl_Obj *resultObj;
1095         Tcl_Obj *stringObj;
1096         resultObj = Tcl_GetObjResult(interp);
1097
1098         for (code = 0; code < LDAPTCL_MAXERR; code++) {
1099             if (!ldaptclerrorcode[code]) continue;
1100             Tcl_ListObjAppendElement(interp, resultObj,
1101                         Tcl_NewStringObj(ldaptclerrorcode[code], -1));
1102         }
1103         return TCL_OK;
1104     }
1105 #ifdef LDAP_DEBUG
1106     if (STREQU (subCommand, "debug")) {
1107         if (objc != 3) {
1108             Tcl_AppendStringsToObj(resultObj, "Wrong # of arguments",
1109                 (char*)NULL);
1110             return TCL_ERROR;
1111         }
1112         return Tcl_GetIntFromObj(interp, objv[2], &ldap_debug);
1113     }
1114 #endif
1115
1116     /* FIX: this needs to enumerate all the possibilities */
1117     Tcl_AppendStringsToObj (resultObj,
1118                             "subcommand \"",
1119                             subCommand,
1120                             "\" must be one of \"add\", ",
1121                             "\"add_attributes\", ",
1122                             "\"bind\", \"cache\", \"delete\", ",
1123                             "\"delete_attributes\", \"modify\", ",
1124                             "\"modify_rdn\", \"rename_rdn\", ",
1125                             "\"replace_attributes\", ",
1126                             "\"search\" or \"unbind\".",
1127                             (char *)NULL);
1128     return TCL_ERROR;
1129 }
1130
1131 /*
1132  * Delete and LDAP command object
1133  *
1134  */
1135 static void
1136 NeoX_LdapObjDeleteCmd(clientData)
1137     ClientData    clientData;
1138 {
1139     LDAPTCL      *ldaptcl = (LDAPTCL *)clientData;
1140     LDAP         *ldap = ldaptcl->ldap;
1141
1142     if (ldaptcl->trapCmdObj)
1143         Tcl_DecrRefCount (ldaptcl->trapCmdObj);
1144     if (ldaptcl->traplist)
1145         free(ldaptcl->traplist);
1146     ldap_unbind(ldap);
1147     free((char*) ldaptcl);
1148 }
1149
1150 /*-----------------------------------------------------------------------------
1151  * NeoX_LdapObjCmd --
1152  *
1153  * Implements the `ldap' command:
1154  *    ldap open newObjName host [port]
1155  *    ldap init newObjName host [port]
1156  *
1157  * Results:
1158  *      A standard Tcl result.
1159  *
1160  * Side effects:
1161  *      See the user documentation.
1162  *-----------------------------------------------------------------------------
1163  */
1164 static int
1165 NeoX_LdapObjCmd (clientData, interp, objc, objv)
1166     ClientData    clientData;
1167     Tcl_Interp   *interp;
1168     int           objc;
1169     Tcl_Obj      *CONST objv[];
1170 {
1171     extern int    errno;
1172     char         *subCommand;
1173     char         *newCommand;
1174     char         *ldapHost;
1175     int           ldapPort = 389;
1176     LDAP         *ldap;
1177     LDAPTCL      *ldaptcl;
1178
1179     Tcl_Obj      *resultObj = Tcl_GetObjResult (interp);
1180
1181     if (objc < 3 || objc > 5)
1182         return TclX_WrongArgs (interp, objv [0],
1183                                "(open|init) new_command host [port]|explode dn");
1184
1185     subCommand = Tcl_GetStringFromObj (objv[1], NULL);
1186
1187     if (STREQU(subCommand, "explode")) {
1188         char *param;
1189         int nonames = 0;
1190         int list = 0;
1191         char **exploded, **p;
1192
1193         param = Tcl_GetStringFromObj (objv[2], NULL);
1194         if (param[0] == '-') {
1195             if (STREQU(param, "-nonames")) {
1196                 nonames = 1;
1197             } else if (STREQU(param, "-list")) {
1198                 list = 1;
1199             } else {
1200                 return TclX_WrongArgs (interp, objv [0], "explode ?-nonames|-list? dn");
1201             }
1202         }
1203         if (nonames || list)
1204             param = Tcl_GetStringFromObj (objv[3], NULL);
1205         exploded = ldap_explode_dn(param, nonames);
1206         for (p = exploded; *p; p++) {
1207             if (list) {
1208                 char *q = strchr(*p, '=');
1209                 if (!q) {
1210                     Tcl_SetObjLength(resultObj, 0);
1211                     Tcl_AppendStringsToObj(resultObj, "rdn ", *p,
1212                         " missing '='", NULL);
1213                     ldap_value_free(exploded);
1214                     return TCL_ERROR;
1215                 }
1216                 *q = '\0';
1217                 if (Tcl_ListObjAppendElement(interp, resultObj,
1218                         Tcl_NewStringObj(*p, -1)) != TCL_OK ||
1219                         Tcl_ListObjAppendElement(interp, resultObj,
1220                         Tcl_NewStringObj(q+1, -1)) != TCL_OK) {
1221                     ldap_value_free(exploded);
1222                     return TCL_ERROR;
1223                 }
1224             } else {
1225                 if (Tcl_ListObjAppendElement(interp, resultObj,
1226                         Tcl_NewStringObj(*p, -1))) {
1227                     ldap_value_free(exploded);
1228                     return TCL_ERROR;
1229                 }
1230             }
1231         }
1232         ldap_value_free(exploded);
1233         return TCL_OK;
1234     }
1235
1236 #ifdef UMICH_LDAP
1237     if (STREQU(subCommand, "friendly")) {
1238         char *friendly = ldap_dn2ufn(Tcl_GetStringFromObj(objv[2], NULL));
1239         Tcl_SetStringObj(resultObj, friendly, -1);
1240         free(friendly);
1241         return TCL_OK;
1242     }
1243 #endif
1244
1245     newCommand = Tcl_GetStringFromObj (objv[2], NULL);
1246     ldapHost = Tcl_GetStringFromObj (objv[3], NULL);
1247
1248     if (objc == 5) {
1249         if (Tcl_GetIntFromObj (interp, objv [4], &ldapPort) == TCL_ERROR) {
1250             Tcl_AppendStringsToObj (resultObj,
1251                                     "LDAP port number is non-numeric",
1252                                     (char *)NULL);
1253             return TCL_ERROR;
1254         }
1255     }
1256
1257     if (STREQU (subCommand, "open")) {
1258         ldap = ldap_open (ldapHost, ldapPort);
1259     } else if (STREQU (subCommand, "init")) {
1260         ldap = ldap_init (ldapHost, ldapPort);
1261     } else {
1262         Tcl_AppendStringsToObj (resultObj,
1263                                 "option was not \"open\" or \"init\"");
1264         return TCL_ERROR;
1265     }
1266
1267     if (ldap == (LDAP *)NULL) {
1268         Tcl_SetErrno(errno);
1269         Tcl_AppendStringsToObj (resultObj,
1270                                 Tcl_PosixError (interp),
1271                                 (char *)NULL);
1272         return TCL_ERROR;
1273     }
1274
1275 #if UMICH_LDAP
1276     ldap->ld_deref = LDAP_DEREF_NEVER;  /* Turn off alias dereferencing */
1277 #endif
1278
1279     ldaptcl = (LDAPTCL *) malloc(sizeof(LDAPTCL));
1280     ldaptcl->ldap = ldap;
1281     ldaptcl->caching = 0;
1282     ldaptcl->timeout = 0;
1283     ldaptcl->maxmem = 0;
1284     ldaptcl->trapCmdObj = NULL;
1285     ldaptcl->traplist = NULL;
1286     ldaptcl->flags = 0;
1287
1288     Tcl_CreateObjCommand (interp,
1289                           newCommand,
1290                           NeoX_LdapTargetObjCmd,
1291                           (ClientData) ldaptcl,
1292                           NeoX_LdapObjDeleteCmd);
1293     return TCL_OK;
1294 }
1295
1296 /*-----------------------------------------------------------------------------
1297  * Neo_initLDAP --
1298  *     Initialize the LDAP interface.
1299  *-----------------------------------------------------------------------------
1300  */
1301 int
1302 Ldaptcl_Init (interp)
1303 Tcl_Interp   *interp;
1304 {
1305     Tcl_CreateObjCommand (interp,
1306                           "ldap",
1307                           NeoX_LdapObjCmd,
1308                           (ClientData) NULL,
1309                           (Tcl_CmdDeleteProc*) NULL);
1310     Tcl_PkgProvide(interp, "Ldaptcl", VERSION);
1311     return TCL_OK;
1312 }