git.sur5r.net Git - openldap/blob - contrib/ldaptcl/neoXldap.c

   1 /*
   2  * NeoSoft Tcl client extensions to Lightweight Directory Access Protocol.
   3  *
   4  * Copyright (c) 1998-1999 NeoSoft, Inc.
   5  * All Rights Reserved.
   6  *
   7  * This software may be used, modified, copied, distributed, and sold,
   8  * in both source and binary form provided that these copyrights are
   9  * retained and their terms are followed.
  10  *
  11  * Under no circumstances are the authors or NeoSoft Inc. responsible
  12  * for the proper functioning of this software, nor do the authors
  13  * assume any liability for damages incurred with its use.
  14  *
  15  * Redistribution and use in source and binary forms are permitted
  16  * provided that this notice is preserved and that due credit is given
  17  * to NeoSoft, Inc.
  18  *
  19  * NeoSoft, Inc. may not be used to endorse or promote products derived
  20  * from this software without specific prior written permission. This
  21  * software is provided ``as is'' without express or implied warranty.
  22  *
  23  * Requests for permission may be sent to NeoSoft Inc, 1770 St. James Place,
  24  * Suite 500, Houston, TX, 77056.
  25  *
  26  * $Id: neoXldap.c,v 1.4 1999/07/27 05:29:27 kunkee Exp $
  27  *
  28  */
  29
  30 /*
  31  * This code was originally developed by Karl Lehenbauer to work with
  32  * Umich-3.3 LDAP.  It was debugged against the Netscape LDAP server
  33  * and their much more reliable SDK, and again backported to the
  34  * Umich-3.3 client code.  The UMICH_LDAP define is used to include
  35  * code that will work with the Umich-3.3 LDAP, but not with Netscape's
  36  * SDK.  OpenLDAP may support some of these, but they have not been tested.
  37  * Currently supported by Randy Kunkee (kunkee@OpenLDAP.org).
  38  */
  39
  40 /*
  41  * Add timeout to controlArray to set timeout for ldap_result.
  42  * 4/14/99 - Randy
  43  */
  44
  45 #include "tclExtend.h"
  46
  47 #include <lber.h>
  48 #include <ldap.h>
  49 #include <string.h>
  50 #include <sys/time.h>
  51 #include <math.h>
  52
  53 /*
  54  * Macros to do string compares.  They pre-check the first character before
  55  * checking of the strings are equal.
  56  */
  57
  58 #define STREQU(str1, str2) \
  59         (((str1) [0] == (str2) [0]) && (strcmp (str1, str2) == 0))
  60 #define STRNEQU(str1, str2, n) \
  61         (((str1) [0] == (str2) [0]) && (strncmp (str1, str2, n) == 0))
  62
  63 /*
  64  * The following section defines some common macros used by the rest
  65  * of the code.  It's ugly, and can use some work.  This code was
  66  * originally developed to work with Umich-3.3 LDAP.  It was debugged
  67  * against the Netscape LDAP server and the much more reliable SDK,
  68  * and then again backported to the Umich-3.3 client code.
  69  */
  70 #define OPEN_LDAP 1
  71 #if defined(OPEN_LDAP)
  72        /* LDAP_API_VERSION must be defined per the current draft spec
  73        ** it's value will be assigned RFC number.  However, as
  74        ** no RFC is defined, it's value is currently implementation
  75        ** specific (though I would hope it's value is greater than 1823).
  76        ** In OpenLDAP 2.x-devel, its 2000 + the draft number, ie 2002.
  77        ** This section is for OPENLDAP.
  78        */
  79 #define ldap_attributefree(p) ldap_memfree(p)
  80 #define ldap_memfree(p) free(p)
  81 #ifdef LDAP_OPT_ERROR_NUMBER
  82 #define ldap_get_lderrno(ld)    (ldap_get_option(ld, LDAP_OPT_ERROR_NUMBER, &lderrno), lderrno)
  83 #else
  84 #define ldap_get_lderrno(ld) (ld->ld_errno)
  85 #endif
  86 #define LDAP_ERR_STRING(ld)  \
  87         ldap_err2string(ldap_get_lderrno(ld))
  88 #elif defined( LDAP_OPT_SIZELIMIT )
  89        /*
  90        ** Netscape SDK w/ ldap_set_option, ldap_get_option
  91        */
  92 #define ldap_attributefree(p) ldap_memfree(p)
  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_attributefree(p)
 103 #define ldap_get_lderrno(ld) (ld->ld_errno)
 104 #define LDAP_ERR_STRING(ld)  \
 105         ldap_err2string(ld->ld_errno)
 106 #endif
 107
 108 typedef struct ldaptclobj {
 109     LDAP        *ldap;
 110     int         flags
 111 } LDAPTCL;
 112
 113 #define LDAPTCL_INTERRCODES     0x001
 114
 115 #include "ldaptclerr.h"
 116
 117 static
 118 LDAP_SetErrorCode(LDAPTCL *ldaptcl, int code, Tcl_Interp *interp)
 119 {
 120     char shortbuf[6];
 121     char *errp;
 122     int   lderrno;
 123
 124     if (code == -1)
 125         code = ldap_get_lderrno(ldaptcl->ldap);
 126     if ((ldaptcl->flags & LDAPTCL_INTERRCODES) || code > LDAPTCL_MAXERR ||
 127       ldaptclerrorcode[code] == NULL) {
 128         sprintf(shortbuf, "0x%03x", code);
 129         errp = shortbuf;
 130     } else
 131         errp = ldaptclerrorcode[code];
 132
 133     Tcl_SetErrorCode(interp, errp, NULL);
 134 }
 135
 136 /*-----------------------------------------------------------------------------
 137  * LDAP_ProcessOneSearchResult --
 138  *
 139  *   Process one result return from an LDAP search.
 140  *
 141  * Paramaters:
 142  *   o interp -            Tcl interpreter; Errors are returned in result.
 143  *   o ldap -              LDAP structure pointer.
 144  *   o entry -             LDAP message pointer.
 145  *   o destArrayNameObj -  Name of Tcl array in which to store attributes.
 146  *   o evalCodeObj -       Tcl_Obj pointer to code to eval against this result.
 147  * Returns:
 148  *   o TCL_OK if processing succeeded..
 149  *   o TCL_ERROR if an error occured, with error message in interp.
 150  *-----------------------------------------------------------------------------
 151  */
 152 static int
 153 LDAP_ProcessOneSearchResult (interp, ldap, entry, destArrayNameObj, evalCodeObj)
 154     Tcl_Interp     *interp;
 155     LDAP           *ldap;
 156     LDAPMessage    *entry;
 157     Tcl_Obj        *destArrayNameObj;
 158     Tcl_Obj        *evalCodeObj;
 159 {
 160     char           *attributeName;
 161     Tcl_Obj        *attributeNameObj;
 162     Tcl_Obj        *attributeDataObj;
 163     int             i;
 164     BerElement     *ber;
 165     struct berval **bvals;
 166     char           *dn;
 167     int             lderrno;
 168
 169     Tcl_UnsetVar (interp, Tcl_GetStringFromObj (destArrayNameObj, NULL), 0);
 170
 171     dn = ldap_get_dn(ldap, entry);
 172     if (dn != NULL) {
 173         if (Tcl_SetVar2(interp,         /* set dn */
 174                        Tcl_GetStringFromObj(destArrayNameObj, NULL),
 175                        "dn",
 176                        dn,
 177                        TCL_LEAVE_ERR_MSG) == NULL)
 178             return TCL_ERROR;
 179         ldap_memfree(dn);
 180     }
 181     for (attributeName = ldap_first_attribute (ldap, entry, &ber);
 182       attributeName != NULL;
 183       attributeName = ldap_next_attribute(ldap, entry, ber)) {
 184
 185         bvals = ldap_get_values_len(ldap, entry, attributeName);
 186
 187         if (bvals != NULL) {
 188             /* Note here that the U.of.M. ldap will return a null bvals
 189                when the last attribute value has been deleted, but still
 190                retains the attributeName.  Even though this is documented
 191                as an error, we ignore it to present a consistent interface
 192                with Netscape's server
 193             */
 194             attributeNameObj = Tcl_NewStringObj (attributeName, -1);
 195             Tcl_IncrRefCount (attributeNameObj);
 196             attributeDataObj = Tcl_NewObj();
 197             for (i = 0; bvals[i] != NULL; i++) {
 198                 Tcl_Obj *singleAttributeValueObj;
 199
 200                 singleAttributeValueObj = Tcl_NewStringObj (bvals[i]->bv_val, -1);
 201                 if (Tcl_ListObjAppendElement (interp,
 202                                               attributeDataObj,
 203                                               singleAttributeValueObj)
 204                   == TCL_ERROR) {
 205                     return TCL_ERROR;
 206                 }
 207             }
 208
 209             ldap_value_free_len(bvals);
 210
 211             if (Tcl_ObjSetVar2 (interp,
 212                                 destArrayNameObj,
 213                                 attributeNameObj,
 214                                 attributeDataObj,
 215                                 TCL_LEAVE_ERR_MSG) == NULL) {
 216                 return TCL_ERROR;
 217             }
 218             Tcl_DecrRefCount (attributeNameObj);
 219         }
 220         ldap_attributefree(attributeName);
 221     }
 222     return Tcl_EvalObj (interp, evalCodeObj);
 223 }
 224
 225 /*-----------------------------------------------------------------------------
 226  * LDAP_PerformSearch --
 227  *
 228  *   Perform an LDAP search.
 229  *
 230  * Paramaters:
 231  *   o interp -            Tcl interpreter; Errors are returned in result.
 232  *   o ldap -              LDAP structure pointer.
 233  *   o base -              Base DN from which to perform search.
 234  *   o scope -             LDAP search scope, must be one of LDAP_SCOPE_BASE,
 235  *                         LDAP_SCOPE_ONELEVEL, or LDAP_SCOPE_SUBTREE.
 236  *   o attrs -             Pointer to array of char * pointers of desired
 237  *                         attribute names, or NULL for all attributes.
 238  *   o filtpatt            LDAP filter pattern.
 239  *   o value               Value to get sprintf'ed into filter pattern.
 240  *   o destArrayNameObj -  Name of Tcl array in which to store attributes.
 241  *   o evalCodeObj -       Tcl_Obj pointer to code to eval against this result.
 242  * Returns:
 243  *   o TCL_OK if processing succeeded..
 244  *   o TCL_ERROR if an error occured, with error message in interp.
 245  *-----------------------------------------------------------------------------
 246  */
 247 static int
 248 LDAP_PerformSearch (interp, ldaptcl, base, scope, attrs, filtpatt, value, destArrayNameObj, evalCodeObj, timeout_p)
 249     Tcl_Interp     *interp;
 250     LDAPTCL        *ldaptcl;
 251     char           *base;
 252     int             scope;
 253     char          **attrs;
 254     char           *filtpatt;
 255     char           *value;
 256     Tcl_Obj        *destArrayNameObj;
 257     Tcl_Obj        *evalCodeObj;
 258     struct timeval *timeout_p;
 259 {
 260     LDAP         *ldap = ldaptcl->ldap;
 261     char          filter[BUFSIZ];
 262     int           resultCode;
 263     int           errorCode;
 264     int           abandon;
 265     int           tclResult = TCL_OK;
 266     int           msgid;
 267     LDAPMessage  *resultMessage;
 268     LDAPMessage  *entryMessage;
 269
 270     Tcl_Obj      *resultObj;
 271     int           lderrno;
 272
 273     resultObj = Tcl_GetObjResult (interp);
 274
 275     sprintf(filter, filtpatt, value);
 276
 277     if ((msgid = ldap_search (ldap, base, scope, filter, attrs, 0)) == -1) {
 278         Tcl_AppendStringsToObj (resultObj,
 279                                 "LDAP start search error: ",
 280                                         LDAP_ERR_STRING(ldap),
 281                                 (char *)NULL);
 282         LDAP_SetErrorCode(ldaptcl, -1, interp);
 283         return TCL_ERROR;
 284     }
 285
 286     abandon = 0;
 287     while ((resultCode = ldap_result (ldap,
 288                               msgid,
 289                               0,
 290                               timeout_p,
 291                               &resultMessage)) == LDAP_RES_SEARCH_ENTRY) {
 292
 293         entryMessage = ldap_first_entry(ldap, resultMessage);
 294
 295         tclResult = LDAP_ProcessOneSearchResult  (interp,
 296                                 ldap,
 297                                 entryMessage,
 298                                 destArrayNameObj,
 299                                 evalCodeObj);
 300         ldap_msgfree(resultMessage);
 301         if (tclResult != TCL_OK) {
 302             if (tclResult == TCL_CONTINUE) {
 303                 tclResult = TCL_OK;
 304             } else if (tclResult == TCL_BREAK) {
 305                 tclResult = TCL_OK;
 306                 abandon = 1;
 307                 break;
 308             } else if (tclResult == TCL_ERROR) {
 309                 char msg[100];
 310                 sprintf(msg, "\n    (\"search\" body line %d)",
 311                         interp->errorLine);
 312                 Tcl_AddObjErrorInfo(interp, msg, -1);
 313                 abandon = 1;
 314                 break;
 315             } else {
 316                 abandon = 1;
 317                 break;
 318             }
 319         }
 320     }
 321     if (abandon || resultCode == 0) {
 322         ldap_abandon(ldap, msgid);
 323         if (resultCode == 0) {
 324             Tcl_SetErrorCode (interp, "TIMEOUT", (char*) NULL);
 325             Tcl_SetStringObj (resultObj, "LDAP timeout retrieving results", -1);
 326             return TCL_ERROR;
 327         }
 328     } else {
 329         if (resultCode == LDAP_RES_SEARCH_RESULT) {
 330             if ((errorCode = ldap_result2error (ldap, resultMessage, 0))
 331               != LDAP_SUCCESS) {
 332               Tcl_AppendStringsToObj (resultObj,
 333                                       "LDAP search error: ",
 334                                       ldap_err2string(errorCode),
 335                                       (char *)NULL);
 336               ldap_msgfree(resultMessage);
 337               LDAP_SetErrorCode(ldaptcl, errorCode, interp);
 338               return TCL_ERROR;
 339             }
 340         }
 341
 342
 343         if (resultCode == -1) {
 344             Tcl_AppendStringsToObj (resultObj,
 345                                     "LDAP result search error: ",
 346                                     LDAP_ERR_STRING(ldap),
 347                                     (char *)NULL);
 348             LDAP_SetErrorCode(ldaptcl, -1, interp);
 349             return TCL_ERROR;
 350         } else
 351             ldap_msgfree(resultMessage);
 352     }
 353
 354     return tclResult;
 355 }
 356
 357 /*-----------------------------------------------------------------------------
 358  * NeoX_LdapTargetObjCmd --
 359  *
 360  * Implements the body of commands created by Neo_LdapObjCmd.
 361  *
 362  * Results:
 363  *      A standard Tcl result.
 364  *
 365  * Side effects:
 366  *      See the user documentation.
 367  *-----------------------------------------------------------------------------
 368  */
 369 static int
 370 NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
 371     ClientData    clientData;
 372     Tcl_Interp   *interp;
 373     int           objc;
 374     Tcl_Obj      *CONST objv[];
 375 {
 376     char         *command;
 377     char         *subCommand;
 378     LDAPTCL      *ldaptcl = (LDAPTCL *)clientData;
 379     LDAP         *ldap = ldaptcl->ldap;
 380     char         *dn;
 381     int           is_add = 0;
 382     int           is_add_or_modify = 0;
 383     int           mod_op = 0;
 384     char         *m, *s, *errmsg;
 385     int          errcode;
 386
 387     Tcl_Obj      *resultObj = Tcl_GetObjResult (interp);
 388
 389     if (objc < 2)
 390        return TclX_WrongArgs (interp,
 391                               objv [0],
 392                               "subcommand [args...]");
 393
 394     command = Tcl_GetStringFromObj (objv[0], NULL);
 395     subCommand = Tcl_GetStringFromObj (objv[1], NULL);
 396
 397     /* object bind authtype name password */
 398     if (STREQU (subCommand, "bind")) {
 399         char     *binddn;
 400         char     *passwd;
 401         int       stringLength;
 402         char     *ldap_authString;
 403         int       ldap_authInt;
 404
 405         if (objc != 5)
 406             return TclX_WrongArgs (interp, objv [0], "bind authtype dn passwd");
 407
 408         ldap_authString = Tcl_GetStringFromObj (objv[2], NULL);
 409
 410         if (STREQU (ldap_authString, "simple")) {
 411             ldap_authInt = LDAP_AUTH_SIMPLE;
 412         }
 413 #ifdef UMICH_LDAP
 414         else if (STREQU (ldap_authString, "kerberos_ldap")) {
 415             ldap_authInt = LDAP_AUTH_KRBV41;
 416         } else if (STREQU (ldap_authString, "kerberos_dsa")) {
 417             ldap_authInt = LDAP_AUTH_KRBV42;
 418         } else if (STREQU (ldap_authString, "kerberos_both")) {
 419             ldap_authInt = LDAP_AUTH_KRBV4;
 420         }
 421 #endif
 422         else {
 423             Tcl_AppendStringsToObj (resultObj,
 424                                     "\"",
 425                                     command,
 426                                     " ",
 427                                     subCommand,
 428 #ifdef UMICH_LDAP
 429                                     "\" authtype must be one of \"simple\", ",
 430                                     "\"kerberos_ldap\", \"kerberos_dsa\" ",
 431                                     "or \"kerberos_both\"",
 432 #else
 433                                     "\" authtype must be \"simple\", ",
 434 #endif
 435                                     (char *)NULL);
 436             return TCL_ERROR;
 437         }
 438
 439         binddn = Tcl_GetStringFromObj (objv[3], &stringLength);
 440         if (stringLength == 0)
 441             binddn = NULL;
 442
 443         passwd = Tcl_GetStringFromObj (objv[4], &stringLength);
 444         if (stringLength == 0)
 445             passwd = NULL;
 446
 447 /*  ldap_bind_s(ldap, dn, pw, method) */
 448
 449 #ifdef UMICH_LDAP
 450 #define LDAP_BIND(ldap, dn, pw, method) \
 451   ldap_bind_s(ldap, dn, pw, method)
 452 #else
 453 #define LDAP_BIND(ldap, dn, pw, method) \
 454   ldap_simple_bind_s(ldap, dn, pw)
 455 #endif
 456         if ((errcode = LDAP_BIND (ldap,
 457                          binddn,
 458                          passwd,
 459                          ldap_authInt)) != LDAP_SUCCESS) {
 460
 461             Tcl_AppendStringsToObj (resultObj,
 462                                     "LDAP bind error: ",
 463                                     ldap_err2string(errcode),
 464                                     (char *)NULL);
 465             LDAP_SetErrorCode(ldaptcl, errcode, interp);
 466             return TCL_ERROR;
 467         }
 468         return TCL_OK;
 469     }
 470
 471     if (STREQU (subCommand, "unbind")) {
 472         if (objc != 2)
 473             return TclX_WrongArgs (interp, objv [0], "unbind");
 474
 475        return Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], NULL));
 476     }
 477
 478     /* object delete dn */
 479     if (STREQU (subCommand, "delete")) {
 480         if (objc != 3)
 481             return TclX_WrongArgs (interp, objv [0], "delete dn");
 482
 483        dn = Tcl_GetStringFromObj (objv [2], NULL);
 484        if ((errcode = ldap_delete_s(ldap, dn)) != LDAP_SUCCESS) {
 485            Tcl_AppendStringsToObj (resultObj,
 486                                    "LDAP delete error: ",
 487                                    ldap_err2string(errcode),
 488                                    (char *)NULL);
 489            LDAP_SetErrorCode(ldaptcl, errcode, interp);
 490            return TCL_ERROR;
 491        }
 492        return TCL_OK;
 493     }
 494
 495     /* object rename_rdn dn rdn */
 496     /* object modify_rdn dn rdn */
 497     if (STREQU (subCommand, "rename_rdn") || STREQU (subCommand, "modify_rdn")) {
 498         char    *rdn;
 499         int      deleteOldRdn;
 500
 501         if (objc != 4)
 502             return TclX_WrongArgs (interp,
 503                                    objv [0],
 504                                    "delete_rdn|modify_rdn dn rdn");
 505
 506         dn = Tcl_GetStringFromObj (objv [2], NULL);
 507         rdn = Tcl_GetStringFromObj (objv [3], NULL);
 508
 509         deleteOldRdn = (*subCommand == 'r');
 510
 511         if ((errcode = ldap_modrdn2_s (ldap, dn, rdn, deleteOldRdn)) != LDAP_SUCCESS) {
 512             Tcl_AppendStringsToObj (resultObj,
 513                                     "LDAP ",
 514                                     subCommand,
 515                                     " error: ",
 516                                     ldap_err2string(errcode),
 517                                     (char *)NULL);
 518             LDAP_SetErrorCode(ldaptcl, errcode, interp);
 519             return TCL_ERROR;
 520         }
 521         return TCL_OK;
 522     }
 523
 524     /* object add dn attributePairList */
 525     /* object add_attributes dn attributePairList */
 526     /* object replace_attributes dn attributePairList */
 527     /* object delete_attributes dn attributePairList */
 528
 529     if (STREQU (subCommand, "add")) {
 530         is_add = 1;
 531         is_add_or_modify = 1;
 532     } else {
 533         is_add = 0;
 534         if (STREQU (subCommand, "add_attributes")) {
 535             is_add_or_modify = 1;
 536             mod_op = LDAP_MOD_ADD;
 537         } else if (STREQU (subCommand, "replace_attributes")) {
 538             is_add_or_modify = 1;
 539             mod_op = LDAP_MOD_REPLACE;
 540         } else if (STREQU (subCommand, "delete_attributes")) {
 541             is_add_or_modify = 1;
 542             mod_op = LDAP_MOD_DELETE;
 543         }
 544     }
 545
 546     if (is_add_or_modify) {
 547         int          result;
 548         LDAPMod    **modArray;
 549         LDAPMod     *mod;
 550         char       **valPtrs = NULL;
 551         int          attribObjc;
 552         Tcl_Obj    **attribObjv;
 553         int          valuesObjc;
 554         Tcl_Obj    **valuesObjv;
 555         int          nPairs;
 556         int          i;
 557         int          j;
 558
 559         Tcl_Obj      *resultObj = Tcl_GetObjResult (interp);
 560
 561         if (objc != 4) {
 562             Tcl_AppendStringsToObj (resultObj,
 563                                     "wrong # args: ",
 564                                     Tcl_GetStringFromObj (objv [0], NULL),
 565                                     " ",
 566                                     subCommand,
 567                                     " dn attributePairList",
 568                                     (char *)NULL);
 569             return TCL_ERROR;
 570         }
 571
 572         dn = Tcl_GetStringFromObj (objv [2], NULL);
 573
 574         if (Tcl_ListObjGetElements (interp, objv [3], &attribObjc, &attribObjv)
 575           == TCL_ERROR) {
 576            return TCL_ERROR;
 577         }
 578
 579         if (attribObjc & 1) {
 580             Tcl_AppendStringsToObj (resultObj,
 581                                     "attribute list does not contain an ",
 582                                     "even number of key-value elements",
 583                                     (char *)NULL);
 584             return TCL_ERROR;
 585         }
 586
 587         nPairs = attribObjc / 2;
 588
 589         modArray = (LDAPMod **)ckalloc (sizeof(LDAPMod *) * (nPairs + 1));
 590         modArray[nPairs] = (LDAPMod *) NULL;
 591
 592         for (i = 0; i < nPairs; i++) {
 593             mod = modArray[i] = (LDAPMod *) ckalloc (sizeof(LDAPMod));
 594             mod->mod_op = mod_op;
 595             mod->mod_type = Tcl_GetStringFromObj (attribObjv [i * 2], NULL);
 596
 597             if (Tcl_ListObjGetElements (interp, attribObjv [i * 2 + 1], &valuesObjc, &valuesObjv) == TCL_ERROR) {
 598                 /* FIX: cleanup memory here */
 599                 return TCL_ERROR;
 600             }
 601
 602             valPtrs = mod->mod_vals.modv_strvals = \
 603                 (char **)ckalloc (sizeof (char *) * (valuesObjc + 1));
 604             valPtrs[valuesObjc] = (char *)NULL;
 605
 606             for (j = 0; j < valuesObjc; j++) {
 607                 valPtrs [j] = Tcl_GetStringFromObj (valuesObjv[j], NULL);
 608
 609                 /* If it's "delete" and value is an empty string, make
 610                  * value be NULL to indicate entire attribute is to be
 611                  * deleted */
 612                 if ((*valPtrs [j] == '\0')
 613                     && (mod->mod_op == LDAP_MOD_DELETE)) {
 614                         valPtrs [j] = NULL;
 615                 }
 616             }
 617         }
 618
 619         if (is_add) {
 620             result = ldap_add_s (ldap, dn, modArray);
 621         } else {
 622             result = ldap_modify_s (ldap, dn, modArray);
 623         }
 624
 625         /* free the modArray elements, then the modArray itself. */
 626         for (i = 0; i < nPairs; i++) {
 627             ckfree ((char *) modArray[i]->mod_vals.modv_strvals);
 628             ckfree ((char *) modArray[i]);
 629         }
 630         ckfree ((char *) modArray);
 631
 632         /* FIX: memory cleanup required all over the place here */
 633         if (result != LDAP_SUCCESS) {
 634             Tcl_AppendStringsToObj (resultObj,
 635                                     "LDAP ",
 636                                     subCommand,
 637                                     " error: ",
 638                                     ldap_err2string(result),
 639                                     (char *)NULL);
 640             LDAP_SetErrorCode(ldaptcl, result, interp);
 641             return TCL_ERROR;
 642         }
 643         return TCL_OK;
 644     }
 645
 646     /* object search controlArray dn pattern */
 647     if (STREQU (subCommand, "search")) {
 648         char        *controlArrayName;
 649         Tcl_Obj     *controlArrayNameObj;
 650
 651         char        *scopeString;
 652         int          scope;
 653
 654         char        *derefString;
 655         int          deref;
 656
 657         char        *baseString;
 658
 659         char       **attributesArray;
 660         char        *attributesString;
 661         int          attributesArgc;
 662
 663         char        *filterPatternString;
 664
 665         char        *timeoutString;
 666         double       timeoutTime;
 667         struct timeval timeout, *timeout_p;
 668
 669         Tcl_Obj     *destArrayNameObj;
 670         Tcl_Obj     *evalCodeObj;
 671
 672         if (objc != 5)
 673             return TclX_WrongArgs (interp,
 674                                    objv [0],
 675                                    "search controlArray destArray code");
 676
 677         controlArrayNameObj = objv [2];
 678         controlArrayName = Tcl_GetStringFromObj (controlArrayNameObj, NULL);
 679
 680         destArrayNameObj = objv [3];
 681
 682         evalCodeObj = objv [4];
 683
 684         baseString = Tcl_GetVar2 (interp,
 685                                   controlArrayName,
 686                                   "base",
 687                                   0);
 688
 689         if (baseString == (char *)NULL) {
 690             Tcl_AppendStringsToObj (resultObj,
 691                                     "required element \"base\" ",
 692                                     "is missing from ldap control array \"",
 693                                     controlArrayName,
 694                                     "\"",
 695                                     (char *)NULL);
 696             return TCL_ERROR;
 697         }
 698
 699         filterPatternString = Tcl_GetVar2 (interp,
 700                                            controlArrayName,
 701                                            "filter",
 702                                            0);
 703         if (filterPatternString == (char *)NULL) {
 704             filterPatternString = "objectclass=*";
 705         }
 706
 707         /* Fetch scope setting from control array.
 708          * If it doesn't exist, default to subtree scoping.
 709          */
 710         scopeString = Tcl_GetVar2 (interp, controlArrayName, "scope", 0);
 711         if (scopeString == NULL) {
 712             scope = LDAP_SCOPE_SUBTREE;
 713         } else {
 714             if (STREQU(scopeString, "base"))
 715                 scope = LDAP_SCOPE_BASE;
 716             else if (STRNEQU(scopeString, "one", 3))
 717                 scope = LDAP_SCOPE_ONELEVEL;
 718             else if (STRNEQU(scopeString, "sub", 3))
 719                 scope = LDAP_SCOPE_SUBTREE;
 720             else {
 721                 Tcl_AppendStringsToObj (resultObj,
 722                                         "\"scope\" element of \"",
 723                                         controlArrayName,
 724                                         "\" array is not one of ",
 725                                         "\"base\", \"onelevel\", ",
 726                                         "or \"subtree\"",
 727                                       (char *) NULL);
 728                 return TCL_ERROR;
 729             }
 730         }
 731
 732         /* Fetch dereference control setting from control array.
 733          * If it doesn't exist, default to never dereference. */
 734         derefString = Tcl_GetVar2 (interp,
 735                                    controlArrayName,
 736                                    "deref",
 737                                    0);
 738
 739         if (derefString == (char *)NULL) {
 740             deref = LDAP_DEREF_NEVER;
 741         } else {
 742             if (STREQU(derefString, "never"))
 743                 deref = LDAP_DEREF_NEVER;
 744             else if (STREQU(derefString, "search"))
 745                 deref = LDAP_DEREF_SEARCHING;
 746             else if (STREQU(derefString, "find") == 0)
 747                 deref = LDAP_DEREF_FINDING;
 748             else if (STREQU(derefString, "always"))
 749                 deref = LDAP_DEREF_ALWAYS;
 750             else {
 751                 Tcl_AppendStringsToObj (resultObj,
 752                                         "\"deref\" element of \"",
 753                                         controlArrayName,
 754                                         "\" array is not one of ",
 755                                         "\"never\", \"search\", \"find\", ",
 756                                         "or \"always\"",
 757                                         (char *) NULL);
 758                 return TCL_ERROR;
 759             }
 760         }
 761
 762         /* Fetch list of attribute names from control array.
 763          * If entry doesn't exist, default to NULL (all).
 764          */
 765         attributesString = Tcl_GetVar2 (interp,
 766                                         controlArrayName,
 767                                         "attributes",
 768                                         0);
 769         if (attributesString == (char *)NULL) {
 770             attributesArray = NULL;
 771         } else {
 772             if ((Tcl_SplitList (interp,
 773                                 attributesString,
 774                                 &attributesArgc,
 775                                 &attributesArray)) != TCL_OK) {
 776                 return TCL_ERROR;
 777             }
 778         }
 779
 780         /* Fetch timeout value if there is one
 781          */
 782         timeoutString = Tcl_GetVar2 (interp,
 783                                         controlArrayName,
 784                                         "timeout",
 785                                         0);
 786         timeout.tv_usec = 0;
 787         if (timeoutString == (char *)NULL) {
 788             timeout_p = NULL;
 789             timeout.tv_sec = 0;
 790         } else {
 791             if (Tcl_GetDouble(interp, timeoutString, &timeoutTime) != TCL_OK)
 792                 return TCL_ERROR;
 793             timeout.tv_sec = floor(timeoutTime);
 794             timeout.tv_usec = (timeoutTime-timeout.tv_sec) * 1000000;
 795             timeout_p = &timeout;
 796         }
 797
 798 #ifdef UMICH_LDAP
 799         ldap->ld_deref = deref;
 800         ldap->ld_timelimit = 0;
 801         ldap->ld_sizelimit = 0;
 802         ldap->ld_options = 0;
 803 #endif
 804
 805          return LDAP_PerformSearch (interp,
 806                                     ldaptcl,
 807                                     baseString,
 808                                     scope,
 809                                     attributesArray,
 810                                     filterPatternString,
 811                                     "",
 812                                     destArrayNameObj,
 813                                     evalCodeObj,
 814                                     timeout_p);
 815     }
 816
 817 #if defined(UMICH_LDAP) || (defined(OPEN_LDAP) && !defined(LDAP_API_VERSION))
 818     if (STREQU (subCommand, "cache")) {
 819         char *cacheCommand;
 820
 821         if (objc < 3)
 822           badargs:
 823             return TclX_WrongArgs (interp,
 824                                    objv [0],
 825                                    "cache command [args...]");
 826
 827         cacheCommand = Tcl_GetStringFromObj (objv [2], NULL);
 828
 829         if (STREQU (cacheCommand, "uncache")) {
 830             char *dn;
 831
 832             if (objc != 4)
 833                 return TclX_WrongArgs (interp,
 834                                        objv [0],
 835                                        "cache uncache dn");
 836
 837             dn = Tcl_GetStringFromObj (objv [3], NULL);
 838             ldap_uncache_entry (ldap, dn);
 839             return TCL_OK;
 840         }
 841
 842         if (STREQU (cacheCommand, "enable")) {
 843             long   timeout;
 844             long   maxmem;
 845
 846             if (objc != 5)
 847                 return TclX_WrongArgs (interp,
 848                                        objv [0],
 849                                        "cache enable timeout maxmem");
 850
 851             if (Tcl_GetLongFromObj (interp, objv [3], &timeout) == TCL_ERROR)
 852                 return TCL_ERROR;
 853
 854             if (Tcl_GetLongFromObj (interp, objv [4], &maxmem) == TCL_ERROR)
 855                 return TCL_ERROR;
 856
 857             if (ldap_enable_cache (ldap, timeout, maxmem) == -1) {
 858                 Tcl_AppendStringsToObj (resultObj,
 859                                         "LDAP cache enable error: ",
 860                                         LDAP_ERR_STRING(ldap),
 861                                         (char *)NULL);
 862                 LDAP_SetErrorCode(ldaptcl, -1, interp);
 863                 return TCL_ERROR;
 864             }
 865             return TCL_OK;
 866         }
 867
 868         if (objc != 3) goto badargs;
 869
 870         if (STREQU (cacheCommand, "disable")) {
 871             ldap_disable_cache (ldap);
 872             return TCL_OK;
 873         }
 874
 875         if (STREQU (cacheCommand, "destroy")) {
 876             ldap_destroy_cache (ldap);
 877             return TCL_OK;
 878         }
 879
 880         if (STREQU (cacheCommand, "flush")) {
 881             ldap_flush_cache (ldap);
 882             return TCL_OK;
 883         }
 884
 885         if (STREQU (cacheCommand, "no_errors")) {
 886             ldap_set_cache_options (ldap, LDAP_CACHE_OPT_CACHENOERRS);
 887             return TCL_OK;
 888         }
 889
 890         if (STREQU (cacheCommand, "all_errors")) {
 891             ldap_set_cache_options (ldap, LDAP_CACHE_OPT_CACHEALLERRS);
 892             return TCL_OK;
 893         }
 894
 895         if (STREQU (cacheCommand, "size_errors")) {
 896             ldap_set_cache_options (ldap, 0);
 897             return TCL_OK;
 898         }
 899         Tcl_AppendStringsToObj (resultObj,
 900                                 "\"",
 901                                 command,
 902                                 " ",
 903                                 subCommand,
 904                                 "\" subcommand",
 905                                 " must be one of \"enable\", ",
 906                                 "\"disable\", ",
 907                                 "\"destroy\", \"flush\", \"uncache\", ",
 908                                 "\"no_errors\", \"size_errors\",",
 909                                 " or \"all_errors\"",
 910                                 (char *)NULL);
 911         return TCL_ERROR;
 912     }
 913 #endif
 914 #ifdef LDAP_DEBUG
 915     if (STREQU (subCommand, "debug")) {
 916         if (objc != 3) {
 917             Tcl_AppendStringsToObj(resultObj, "Wrong # of arguments",
 918                 (char*)NULL);
 919             return TCL_ERROR;
 920         }
 921         return Tcl_GetIntFromObj(interp, objv[2], &ldap_debug);
 922     }
 923 #endif
 924
 925     /* FIX: this needs to enumerate all the possibilities */
 926     Tcl_AppendStringsToObj (resultObj,
 927                             "subcommand \"",
 928                             subCommand,
 929                             "\" must be one of \"add\", ",
 930                             "\"add_attributes\", ",
 931                             "\"bind\", \"cache\", \"delete\", ",
 932                             "\"delete_attributes\", \"modify\", ",
 933                             "\"modify_rdn\", \"rename_rdn\", ",
 934                             "\"replace_attributes\", ",
 935                             "\"search\" or \"unbind\".",
 936                             (char *)NULL);
 937     return TCL_ERROR;
 938 }
 939
 940 /*
 941  * Delete and LDAP command object
 942  *
 943  */
 944 static void
 945 NeoX_LdapObjDeleteCmd(clientData)
 946     ClientData    clientData;
 947 {
 948     LDAPTCL      *ldaptcl = (LDAPTCL *)clientData;
 949     LDAP         *ldap = ldaptcl->ldap;
 950
 951     ldap_unbind(ldap);
 952     ckfree((char*) ldaptcl);
 953 }
 954
 955 /*-----------------------------------------------------------------------------
 956  * NeoX_LdapObjCmd --
 957  *
 958  * Implements the `ldap' command:
 959  *    ldap open newObjName host [port]
 960  *    ldap init newObjName host [port]
 961  *
 962  * Results:
 963  *      A standard Tcl result.
 964  *
 965  * Side effects:
 966  *      See the user documentation.
 967  *-----------------------------------------------------------------------------
 968  */
 969 static int
 970 NeoX_LdapObjCmd (clientData, interp, objc, objv)
 971     ClientData    clientData;
 972     Tcl_Interp   *interp;
 973     int           objc;
 974     Tcl_Obj      *CONST objv[];
 975 {
 976     extern int    errno;
 977     char         *subCommand;
 978     char         *newCommand;
 979     char         *ldapHost;
 980     int           ldapPort = 389;
 981     LDAP         *ldap;
 982     LDAPTCL      *ldaptcl;
 983
 984     Tcl_Obj      *resultObj = Tcl_GetObjResult (interp);
 985
 986     if (objc < 3 || objc > 5)
 987         return TclX_WrongArgs (interp, objv [0],
 988                                "(open|init) new_command host [port]|explode dn");
 989
 990     subCommand = Tcl_GetStringFromObj (objv[1], NULL);
 991
 992     if (STREQU(subCommand, "explode")) {
 993         char *param;
 994         int nonames = 0;
 995         int list = 0;
 996         char **exploded, **p;
 997
 998         param = Tcl_GetStringFromObj (objv[2], NULL);
 999         if (param[0] == '-') {
1000             if (STREQU(param, "-nonames")) {
1001                 nonames = 1;
1002             } else if (STREQU(param, "-list")) {
1003                 list = 1;
1004             } else {
1005                 return TclX_WrongArgs (interp, objv [0], "explode ?-nonames|-list? dn");
1006             }
1007         }
1008         if (nonames || list)
1009             param = Tcl_GetStringFromObj (objv[3], NULL);
1010         exploded = ldap_explode_dn(param, nonames);
1011         for (p = exploded; *p; p++) {
1012             if (list) {
1013                 char *q = strchr(*p, '=');
1014                 if (!q) {
1015                     Tcl_SetObjLength(resultObj, 0);
1016                     Tcl_AppendStringsToObj(resultObj, "rdn ", *p,
1017                         " missing '='", NULL);
1018                     ldap_value_free(exploded);
1019                     return TCL_ERROR;
1020                 }
1021                 *q = '\0';
1022                 if (Tcl_ListObjAppendElement(interp, resultObj,
1023                         Tcl_NewStringObj(*p, -1)) != TCL_OK ||
1024                         Tcl_ListObjAppendElement(interp, resultObj,
1025                         Tcl_NewStringObj(q+1, -1)) != TCL_OK) {
1026                     ldap_value_free(exploded);
1027                     return TCL_ERROR;
1028                 }
1029             } else {
1030                 if (Tcl_ListObjAppendElement(interp, resultObj,
1031                         Tcl_NewStringObj(*p, -1))) {
1032                     ldap_value_free(exploded);
1033                     return TCL_ERROR;
1034                 }
1035             }
1036         }
1037         ldap_value_free(exploded);
1038         return TCL_OK;
1039     }
1040
1041 #ifdef UMICH_LDAP
1042     if (STREQU(subCommand, "friendly")) {
1043         char *friendly = ldap_dn2ufn(Tcl_GetStringFromObj(objv[2], NULL));
1044         Tcl_SetStringObj(resultObj, friendly, -1);
1045         free(friendly);
1046         return TCL_OK;
1047     }
1048 #endif
1049
1050     newCommand = Tcl_GetStringFromObj (objv[2], NULL);
1051     ldapHost = Tcl_GetStringFromObj (objv[3], NULL);
1052
1053     if (objc == 5) {
1054         if (Tcl_GetIntFromObj (interp, objv [4], &ldapPort) == TCL_ERROR) {
1055             Tcl_AppendStringsToObj (resultObj,
1056                                     "LDAP port number is non-numeric",
1057                                     (char *)NULL);
1058             return TCL_ERROR;
1059         }
1060     }
1061
1062     if (STREQU (subCommand, "open")) {
1063         ldap = ldap_open (ldapHost, ldapPort);
1064     } else if (STREQU (subCommand, "init")) {
1065         ldap = ldap_init (ldapHost, ldapPort);
1066     } else {
1067         Tcl_AppendStringsToObj (resultObj,
1068                                 "option was not \"open\" or \"init\"");
1069         return TCL_ERROR;
1070     }
1071
1072     if (ldap == (LDAP *)NULL) {
1073         Tcl_SetErrno(errno);
1074         Tcl_AppendStringsToObj (resultObj,
1075                                 Tcl_PosixError (interp),
1076                                 (char *)NULL);
1077         return TCL_ERROR;
1078     }
1079
1080 #if UMICH_LDAP
1081     ldap->ld_deref = LDAP_DEREF_NEVER;  /* Turn off alias dereferencing */
1082 #endif
1083
1084     ldaptcl = (LDAPTCL *) ckalloc(sizeof(LDAPTCL));
1085     ldaptcl->ldap = ldap;
1086     ldaptcl->flags = 0;
1087
1088     Tcl_CreateObjCommand (interp,
1089                           newCommand,
1090                           NeoX_LdapTargetObjCmd,
1091                           (ClientData) ldaptcl,
1092                           NeoX_LdapObjDeleteCmd);
1093     return TCL_OK;
1094 }
1095
1096 /*-----------------------------------------------------------------------------
1097  * Neo_initLDAP --
1098  *     Initialize the LDAP interface.
1099  *-----------------------------------------------------------------------------
1100  */
1101 int
1102 Ldaptcl_Init (interp)
1103 Tcl_Interp   *interp;
1104 {
1105     Tcl_CreateObjCommand (interp,
1106                           "ldap",
1107                           NeoX_LdapObjCmd,
1108                           (ClientData) NULL,
1109                           (Tcl_CmdDeleteProc*) NULL);
1110     Tcl_PkgProvide(interp, "Ldaptcl", VERSION);
1111     return TCL_OK;
1112 }