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