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  * $OpenLDAP$
  27  *
  28  */
  29
  30 /*
  31  * This code was originally developed by Karl Lehenbauer to work with
  32  * Umich-3.3 LDAP.  It was debugged against the Netscape LDAP server
  33  * and their much more reliable SDK, and again backported to the
  34  * Umich-3.3 client code.  The UMICH_LDAP define is used to include
  35  * code that will work with the Umich-3.3 LDAP, but not with Netscape's
  36  * SDK.  OpenLDAP may support some of these, but they have not been tested.
  37  * Currently supported by Randy Kunkee (kunkee@OpenLDAP.org).
  38  */
  39
  40 /*
  41  * Add timeout to controlArray to set timeout for ldap_result.
  42  * 4/14/99 - Randy
  43  */
  44
  45 #include "tclExtend.h"
  46
  47 #include <lber.h>
  48 #include <ldap.h>
  49 #include <string.h>
  50 #include <sys/time.h>
  51 #include <math.h>
  52
  53 /*
  54  * Macros to do string compares.  They pre-check the first character before
  55  * checking of the strings are equal.
  56  */
  57
  58 #define STREQU(str1, str2) \
  59         (((str1) [0] == (str2) [0]) && (strcmp (str1, str2) == 0))
  60 #define STRNEQU(str1, str2, n) \
  61         (((str1) [0] == (str2) [0]) && (strncmp (str1, str2, n) == 0))
  62
  63 /*
  64  * The following section defines some common macros used by the rest
  65  * of the code.  It's ugly, and can use some work.  This code was
  66  * originally developed to work with Umich-3.3 LDAP.  It was debugged
  67  * against the Netscape LDAP server and the much more reliable SDK,
  68  * and then again backported to the Umich-3.3 client code.
  69  */
  70 #define OPEN_LDAP 1
  71 #if defined(OPEN_LDAP)
  72        /* LDAP_API_VERSION must be defined per the current draft spec
  73        ** it's value will be assigned RFC number.  However, as
  74        ** no RFC is defined, it's value is currently implementation
  75        ** specific (though I would hope it's value is greater than 1823).
  76        ** In OpenLDAP 2.x-devel, its 2000 + the draft number, ie 2002.
  77        ** This section is for OPENLDAP.
  78        */
  79 #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"))
 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
 890         ldap_set_option(ldap, LDAP_OPT_DEREF, &deref);
 891
 892         tclResult = LDAP_PerformSearch (interp,
 893                                     ldaptcl,
 894                                     baseString,
 895                                     scope,
 896                                     attributesArray,
 897                                     filterPatternString,
 898                                     "",
 899                                     destArrayNameObj,
 900                                     evalCodeObj,
 901                                     timeout_p,
 902                                     all,
 903                                     sortattr);
 904         /* Following the search, if we changed the caching behavior, change */
 905         /* it back. */
 906 #if 0
 907         if (cacheThis >= 0 && ldaptcl->caching != cacheThis) {
 908             if (cacheThis)
 909                 ldap_disable_cache(ldap);
 910             else
 911                 ldap_enable_cache(ldap, ldaptcl->timeout, ldaptcl->maxmem);
 912         }
 913         deref = LDAP_DEREF_NEVER;
 914         ldap_set_option(ldap, LDAP_OPT_DEREF, &deref);
 915 #endif
 916         return tclResult;
 917     }
 918
 919     /* object compare dn attr value */
 920     if (STREQU (subCommand, "compare")) {
 921         char        *dn;
 922         char        *attr;
 923         char        *value;
 924         int          result;
 925         int          lderrno;
 926
 927         if (objc != 5)
 928             return TclX_WrongArgs (interp,
 929                                    objv [0],
 930                                    "compare dn attribute value");
 931
 932         dn = Tcl_GetStringFromObj (objv[2], NULL);
 933         attr = Tcl_GetStringFromObj (objv[3], NULL);
 934         value = Tcl_GetStringFromObj (objv[4], NULL);
 935
 936         result = ldap_compare_s (ldap, dn, attr, value);
 937         if (result == LDAP_COMPARE_TRUE || result == LDAP_COMPARE_FALSE) {
 938             Tcl_SetIntObj(resultObj, result == LDAP_COMPARE_TRUE);
 939             return TCL_OK;
 940         }
 941         LDAP_SetErrorCode(ldaptcl, result, interp);
 942         Tcl_AppendStringsToObj (resultObj,
 943                                 "LDAP compare error: ",
 944                                 LDAP_ERR_STRING(ldap),
 945                                 (char *)NULL);
 946         return TCL_ERROR;
 947     }
 948
 949 #if defined(UMICH_LDAP) || (defined(OPEN_LDAP) && !defined(LDAP_API_VERSION))
 950     if (STREQU (subCommand, "cache")) {
 951         char *cacheCommand;
 952
 953         if (objc < 3)
 954           badargs:
 955             return TclX_WrongArgs (interp,
 956                                    objv [0],
 957                                    "cache command [args...]");
 958
 959         cacheCommand = Tcl_GetStringFromObj (objv [2], NULL);
 960
 961         if (STREQU (cacheCommand, "uncache")) {
 962             char *dn;
 963
 964             if (objc != 4)
 965                 return TclX_WrongArgs (interp,
 966                                        objv [0],
 967                                        "cache uncache dn");
 968
 969             dn = Tcl_GetStringFromObj (objv [3], NULL);
 970             ldap_uncache_entry (ldap, dn);
 971             return TCL_OK;
 972         }
 973
 974         if (STREQU (cacheCommand, "enable")) {
 975             long   timeout = ldaptcl->timeout;
 976             long   maxmem = ldaptcl->maxmem;
 977
 978             if (objc > 5)
 979                 return TclX_WrongArgs (interp,
 980                                        objv [0],
 981                                        "cache enable ?timeout? ?maxmem?");
 982
 983             if (objc > 3) {
 984                 if (Tcl_GetLongFromObj (interp, objv [3], &timeout) == TCL_ERROR)
 985                     return TCL_ERROR;
 986             }
 987             if (timeout == 0) {
 988                 Tcl_SetStringObj(resultObj,
 989                     objc > 3 ? "timeouts must be greater than 0" :
 990                     "no previous timeout to reference", -1);
 991                 return TCL_ERROR;
 992             }
 993
 994             if (objc > 4)
 995                 if (Tcl_GetLongFromObj (interp, objv [4], &maxmem) == TCL_ERROR)
 996                     return TCL_ERROR;
 997
 998             if (ldap_enable_cache (ldap, timeout, maxmem) == -1) {
 999                 Tcl_AppendStringsToObj (resultObj,
1000                                         "LDAP cache enable error: ",
1001                                         LDAP_ERR_STRING(ldap),
1002                                         (char *)NULL);
1003                 LDAP_SetErrorCode(ldaptcl, -1, interp);
1004                 return TCL_ERROR;
1005             }
1006             ldaptcl->caching = 1;
1007             ldaptcl->timeout = timeout;
1008             ldaptcl->maxmem = maxmem;
1009             return TCL_OK;
1010         }
1011
1012         if (objc != 3) goto badargs;
1013
1014         if (STREQU (cacheCommand, "disable")) {
1015             ldap_disable_cache (ldap);
1016             ldaptcl->caching = 0;
1017             return TCL_OK;
1018         }
1019
1020         if (STREQU (cacheCommand, "destroy")) {
1021             ldap_destroy_cache (ldap);
1022             ldaptcl->caching = 0;
1023             return TCL_OK;
1024         }
1025
1026         if (STREQU (cacheCommand, "flush")) {
1027             ldap_flush_cache (ldap);
1028             return TCL_OK;
1029         }
1030
1031         if (STREQU (cacheCommand, "no_errors")) {
1032             ldap_set_cache_options (ldap, LDAP_CACHE_OPT_CACHENOERRS);
1033             return TCL_OK;
1034         }
1035
1036         if (STREQU (cacheCommand, "all_errors")) {
1037             ldap_set_cache_options (ldap, LDAP_CACHE_OPT_CACHEALLERRS);
1038             return TCL_OK;
1039         }
1040
1041         if (STREQU (cacheCommand, "size_errors")) {
1042             ldap_set_cache_options (ldap, 0);
1043             return TCL_OK;
1044         }
1045         Tcl_AppendStringsToObj (resultObj,
1046                                 "\"",
1047                                 command,
1048                                 " ",
1049                                 subCommand,
1050                                 "\" subcommand",
1051                                 " must be one of \"enable\", ",
1052                                 "\"disable\", ",
1053                                 "\"destroy\", \"flush\", \"uncache\", ",
1054                                 "\"no_errors\", \"size_errors\",",
1055                                 " or \"all_errors\"",
1056                                 (char *)NULL);
1057         return TCL_ERROR;
1058     }
1059 #endif
1060     if (STREQU (subCommand, "trap")) {
1061         Tcl_Obj *listObj, *resultObj;
1062         int *p, l, i, code;
1063
1064         if (objc > 4)
1065             return TclX_WrongArgs (interp, objv [0],
1066                                    "trap command ?errorCode-list?");
1067         if (objc == 2) {
1068             if (!ldaptcl->trapCmdObj)
1069                 return TCL_OK;
1070             resultObj = Tcl_NewListObj(0, NULL);
1071             Tcl_ListObjAppendElement(interp, resultObj, ldaptcl->trapCmdObj);
1072             if (ldaptcl->traplist) {
1073                 listObj = Tcl_NewObj();
1074                 for (p = ldaptcl->traplist; *p; p++) {
1075                     Tcl_ListObjAppendElement(interp, listObj,
1076                         Tcl_NewStringObj(ldaptclerrorcode[*p], -1));
1077                 }
1078                 Tcl_ListObjAppendElement(interp, resultObj, listObj);
1079             }
1080             Tcl_SetObjResult(interp, resultObj);
1081             return TCL_OK;
1082         }
1083         if (ldaptcl->trapCmdObj) {
1084             Tcl_DecrRefCount (ldaptcl->trapCmdObj);
1085             ldaptcl->trapCmdObj = NULL;
1086         }
1087         if (ldaptcl->traplist) {
1088             free(ldaptcl->traplist);
1089             ldaptcl->traplist = NULL;
1090         }
1091         Tcl_GetStringFromObj(objv[2], &l);
1092         if (l == 0)
1093             return TCL_OK;              /* just turn off trap */
1094         ldaptcl->trapCmdObj = objv[2];
1095         Tcl_IncrRefCount (ldaptcl->trapCmdObj);
1096         if (objc < 4)
1097             return TCL_OK;              /* no code list */
1098         if (Tcl_ListObjLength(interp, objv[3], &l) != TCL_OK)
1099             return TCL_ERROR;
1100         if (l == 0)
1101             return TCL_OK;              /* empty code list */
1102         ldaptcl->traplist = (int*)malloc(sizeof(int) * (l + 1));
1103         ldaptcl->traplist[l] = 0;
1104         for (i = 0; i < l; i++) {
1105             Tcl_ListObjIndex(interp, objv[3], i, &resultObj);
1106             code = LDAP_ErrorStringToCode(interp, Tcl_GetStringFromObj(resultObj, NULL));
1107             if (code == -1) {
1108                 free(ldaptcl->traplist);
1109                 ldaptcl->traplist = NULL;
1110                 return TCL_ERROR;
1111             }
1112             ldaptcl->traplist[i] = code;
1113         }
1114         return TCL_OK;
1115     }
1116     if (STREQU (subCommand, "trapcodes")) {
1117         int code;
1118         Tcl_Obj *resultObj;
1119         Tcl_Obj *stringObj;
1120         resultObj = Tcl_GetObjResult(interp);
1121
1122         for (code = 0; code < LDAPTCL_MAXERR; code++) {
1123             if (!ldaptclerrorcode[code]) continue;
1124             Tcl_ListObjAppendElement(interp, resultObj,
1125                         Tcl_NewStringObj(ldaptclerrorcode[code], -1));
1126         }
1127         return TCL_OK;
1128     }
1129 #ifdef LDAP_DEBUG
1130     if (STREQU (subCommand, "debug")) {
1131         if (objc != 3) {
1132             Tcl_AppendStringsToObj(resultObj, "Wrong # of arguments",
1133                 (char*)NULL);
1134             return TCL_ERROR;
1135         }
1136         return Tcl_GetIntFromObj(interp, objv[2], &ldap_debug);
1137     }
1138 #endif
1139
1140     /* FIX: this needs to enumerate all the possibilities */
1141     Tcl_AppendStringsToObj (resultObj,
1142                             "subcommand \"",
1143                             subCommand,
1144                             "\" must be one of \"add\", ",
1145                             "\"add_attributes\", ",
1146                             "\"bind\", \"cache\", \"delete\", ",
1147                             "\"delete_attributes\", \"modify\", ",
1148                             "\"modify_rdn\", \"rename_rdn\", ",
1149                             "\"replace_attributes\", ",
1150                             "\"search\" or \"unbind\".",
1151                             (char *)NULL);
1152     return TCL_ERROR;
1153 }
1154
1155 /*
1156  * Delete and LDAP command object
1157  *
1158  */
1159 static void
1160 NeoX_LdapObjDeleteCmd(clientData)
1161     ClientData    clientData;
1162 {
1163     LDAPTCL      *ldaptcl = (LDAPTCL *)clientData;
1164     LDAP         *ldap = ldaptcl->ldap;
1165
1166     if (ldaptcl->trapCmdObj)
1167         Tcl_DecrRefCount (ldaptcl->trapCmdObj);
1168     if (ldaptcl->traplist)
1169         free(ldaptcl->traplist);
1170     ldap_unbind(ldap);
1171     free((char*) ldaptcl);
1172 }
1173
1174 /*-----------------------------------------------------------------------------
1175  * NeoX_LdapObjCmd --
1176  *
1177  * Implements the `ldap' command:
1178  *    ldap open newObjName host [port]
1179  *    ldap init newObjName host [port]
1180  *
1181  * Results:
1182  *      A standard Tcl result.
1183  *
1184  * Side effects:
1185  *      See the user documentation.
1186  *-----------------------------------------------------------------------------
1187  */
1188 static int
1189 NeoX_LdapObjCmd (clientData, interp, objc, objv)
1190     ClientData    clientData;
1191     Tcl_Interp   *interp;
1192     int           objc;
1193     Tcl_Obj      *CONST objv[];
1194 {
1195     extern int    errno;
1196     char         *subCommand;
1197     char         *newCommand;
1198     char         *ldapHost;
1199     int           ldapPort = 389;
1200     LDAP         *ldap;
1201     LDAPTCL      *ldaptcl;
1202
1203     Tcl_Obj      *resultObj = Tcl_GetObjResult (interp);
1204
1205     if (objc < 3 || objc > 5)
1206         return TclX_WrongArgs (interp, objv [0],
1207                                "(open|init) new_command host [port]|explode dn");
1208
1209     subCommand = Tcl_GetStringFromObj (objv[1], NULL);
1210
1211     if (STREQU(subCommand, "explode")) {
1212         char *param;
1213         int nonames = 0;
1214         int list = 0;
1215         char **exploded, **p;
1216
1217         param = Tcl_GetStringFromObj (objv[2], NULL);
1218         if (param[0] == '-') {
1219             if (STREQU(param, "-nonames")) {
1220                 nonames = 1;
1221             } else if (STREQU(param, "-list")) {
1222                 list = 1;
1223             } else {
1224                 return TclX_WrongArgs (interp, objv [0], "explode ?-nonames|-list? dn");
1225             }
1226         }
1227         if (nonames || list)
1228             param = Tcl_GetStringFromObj (objv[3], NULL);
1229         exploded = ldap_explode_dn(param, nonames);
1230         for (p = exploded; *p; p++) {
1231             if (list) {
1232                 char *q = strchr(*p, '=');
1233                 if (!q) {
1234                     Tcl_SetObjLength(resultObj, 0);
1235                     Tcl_AppendStringsToObj(resultObj, "rdn ", *p,
1236                         " missing '='", NULL);
1237                     ldap_value_free(exploded);
1238                     return TCL_ERROR;
1239                 }
1240                 *q = '\0';
1241                 if (Tcl_ListObjAppendElement(interp, resultObj,
1242                         Tcl_NewStringObj(*p, -1)) != TCL_OK ||
1243                         Tcl_ListObjAppendElement(interp, resultObj,
1244                         Tcl_NewStringObj(q+1, -1)) != TCL_OK) {
1245                     ldap_value_free(exploded);
1246                     return TCL_ERROR;
1247                 }
1248             } else {
1249                 if (Tcl_ListObjAppendElement(interp, resultObj,
1250                         Tcl_NewStringObj(*p, -1))) {
1251                     ldap_value_free(exploded);
1252                     return TCL_ERROR;
1253                 }
1254             }
1255         }
1256         ldap_value_free(exploded);
1257         return TCL_OK;
1258     }
1259
1260 #ifdef UMICH_LDAP
1261     if (STREQU(subCommand, "friendly")) {
1262         char *friendly = ldap_dn2ufn(Tcl_GetStringFromObj(objv[2], NULL));
1263         Tcl_SetStringObj(resultObj, friendly, -1);
1264         free(friendly);
1265         return TCL_OK;
1266     }
1267 #endif
1268
1269     newCommand = Tcl_GetStringFromObj (objv[2], NULL);
1270     ldapHost = Tcl_GetStringFromObj (objv[3], NULL);
1271
1272     if (objc == 5) {
1273         if (Tcl_GetIntFromObj (interp, objv [4], &ldapPort) == TCL_ERROR) {
1274             Tcl_AppendStringsToObj (resultObj,
1275                                     "LDAP port number is non-numeric",
1276                                     (char *)NULL);
1277             return TCL_ERROR;
1278         }
1279     }
1280
1281     if (STREQU (subCommand, "open")) {
1282         ldap = ldap_open (ldapHost, ldapPort);
1283     } else if (STREQU (subCommand, "init")) {
1284         ldap = ldap_init (ldapHost, ldapPort);
1285     } else {
1286         Tcl_AppendStringsToObj (resultObj,
1287                                 "option was not \"open\" or \"init\"");
1288         return TCL_ERROR;
1289     }
1290
1291     if (ldap == (LDAP *)NULL) {
1292         Tcl_SetErrno(errno);
1293         Tcl_AppendStringsToObj (resultObj,
1294                                 Tcl_PosixError (interp),
1295                                 (char *)NULL);
1296         return TCL_ERROR;
1297     }
1298
1299 #if UMICH_LDAP
1300     ldap->ld_deref = LDAP_DEREF_NEVER;  /* Turn off alias dereferencing */
1301 #endif
1302
1303     ldaptcl = (LDAPTCL *) malloc(sizeof(LDAPTCL));
1304     ldaptcl->ldap = ldap;
1305     ldaptcl->caching = 0;
1306     ldaptcl->timeout = 0;
1307     ldaptcl->maxmem = 0;
1308     ldaptcl->trapCmdObj = NULL;
1309     ldaptcl->traplist = NULL;
1310     ldaptcl->flags = 0;
1311
1312     Tcl_CreateObjCommand (interp,
1313                           newCommand,
1314                           NeoX_LdapTargetObjCmd,
1315                           (ClientData) ldaptcl,
1316                           NeoX_LdapObjDeleteCmd);
1317     return TCL_OK;
1318 }
1319
1320 /*-----------------------------------------------------------------------------
1321  * Neo_initLDAP --
1322  *     Initialize the LDAP interface.
1323  *-----------------------------------------------------------------------------
1324  */
1325 int
1326 Ldaptcl_Init (interp)
1327 Tcl_Interp   *interp;
1328 {
1329     Tcl_CreateObjCommand (interp,
1330                           "ldap",
1331                           NeoX_LdapObjCmd,
1332                           (ClientData) NULL,
1333                           (Tcl_CmdDeleteProc*) NULL);
1334     Tcl_PkgProvide(interp, "Ldaptcl", VERSION);
1335     return TCL_OK;
1336 }