Back to index

openldap  2.4.31
neoXldap.c
Go to the documentation of this file.
00001 /*
00002  * NeoSoft Tcl client extensions to Lightweight Directory Access Protocol.
00003  * 
00004  * Copyright (c) 1998-1999 NeoSoft, Inc.  
00005  * All Rights Reserved.
00006  * 
00007  * This software may be used, modified, copied, distributed, and sold,
00008  * in both source and binary form provided that these copyrights are
00009  * retained and their terms are followed.
00010  * 
00011  * Under no circumstances are the authors or NeoSoft Inc. responsible
00012  * for the proper functioning of this software, nor do the authors
00013  * assume any liability for damages incurred with its use.
00014  * 
00015  * Redistribution and use in source and binary forms are permitted
00016  * provided that this notice is preserved and that due credit is given
00017  * to NeoSoft, Inc.
00018  * 
00019  * NeoSoft, Inc. may not be used to endorse or promote products derived
00020  * from this software without specific prior written permission. This
00021  * software is provided ``as is'' without express or implied warranty.
00022  * 
00023  * Requests for permission may be sent to NeoSoft Inc, 1770 St. James Place,
00024  * Suite 500, Houston, TX, 77056.
00025  *
00026  * $OpenLDAP$
00027  *
00028  */
00029 
00030 /*
00031  * This code was originally developed by Karl Lehenbauer to work with
00032  * Umich-3.3 LDAP.  It was debugged against the Netscape LDAP server
00033  * and their much more reliable SDK, and again backported to the
00034  * Umich-3.3 client code.  The UMICH_LDAP define is used to include
00035  * code that will work with the Umich-3.3 LDAP, but not with Netscape's
00036  * SDK.  OpenLDAP may support some of these, but they have not been tested.
00037  * Currently supported by Randy Kunkee (kunkee@OpenLDAP.org).
00038  */
00039 
00040 /*
00041  * Add timeout to controlArray to set timeout for ldap_result.
00042  * 4/14/99 - Randy
00043  */
00044 
00045 #include "tclExtend.h"
00046 
00047 #include <lber.h>
00048 #include <ldap.h>
00049 #include <string.h>
00050 #include <sys/time.h>
00051 #include <math.h>
00052 
00053 /*
00054  * Macros to do string compares.  They pre-check the first character before
00055  * checking of the strings are equal.
00056  */
00057 
00058 #define STREQU(str1, str2) \
00059        (((str1) [0] == (str2) [0]) && (strcmp (str1, str2) == 0))
00060 #define STRNEQU(str1, str2, n) \
00061        (((str1) [0] == (str2) [0]) && (strncmp (str1, str2, n) == 0))
00062 
00063 /*
00064  * The following section defines some common macros used by the rest
00065  * of the code.  It's ugly, and can use some work.  This code was
00066  * originally developed to work with Umich-3.3 LDAP.  It was debugged
00067  * against the Netscape LDAP server and the much more reliable SDK,
00068  * and then again backported to the Umich-3.3 client code.
00069  */
00070 #define OPEN_LDAP 1
00071 #if defined(OPEN_LDAP)
00072        /* LDAP_API_VERSION must be defined per the current draft spec
00073        ** it's value will be assigned RFC number.  However, as
00074        ** no RFC is defined, it's value is currently implementation
00075        ** specific (though I would hope it's value is greater than 1823).
00076        ** In OpenLDAP 2.x-devel, its 2000 + the draft number, ie 2002.
00077        ** This section is for OPENLDAP.
00078        */
00079 #ifndef LDAP_API_FEATURE_X_OPENLDAP
00080 #define ldap_memfree(p) free(p)
00081 #endif
00082 #ifdef LDAP_OPT_ERROR_NUMBER
00083 #define ldap_get_lderrno(ld)       (ldap_get_option(ld, LDAP_OPT_ERROR_NUMBER, &lderrno), lderrno)
00084 #else
00085 #define ldap_get_lderrno(ld) (ld->ld_errno)
00086 #endif
00087 #define LDAP_ERR_STRING(ld)  \
00088        ldap_err2string(ldap_get_lderrno(ld))
00089 #elif defined( LDAP_OPT_SIZELIMIT )
00090        /*
00091        ** Netscape SDK w/ ldap_set_option, ldap_get_option
00092        */
00093 #define LDAP_ERR_STRING(ld)  \
00094        ldap_err2string(ldap_get_lderrno(ldap))
00095 #else
00096        /* U-Mich/OpenLDAP 1.x API */
00097        /* RFC-1823 w/ changes */
00098 #define UMICH_LDAP 1
00099 #define ldap_memfree(p) free(p)
00100 #define ldap_ber_free(p, n) ber_free(p, n)
00101 #define ldap_value_free_len(bvals) ber_bvecfree(bvals)
00102 #define ldap_get_lderrno(ld) (ld->ld_errno)
00103 #define LDAP_ERR_STRING(ld)  \
00104        ldap_err2string(ld->ld_errno)
00105 #endif
00106 
00107 typedef struct ldaptclobj {
00108     LDAP      *ldap;
00109     int              caching;      /* flag 1/0 if caching is enabled */
00110     long      timeout;      /* timeout from last cache enable */
00111     long      maxmem;              /* maxmem from last cache enable */
00112     Tcl_Obj   *trapCmdObj;  /* error handler */
00113     int              *traplist;    /* list of errorCodes to trap */
00114     int              flags;
00115 } LDAPTCL;
00116 
00117 
00118 #define LDAPTCL_INTERRCODES 0x001
00119 
00120 #include "ldaptclerr.h"
00121 
00122 static
00123 LDAP_SetErrorCode(LDAPTCL *ldaptcl, int code, Tcl_Interp *interp)
00124 {
00125     char shortbuf[16];
00126     char *errp;
00127     int   lderrno;
00128 
00129     if (code == -1)
00130        code = ldap_get_lderrno(ldaptcl->ldap);
00131     if ((ldaptcl->flags & LDAPTCL_INTERRCODES) || code > LDAPTCL_MAXERR ||
00132       ldaptclerrorcode[code] == NULL) {
00133        sprintf(shortbuf, "0x%03x", code);
00134        errp = shortbuf;
00135     } else
00136        errp = ldaptclerrorcode[code];
00137 
00138     Tcl_SetErrorCode(interp, errp, NULL);
00139     if (ldaptcl->trapCmdObj) {
00140        int *i;
00141        Tcl_Obj *cmdObj;
00142        if (ldaptcl->traplist != NULL) {
00143            for (i = ldaptcl->traplist; *i && *i != code; i++)
00144               ;
00145            if (*i == 0) return;
00146        }
00147        (void) Tcl_EvalObj(interp, ldaptcl->trapCmdObj);
00148     }
00149 }
00150 
00151 static
00152 LDAP_ErrorStringToCode(Tcl_Interp *interp, char *s)
00153 {
00154     int offset;
00155     int code;
00156 
00157     offset = (strncasecmp(s, "LDAP_", 5) == 0) ? 0 : 5;
00158     for (code = 0; code < LDAPTCL_MAXERR; code++) {
00159        if (!ldaptclerrorcode[code]) continue;
00160        if (strcasecmp(s, ldaptclerrorcode[code]+offset) == 0)
00161            return code;
00162     }
00163     Tcl_ResetResult(interp);
00164     Tcl_AppendResult(interp, s, " is an invalid code", (char *) NULL);
00165     return -1;
00166 }
00167 
00168 /*-----------------------------------------------------------------------------
00169  * LDAP_ProcessOneSearchResult --
00170  * 
00171  *   Process one result return from an LDAP search.
00172  *
00173  * Paramaters:
00174  *   o interp -            Tcl interpreter; Errors are returned in result.
00175  *   o ldap -              LDAP structure pointer.
00176  *   o entry -             LDAP message pointer.
00177  *   o destArrayNameObj -  Name of Tcl array in which to store attributes.
00178  *   o evalCodeObj -       Tcl_Obj pointer to code to eval against this result.
00179  * Returns:
00180  *   o TCL_OK if processing succeeded..
00181  *   o TCL_ERROR if an error occured, with error message in interp.
00182  *-----------------------------------------------------------------------------
00183  */
00184 int
00185 LDAP_ProcessOneSearchResult (interp, ldap, entry, destArrayNameObj, evalCodeObj)
00186     Tcl_Interp     *interp;
00187     LDAP           *ldap;
00188     LDAPMessage    *entry;
00189     Tcl_Obj        *destArrayNameObj;
00190     Tcl_Obj        *evalCodeObj;
00191 {
00192     char           *attributeName;
00193     Tcl_Obj        *attributeNameObj;
00194     Tcl_Obj        *attributeDataObj;
00195     int             i; 
00196     BerElement     *ber; 
00197     struct berval **bvals;
00198     char         *dn;
00199     int                  lderrno;
00200 
00201     Tcl_UnsetVar (interp, Tcl_GetStringFromObj (destArrayNameObj, NULL), 0);
00202 
00203     dn = ldap_get_dn(ldap, entry);
00204     if (dn != NULL) {
00205        if (Tcl_SetVar2(interp,            /* set dn */
00206                      Tcl_GetStringFromObj(destArrayNameObj, NULL),
00207                      "dn",
00208                      dn,
00209                      TCL_LEAVE_ERR_MSG) == NULL)
00210            return TCL_ERROR;
00211        ldap_memfree(dn);
00212     }
00213     attributeNameObj = Tcl_NewObj();
00214     Tcl_IncrRefCount (attributeNameObj);
00215 
00216     /* Note that attributeName below is allocated for OL2+ libldap, so it
00217        must be freed with ldap_memfree().  Test below is admittedly a hack.
00218     */
00219 
00220     for (attributeName = ldap_first_attribute (ldap, entry, &ber); 
00221       attributeName != NULL;
00222       attributeName = ldap_next_attribute(ldap, entry, ber)) {
00223 
00224        bvals = ldap_get_values_len(ldap, entry, attributeName);
00225 
00226        if (bvals != NULL) {
00227            /* Note here that the U.of.M. ldap will return a null bvals
00228               when the last attribute value has been deleted, but still
00229               retains the attributeName.  Even though this is documented
00230               as an error, we ignore it to present a consistent interface
00231               with Netscape's server
00232            */
00233            attributeDataObj = Tcl_NewObj();
00234            Tcl_SetStringObj(attributeNameObj, attributeName, -1);
00235 #if LDAP_API_VERSION >= 2004
00236            ldap_memfree(attributeName);   /* free if newer API */
00237 #endif
00238            for (i = 0; bvals[i] != NULL; i++) {
00239               Tcl_Obj *singleAttributeValueObj;
00240 
00241               singleAttributeValueObj = Tcl_NewStringObj(bvals[i]->bv_val, bvals[i]->bv_len);
00242               if (Tcl_ListObjAppendElement (interp, 
00243                                          attributeDataObj, 
00244                                          singleAttributeValueObj) 
00245                 == TCL_ERROR) {
00246                   ber_free(ber, 0);
00247                   return TCL_ERROR;
00248               }
00249            }
00250 
00251            ldap_value_free_len(bvals);
00252 
00253            if (Tcl_ObjSetVar2 (interp, 
00254                             destArrayNameObj,
00255                             attributeNameObj,
00256                             attributeDataObj,
00257                             TCL_LEAVE_ERR_MSG) == NULL) {
00258               return TCL_ERROR;
00259            }
00260        }
00261     }
00262     Tcl_DecrRefCount (attributeNameObj);
00263     return Tcl_EvalObj (interp, evalCodeObj);
00264 }
00265 
00266 /*-----------------------------------------------------------------------------
00267  * LDAP_PerformSearch --
00268  * 
00269  *   Perform an LDAP search.
00270  *
00271  * Paramaters:
00272  *   o interp -            Tcl interpreter; Errors are returned in result.
00273  *   o ldap -              LDAP structure pointer.
00274  *   o base -              Base DN from which to perform search.
00275  *   o scope -             LDAP search scope, must be one of LDAP_SCOPE_BASE,
00276  *                         LDAP_SCOPE_ONELEVEL, or LDAP_SCOPE_SUBTREE.
00277  *   o attrs -             Pointer to array of char * pointers of desired
00278  *                         attribute names, or NULL for all attributes.
00279  *   o filtpatt            LDAP filter pattern.
00280  *   o value               Value to get sprintf'ed into filter pattern.
00281  *   o destArrayNameObj -  Name of Tcl array in which to store attributes.
00282  *   o evalCodeObj -       Tcl_Obj pointer to code to eval against this result.
00283  * Returns:
00284  *   o TCL_OK if processing succeeded..
00285  *   o TCL_ERROR if an error occured, with error message in interp.
00286  *-----------------------------------------------------------------------------
00287  */
00288 int 
00289 LDAP_PerformSearch (interp, ldaptcl, base, scope, attrs, filtpatt, value,
00290        destArrayNameObj, evalCodeObj, timeout_p, all, sortattr)
00291     Tcl_Interp     *interp;
00292     LDAPTCL        *ldaptcl;
00293     char           *base;
00294     int             scope;
00295     char          **attrs;
00296     char           *filtpatt;
00297     char           *value;
00298     Tcl_Obj        *destArrayNameObj;
00299     Tcl_Obj        *evalCodeObj;
00300     struct timeval *timeout_p;
00301     int                  all;
00302     char         *sortattr;
00303 {
00304     LDAP       *ldap = ldaptcl->ldap;
00305     char          filter[BUFSIZ];
00306     int           resultCode;
00307     int           errorCode;
00308     int                abandon;
00309     int                tclResult = TCL_OK;
00310     int                msgid;
00311     LDAPMessage  *resultMessage = 0;
00312     LDAPMessage  *entryMessage = 0;
00313     char        *sortKey;
00314 
00315     int                lderrno;
00316 
00317     sprintf(filter, filtpatt, value);
00318 
00319     fflush(stderr);
00320     if ((msgid = ldap_search (ldap, base, scope, filter, attrs, 0)) == -1) {
00321        Tcl_AppendResult (interp,
00322                              "LDAP start search error: ",
00323                                    LDAP_ERR_STRING(ldap),
00324                              (char *)NULL);
00325        LDAP_SetErrorCode(ldaptcl, -1, interp);
00326        return TCL_ERROR;
00327     }
00328 
00329     abandon = 0;
00330     if (sortattr)
00331        all = 1;
00332     tclResult = TCL_OK;
00333     while (!abandon) {
00334        resultCode = ldap_result (ldap, msgid, all, timeout_p, &resultMessage);
00335        if (resultCode != LDAP_RES_SEARCH_RESULT &&
00336            resultCode != LDAP_RES_SEARCH_ENTRY)
00337               break;
00338 
00339        if (sortattr) {
00340            sortKey = (strcasecmp(sortattr, "dn") == 0) ? NULL : sortattr;
00341            ldap_sort_entries(ldap, &resultMessage, sortKey, strcasecmp);
00342        }
00343        entryMessage = ldap_first_entry(ldap, resultMessage);
00344 
00345        while (entryMessage) {
00346            tclResult = LDAP_ProcessOneSearchResult  (interp, 
00347                                 ldap, 
00348                                 entryMessage,
00349                                 destArrayNameObj,
00350                                 evalCodeObj);
00351            if (tclResult != TCL_OK) {
00352               if (tclResult == TCL_CONTINUE) {
00353                   tclResult = TCL_OK;
00354               } else if (tclResult == TCL_BREAK) {
00355                   tclResult = TCL_OK;
00356                   abandon = 1;
00357                   break;
00358               } else if (tclResult == TCL_ERROR) {
00359                   char msg[100];
00360                   sprintf(msg, "\n    (\"search\" body line %d)",
00361                          interp->errorLine);
00362                   Tcl_AddObjErrorInfo(interp, msg, -1);
00363                   abandon = 1;
00364                   break;
00365               } else {
00366                   abandon = 1;
00367                   break;
00368               }
00369            }
00370            entryMessage = ldap_next_entry(ldap, entryMessage);
00371        }
00372        if (resultCode == LDAP_RES_SEARCH_RESULT || all)
00373            break;
00374        if (resultMessage)
00375        ldap_msgfree(resultMessage);
00376        resultMessage = NULL;
00377     }
00378     if (abandon) {
00379        if (resultMessage)
00380            ldap_msgfree(resultMessage);
00381        if (resultCode == LDAP_RES_SEARCH_ENTRY)
00382            ldap_abandon(ldap, msgid);
00383        return tclResult;
00384     }
00385     if (resultCode == -1) {
00386        Tcl_ResetResult (interp);
00387        Tcl_AppendResult (interp,
00388                             "LDAP result search error: ",
00389                             LDAP_ERR_STRING(ldap),
00390                             (char *)NULL);
00391        LDAP_SetErrorCode(ldaptcl, -1, interp);
00392        return TCL_ERROR;
00393     }
00394 
00395     if ((errorCode = ldap_result2error (ldap, resultMessage, 0))
00396       != LDAP_SUCCESS) {
00397       Tcl_ResetResult (interp);
00398       Tcl_AppendResult (interp,
00399                            "LDAP search error: ",
00400                            ldap_err2string(errorCode),
00401                            (char *)NULL);
00402       if (resultMessage)
00403          ldap_msgfree(resultMessage);
00404       LDAP_SetErrorCode(ldaptcl, errorCode, interp);
00405       return TCL_ERROR;
00406     }
00407     if (resultMessage)
00408        ldap_msgfree(resultMessage);
00409     return tclResult;
00410 }
00411 
00412 /*-----------------------------------------------------------------------------
00413  * NeoX_LdapTargetObjCmd --
00414  *  
00415  * Implements the body of commands created by Neo_LdapObjCmd.
00416  *  
00417  * Results:
00418  *      A standard Tcl result.
00419  *      
00420  * Side effects:
00421  *      See the user documentation.
00422  *-----------------------------------------------------------------------------
00423  */     
00424 int
00425 NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
00426     ClientData    clientData;
00427     Tcl_Interp   *interp;
00428     int           objc;
00429     Tcl_Obj      *CONST objv[];
00430 {
00431     char         *command;
00432     char         *subCommand;
00433     LDAPTCL      *ldaptcl = (LDAPTCL *)clientData;
00434     LDAP         *ldap = ldaptcl->ldap;
00435     char         *dn;
00436     int           is_add = 0;
00437     int           is_add_or_modify = 0;
00438     int           mod_op = 0;
00439     char       *m, *s, *errmsg;
00440     int               errcode;
00441     int               tclResult;
00442     int               lderrno;     /* might be used by LDAP_ERR_STRING macro */
00443 
00444     Tcl_Obj      *resultObj = Tcl_GetObjResult (interp);
00445 
00446     if (objc < 2) {
00447        Tcl_WrongNumArgs (interp, 1, objv, "subcommand [args...]");
00448        return TCL_ERROR;
00449     }
00450 
00451     command = Tcl_GetStringFromObj (objv[0], NULL);
00452     subCommand = Tcl_GetStringFromObj (objv[1], NULL);
00453 
00454     /* object bind authtype name password */
00455     if (STREQU (subCommand, "bind")) {
00456        char     *binddn;
00457        char     *passwd;
00458        int       stringLength;
00459        char     *ldap_authString;
00460        int       ldap_authInt;
00461 
00462        if (objc != 5) {
00463            Tcl_WrongNumArgs (interp, 2, objv, "authtype dn passwd");
00464            return TCL_ERROR;
00465        }
00466 
00467        ldap_authString = Tcl_GetStringFromObj (objv[2], NULL);
00468 
00469        if (STREQU (ldap_authString, "simple")) {
00470            ldap_authInt = LDAP_AUTH_SIMPLE;
00471        }
00472 #ifdef UMICH_LDAP
00473        else if (STREQU (ldap_authString, "kerberos_ldap")) {
00474            ldap_authInt = LDAP_AUTH_KRBV41;
00475        } else if (STREQU (ldap_authString, "kerberos_dsa")) {
00476            ldap_authInt = LDAP_AUTH_KRBV42;
00477        } else if (STREQU (ldap_authString, "kerberos_both")) {
00478            ldap_authInt = LDAP_AUTH_KRBV4;
00479        }
00480 #endif
00481        else {
00482            Tcl_AppendStringsToObj (resultObj,
00483                                 "\"",
00484                                 command,
00485                                 " ",
00486                                 subCommand, 
00487 #ifdef UMICH_LDAP
00488                                 "\" authtype must be one of \"simple\", ",
00489                                 "\"kerberos_ldap\", \"kerberos_dsa\" ",
00490                                 "or \"kerberos_both\"",
00491 #else
00492                                 "\" authtype must be \"simple\", ",
00493 #endif
00494                                 (char *)NULL);
00495            return TCL_ERROR;
00496        }
00497 
00498        binddn = Tcl_GetStringFromObj (objv[3], &stringLength);
00499        if (stringLength == 0)
00500            binddn = NULL;
00501 
00502        passwd = Tcl_GetStringFromObj (objv[4], &stringLength);
00503        if (stringLength == 0)
00504            passwd = NULL;
00505 
00506 /*  ldap_bind_s(ldap, dn, pw, method) */
00507 
00508 #ifdef UMICH_LDAP
00509 #define LDAP_BIND(ldap, dn, pw, method) \
00510   ldap_bind_s(ldap, dn, pw, method)
00511 #else
00512 #define LDAP_BIND(ldap, dn, pw, method) \
00513   ldap_simple_bind_s(ldap, dn, pw)
00514 #endif
00515        if ((errcode = LDAP_BIND (ldap, 
00516                       binddn, 
00517                       passwd, 
00518                       ldap_authInt)) != LDAP_SUCCESS) {
00519 
00520            Tcl_AppendStringsToObj (resultObj,
00521                                  "LDAP bind error: ",
00522                                 ldap_err2string(errcode),
00523                                 (char *)NULL);
00524            LDAP_SetErrorCode(ldaptcl, errcode, interp);
00525            return TCL_ERROR;
00526        }
00527        return TCL_OK;
00528     }
00529 
00530     if (STREQU (subCommand, "unbind")) {
00531        if (objc != 2) {
00532            Tcl_WrongNumArgs (interp, 2, objv, "");
00533            return TCL_ERROR;
00534        }
00535 
00536        return Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], NULL));
00537     }
00538 
00539     /* object delete dn */
00540     if (STREQU (subCommand, "delete")) {
00541        if (objc != 3) {
00542            Tcl_WrongNumArgs (interp, 2, objv, "dn");
00543            return TCL_ERROR;
00544        }
00545 
00546        dn = Tcl_GetStringFromObj (objv [2], NULL);
00547        if ((errcode = ldap_delete_s(ldap, dn)) != LDAP_SUCCESS) {
00548           Tcl_AppendStringsToObj (resultObj,
00549                                 "LDAP delete error: ",
00550                                ldap_err2string(errcode),
00551                                (char *)NULL);
00552           LDAP_SetErrorCode(ldaptcl, errcode, interp);
00553           return TCL_ERROR;
00554        }
00555        return TCL_OK;
00556     }
00557 
00558     /* object rename_rdn dn rdn */
00559     /* object modify_rdn dn rdn */
00560     if (STREQU (subCommand, "rename_rdn") || STREQU (subCommand, "modify_rdn")) {
00561        char    *rdn;
00562        int      deleteOldRdn;
00563 
00564        if (objc != 4) {
00565            Tcl_WrongNumArgs (interp, 2, objv, "dn rdn");
00566            return TCL_ERROR;
00567        }
00568 
00569        dn = Tcl_GetStringFromObj (objv [2], NULL);
00570        rdn = Tcl_GetStringFromObj (objv [3], NULL);
00571 
00572        deleteOldRdn = (*subCommand == 'r');
00573 
00574        if ((errcode = ldap_modrdn2_s (ldap, dn, rdn, deleteOldRdn)) != LDAP_SUCCESS) {
00575            Tcl_AppendStringsToObj (resultObj,
00576                                 "LDAP ",
00577                                 subCommand,
00578                                 " error: ",
00579                                 ldap_err2string(errcode),
00580                                 (char *)NULL);
00581            LDAP_SetErrorCode(ldaptcl, errcode, interp);
00582            return TCL_ERROR;
00583        }
00584        return TCL_OK;
00585     }
00586 
00587     /* object add dn attributePairList */
00588     /* object add_attributes dn attributePairList */
00589     /* object replace_attributes dn attributePairList */
00590     /* object delete_attributes dn attributePairList */
00591 
00592     if (STREQU (subCommand, "add")) {
00593        is_add = 1;
00594        is_add_or_modify = 1;
00595     } else {
00596        is_add = 0;
00597        if (STREQU (subCommand, "add_attributes")) {
00598            is_add_or_modify = 1;
00599            mod_op = LDAP_MOD_ADD;
00600        } else if (STREQU (subCommand, "replace_attributes")) {
00601            is_add_or_modify = 1;
00602            mod_op = LDAP_MOD_REPLACE;
00603        } else if (STREQU (subCommand, "delete_attributes")) {
00604            is_add_or_modify = 1;
00605            mod_op = LDAP_MOD_DELETE;
00606        }
00607     }
00608 
00609     if (is_add_or_modify) {
00610        int          result;
00611        LDAPMod    **modArray;
00612        LDAPMod     *mod;
00613        char       **valPtrs = NULL;
00614        int          attribObjc;
00615        Tcl_Obj    **attribObjv;
00616        int          valuesObjc;
00617        Tcl_Obj    **valuesObjv;
00618        int          nPairs, allPairs;
00619        int          i;
00620        int          j;
00621        int         pairIndex;
00622        int         modIndex;
00623 
00624        Tcl_Obj      *resultObj = Tcl_GetObjResult (interp);
00625 
00626        if (objc < 4 || objc > 4 && is_add || is_add == 0 && objc&1) {
00627            Tcl_AppendStringsToObj (resultObj,
00628                                 "wrong # args: ",
00629                                 Tcl_GetStringFromObj (objv [0], NULL),
00630                                 " ",
00631                                 subCommand,
00632                                 " dn attributePairList",
00633                                 (char *)NULL);
00634            if (!is_add)
00635               Tcl_AppendStringsToObj (resultObj,
00636                   " ?[add|delete|replace] attributePairList ...?", (char *)NULL);
00637            return TCL_ERROR;
00638        }
00639 
00640        dn = Tcl_GetStringFromObj (objv [2], NULL);
00641 
00642        allPairs = 0;
00643        for (i = 3; i < objc; i += 2) {
00644            if (Tcl_ListObjLength (interp, objv[i], &j) == TCL_ERROR)
00645               return TCL_ERROR;
00646            if (j & 1) {
00647               Tcl_AppendStringsToObj (resultObj,
00648                                    "attribute list does not contain an ",
00649                                    "even number of key-value elements",
00650                                    (char *)NULL);
00651               return TCL_ERROR;
00652            }
00653            allPairs += j / 2;
00654        }
00655 
00656        modArray = (LDAPMod **)malloc (sizeof(LDAPMod *) * (allPairs + 1));
00657 
00658        pairIndex = 3;
00659        modIndex = 0;
00660 
00661        do {
00662 
00663        if (Tcl_ListObjGetElements (interp, objv [pairIndex], &attribObjc, &attribObjv)
00664          == TCL_ERROR) {
00665           mod_op = -1;
00666           goto badop;
00667        }
00668 
00669        nPairs = attribObjc / 2;
00670 
00671        for (i = 0; i < nPairs; i++) {
00672            mod = modArray[modIndex++] = (LDAPMod *) malloc (sizeof(LDAPMod));
00673            mod->mod_op = mod_op;
00674            mod->mod_type = Tcl_GetStringFromObj (attribObjv [i * 2], NULL);
00675 
00676            if (Tcl_ListObjGetElements (interp, attribObjv [i * 2 + 1], &valuesObjc, &valuesObjv) == TCL_ERROR) {
00677               /* FIX: cleanup memory here */
00678               mod_op = -1;
00679               goto badop;
00680            }
00681 
00682            valPtrs = mod->mod_vals.modv_strvals = \
00683                (char **)malloc (sizeof (char *) * (valuesObjc + 1));
00684            valPtrs[valuesObjc] = (char *)NULL;
00685 
00686            for (j = 0; j < valuesObjc; j++) {
00687               valPtrs [j] = Tcl_GetStringFromObj (valuesObjv[j], NULL);
00688 
00689               /* If it's "delete" and value is an empty string, make
00690                * value be NULL to indicate entire attribute is to be 
00691                * deleted */
00692               if ((*valPtrs [j] == '\0') 
00693                   && (mod->mod_op == LDAP_MOD_DELETE || mod->mod_op == LDAP_MOD_REPLACE)) {
00694                      valPtrs [j] = NULL;
00695               }
00696            }
00697        }
00698 
00699        pairIndex += 2;
00700        if (mod_op != -1 && pairIndex < objc) {
00701            subCommand = Tcl_GetStringFromObj (objv[pairIndex - 1], NULL);
00702            mod_op = -1;
00703            if (STREQU (subCommand, "add")) {
00704               mod_op = LDAP_MOD_ADD;
00705            } else if (STREQU (subCommand, "replace")) {
00706               mod_op = LDAP_MOD_REPLACE;
00707            } else if (STREQU (subCommand, "delete")) {
00708               mod_op = LDAP_MOD_DELETE;
00709            }
00710            if (mod_op == -1) {
00711               Tcl_SetStringObj (resultObj,
00712                      "Additional operators must be one of"
00713                      " add, replace, or delete", -1);
00714               mod_op = -1;
00715               goto badop;
00716            }
00717        }
00718 
00719        } while (mod_op != -1 && pairIndex < objc);
00720        modArray[modIndex] = (LDAPMod *) NULL;
00721 
00722        if (is_add) {
00723            result = ldap_add_s (ldap, dn, modArray);
00724        } else {
00725            result = ldap_modify_s (ldap, dn, modArray);
00726            if (ldaptcl->caching)
00727               ldap_uncache_entry (ldap, dn);
00728        }
00729 
00730         /* free the modArray elements, then the modArray itself. */
00731 badop:
00732        for (i = 0; i < modIndex; i++) {
00733            free ((char *) modArray[i]->mod_vals.modv_strvals);
00734            free ((char *) modArray[i]);
00735        }
00736        free ((char *) modArray);
00737 
00738        /* after modArray is allocated, mod_op = -1 upon error for cleanup */
00739        if (mod_op == -1)
00740            return TCL_ERROR;
00741 
00742        /* FIX: memory cleanup required all over the place here */
00743         if (result != LDAP_SUCCESS) {
00744            Tcl_AppendStringsToObj (resultObj,
00745                                 "LDAP ",
00746                                 subCommand,
00747                                 " error: ",
00748                                 ldap_err2string(result),
00749                                 (char *)NULL);
00750            LDAP_SetErrorCode(ldaptcl, result, interp);
00751            return TCL_ERROR;
00752        }
00753        return TCL_OK;
00754     }
00755 
00756     /* object search controlArray dn pattern */
00757     if (STREQU (subCommand, "search")) {
00758        char        *controlArrayName;
00759        Tcl_Obj     *controlArrayNameObj;
00760 
00761        char        *scopeString;
00762        int          scope;
00763 
00764        char        *derefString;
00765        int          deref;
00766 
00767        char        *baseString;
00768 
00769        char       **attributesArray;
00770        char        *attributesString;
00771        int          attributesArgc;
00772 
00773        char        *filterPatternString;
00774 
00775        char       *timeoutString;
00776        double             timeoutTime;
00777        struct timeval timeout, *timeout_p;
00778 
00779        char       *paramString;
00780        int         cacheThis = -1;
00781        int         all = 0;
00782 
00783        char       *sortattr;
00784 
00785        Tcl_Obj     *destArrayNameObj;
00786        Tcl_Obj     *evalCodeObj;
00787 
00788        if (objc != 5) {
00789            Tcl_WrongNumArgs (interp, 2, objv,
00790                                "controlArray destArray code");
00791            return TCL_ERROR;
00792        }
00793 
00794         controlArrayNameObj = objv [2];
00795        controlArrayName = Tcl_GetStringFromObj (controlArrayNameObj, NULL);
00796 
00797        destArrayNameObj = objv [3];
00798 
00799        evalCodeObj = objv [4];
00800 
00801        baseString = Tcl_GetVar2 (interp, 
00802                               controlArrayName, 
00803                               "base",
00804                               0);
00805 
00806        if (baseString == (char *)NULL) {
00807            Tcl_AppendStringsToObj (resultObj,
00808                                 "required element \"base\" ",
00809                                 "is missing from ldap control array \"",
00810                                 controlArrayName,
00811                                 "\"",
00812                                 (char *)NULL);
00813            return TCL_ERROR;
00814        }
00815 
00816        filterPatternString = Tcl_GetVar2 (interp,
00817                                        controlArrayName,
00818                                        "filter",
00819                                        0);
00820        if (filterPatternString == (char *)NULL) {
00821            filterPatternString = "(objectclass=*)";
00822        }
00823 
00824        /* Fetch scope setting from control array.
00825         * If it doesn't exist, default to subtree scoping.
00826         */
00827        scopeString = Tcl_GetVar2 (interp, controlArrayName, "scope", 0);
00828        if (scopeString == NULL) {
00829            scope = LDAP_SCOPE_SUBTREE;
00830        } else {
00831            if (STREQU(scopeString, "base")) 
00832               scope = LDAP_SCOPE_BASE;
00833            else if (STRNEQU(scopeString, "one", 3))
00834               scope = LDAP_SCOPE_ONELEVEL;
00835            else if (STRNEQU(scopeString, "sub", 3))
00836               scope = LDAP_SCOPE_SUBTREE;
00837            else {
00838               Tcl_AppendStringsToObj (resultObj,
00839                                     "\"scope\" element of \"",
00840                                     controlArrayName,
00841                                     "\" array is not one of ",
00842                                     "\"base\", \"onelevel\", ",
00843                                    "or \"subtree\"",
00844                                   (char *) NULL);
00845               return TCL_ERROR;
00846            }
00847        }
00848 
00849 #ifdef LDAP_OPT_DEREF                                  
00850        /* Fetch dereference control setting from control array.
00851         * If it doesn't exist, default to never dereference. */
00852        derefString = Tcl_GetVar2 (interp,
00853                                controlArrayName,
00854                                "deref",
00855                                0);
00856        if (derefString == (char *)NULL) {
00857            deref = LDAP_DEREF_NEVER;
00858        } else {
00859            if (STREQU(derefString, "never"))
00860               deref = LDAP_DEREF_NEVER;
00861            else if (STREQU(derefString, "search"))
00862               deref = LDAP_DEREF_SEARCHING;
00863            else if (STREQU(derefString, "find"))
00864               deref = LDAP_DEREF_FINDING;
00865            else if (STREQU(derefString, "always"))
00866               deref = LDAP_DEREF_ALWAYS;
00867            else {
00868               Tcl_AppendStringsToObj (resultObj,
00869                                     "\"deref\" element of \"",
00870                                     controlArrayName,
00871                                     "\" array is not one of ",
00872                                     "\"never\", \"search\", \"find\", ",
00873                                     "or \"always\"",
00874                                     (char *) NULL);
00875               return TCL_ERROR;
00876            }
00877        }
00878 #endif
00879 
00880        /* Fetch list of attribute names from control array.
00881         * If entry doesn't exist, default to NULL (all).
00882         */
00883        attributesString = Tcl_GetVar2 (interp,
00884                                     controlArrayName,
00885                                     "attributes", 
00886                                     0);
00887        if (attributesString == (char *)NULL) {
00888            attributesArray = NULL;
00889        } else {
00890            if ((Tcl_SplitList (interp, 
00891                             attributesString,
00892                             &attributesArgc, 
00893                             &attributesArray)) != TCL_OK) {
00894               return TCL_ERROR;
00895            }
00896        }
00897 
00898        /* Fetch timeout value if there is one
00899         */
00900        timeoutString = Tcl_GetVar2 (interp,
00901                                     controlArrayName,
00902                                     "timeout", 
00903                                     0);
00904        timeout.tv_usec = 0;
00905        if (timeoutString == (char *)NULL) {
00906            timeout_p = NULL;
00907            timeout.tv_sec = 0;
00908        } else {
00909            if (Tcl_GetDouble(interp, timeoutString, &timeoutTime) != TCL_OK)
00910               return TCL_ERROR;
00911            timeout.tv_sec = floor(timeoutTime);
00912            timeout.tv_usec = (timeoutTime-timeout.tv_sec) * 1000000;
00913            timeout_p = &timeout;
00914        }
00915 
00916        paramString = Tcl_GetVar2 (interp, controlArrayName, "cache", 0);
00917        if (paramString) {
00918            if (Tcl_GetInt(interp, paramString, &cacheThis) == TCL_ERROR)
00919               return TCL_ERROR;
00920        }
00921 
00922        paramString = Tcl_GetVar2 (interp, controlArrayName, "all", 0);
00923        if (paramString) {
00924            if (Tcl_GetInt(interp, paramString, &all) == TCL_ERROR)
00925               return TCL_ERROR;
00926        }
00927 
00928        sortattr = Tcl_GetVar2 (interp, controlArrayName, "sort", 0);
00929 
00930 #ifdef UMICH_LDAP
00931        ldap->ld_deref = deref; 
00932        ldap->ld_timelimit = 0;
00933        ldap->ld_sizelimit = 0; 
00934        ldap->ld_options = 0;
00935 #endif
00936 
00937        /* Caching control within the search: if the "cache" control array */
00938        /* value is set, disable/enable caching accordingly */
00939 
00940 #if 0
00941        if (cacheThis >= 0 && ldaptcl->caching != cacheThis) {
00942            if (cacheThis) {
00943               if (ldaptcl->timeout == 0) {
00944                   Tcl_SetStringObj(resultObj, "Caching never before enabled, I have no timeout value to use", -1);
00945                   return TCL_ERROR;
00946               }
00947               ldap_enable_cache(ldap, ldaptcl->timeout, ldaptcl->maxmem);
00948            }
00949            else
00950               ldap_disable_cache(ldap);
00951        }
00952 #endif
00953 
00954 #ifdef LDAP_OPT_DEREF
00955        ldap_set_option(ldap, LDAP_OPT_DEREF, &deref);
00956 #endif
00957 
00958        tclResult = LDAP_PerformSearch (interp, 
00959                                  ldaptcl, 
00960                                  baseString, 
00961                                  scope, 
00962                                  attributesArray, 
00963                                  filterPatternString, 
00964                                  "",
00965                                  destArrayNameObj,
00966                                  evalCodeObj,
00967                                 timeout_p,
00968                                 all,
00969                                 sortattr);
00970        /* Following the search, if we changed the caching behavior, change */
00971        /* it back. */
00972 #if 0
00973        if (cacheThis >= 0 && ldaptcl->caching != cacheThis) {
00974            if (cacheThis)
00975               ldap_disable_cache(ldap);
00976            else
00977               ldap_enable_cache(ldap, ldaptcl->timeout, ldaptcl->maxmem);
00978        }
00979 #ifdef LDAP_OPT_DEREF
00980        deref = LDAP_DEREF_NEVER;
00981        ldap_set_option(ldap, LDAP_OPT_DEREF, &deref);
00982 #endif
00983 #endif
00984        return tclResult;
00985     }
00986 
00987     /* object compare dn attr value */
00988     if (STREQU (subCommand, "compare")) {
00989        char        *dn;
00990        char       *attr;
00991        char       *value;
00992        int         result;
00993        int         lderrno;
00994 
00995        if (objc != 5) {
00996            Tcl_WrongNumArgs (interp, 
00997                                2, objv,
00998                                "dn attribute value");
00999            return TCL_ERROR;
01000        }
01001 
01002        dn = Tcl_GetStringFromObj (objv[2], NULL);
01003        attr = Tcl_GetStringFromObj (objv[3], NULL);
01004        value = Tcl_GetStringFromObj (objv[4], NULL);
01005        
01006        result = ldap_compare_s (ldap, dn, attr, value);
01007        if (result == LDAP_COMPARE_TRUE || result == LDAP_COMPARE_FALSE) {
01008            Tcl_SetBooleanObj(resultObj, result == LDAP_COMPARE_TRUE);
01009            return TCL_OK;
01010        }
01011        LDAP_SetErrorCode(ldaptcl, result, interp);
01012        Tcl_AppendStringsToObj (resultObj,
01013                             "LDAP compare error: ",
01014                             LDAP_ERR_STRING(ldap),
01015                             (char *)NULL);
01016        return TCL_ERROR;
01017     }
01018 
01019     if (STREQU (subCommand, "cache")) {
01020 #if defined(UMICH_LDAP) || (defined(OPEN_LDAP) && !defined(LDAP_API_VERSION))
01021        char *cacheCommand;
01022 
01023        if (objc < 3) {
01024          badargs:
01025            Tcl_WrongNumArgs (interp, 2, objv [0], "command [args...]");
01026            return TCL_ERROR;
01027        }
01028 
01029        cacheCommand = Tcl_GetStringFromObj (objv [2], NULL);
01030 
01031        if (STREQU (cacheCommand, "uncache")) {
01032            char *dn;
01033 
01034            if (objc != 4) {
01035               Tcl_WrongNumArgs (interp, 
01036                                    3, objv,
01037                                    "dn");
01038               return TCL_ERROR;
01039            }
01040 
01041             dn = Tcl_GetStringFromObj (objv [3], NULL);
01042            ldap_uncache_entry (ldap, dn);
01043            return TCL_OK;
01044        }
01045 
01046        if (STREQU (cacheCommand, "enable")) {
01047            long   timeout = ldaptcl->timeout;
01048            long   maxmem = ldaptcl->maxmem;
01049 
01050            if (objc > 5) {
01051               Tcl_WrongNumArgs (interp, 3, objv, "?timeout? ?maxmem?");
01052               return TCL_ERROR;
01053            }
01054 
01055            if (objc > 3) {
01056               if (Tcl_GetLongFromObj (interp, objv [3], &timeout) == TCL_ERROR)
01057                   return TCL_ERROR;
01058            }
01059            if (timeout == 0) {
01060               Tcl_SetStringObj(resultObj,
01061                   objc > 3 ? "timeouts must be greater than 0" : 
01062                   "no previous timeout to reference", -1);
01063               return TCL_ERROR;
01064            }
01065 
01066            if (objc > 4)
01067               if (Tcl_GetLongFromObj (interp, objv [4], &maxmem) == TCL_ERROR)
01068                   return TCL_ERROR;
01069 
01070            if (ldap_enable_cache (ldap, timeout, maxmem) == -1) {
01071               Tcl_AppendStringsToObj (resultObj,
01072                                    "LDAP cache enable error: ",
01073                                    LDAP_ERR_STRING(ldap),
01074                                    (char *)NULL);
01075               LDAP_SetErrorCode(ldaptcl, -1, interp);
01076               return TCL_ERROR;
01077            }
01078            ldaptcl->caching = 1;
01079            ldaptcl->timeout = timeout;
01080            ldaptcl->maxmem = maxmem;
01081            return TCL_OK;
01082        }
01083 
01084        if (objc != 3) goto badargs;
01085 
01086        if (STREQU (cacheCommand, "disable")) {
01087            ldap_disable_cache (ldap);
01088            ldaptcl->caching = 0;
01089            return TCL_OK;
01090        }
01091 
01092        if (STREQU (cacheCommand, "destroy")) {
01093            ldap_destroy_cache (ldap);
01094            ldaptcl->caching = 0;
01095            return TCL_OK;
01096        }
01097 
01098        if (STREQU (cacheCommand, "flush")) {
01099            ldap_flush_cache (ldap);
01100            return TCL_OK;
01101        }
01102 
01103        if (STREQU (cacheCommand, "no_errors")) {
01104            ldap_set_cache_options (ldap, LDAP_CACHE_OPT_CACHENOERRS);
01105            return TCL_OK;
01106        }
01107 
01108        if (STREQU (cacheCommand, "all_errors")) {
01109            ldap_set_cache_options (ldap, LDAP_CACHE_OPT_CACHEALLERRS);
01110            return TCL_OK;
01111        }
01112 
01113        if (STREQU (cacheCommand, "size_errors")) {
01114            ldap_set_cache_options (ldap, 0);
01115            return TCL_OK;
01116        }
01117        Tcl_AppendStringsToObj (resultObj,
01118                             "\"",
01119                             command,
01120                             " ",
01121                             subCommand, 
01122                             "\" subcommand", 
01123                             " must be one of \"enable\", ",
01124                             "\"disable\", ",
01125                             "\"destroy\", \"flush\", \"uncache\", ",
01126                             "\"no_errors\", \"size_errors\",",
01127                             " or \"all_errors\"",
01128                             (char *)NULL);
01129        return TCL_ERROR;
01130 #else
01131        return TCL_OK;
01132 #endif
01133     }
01134     if (STREQU (subCommand, "trap")) {
01135        Tcl_Obj *listObj, *resultObj;
01136        int *p, l, i, code;
01137 
01138        if (objc > 4) {
01139            Tcl_WrongNumArgs (interp, 2, objv,
01140                                "command ?errorCode-list?");
01141            return TCL_ERROR;
01142        }
01143        if (objc == 2) {
01144            if (!ldaptcl->trapCmdObj)
01145               return TCL_OK;
01146            resultObj = Tcl_NewListObj(0, NULL);
01147            Tcl_ListObjAppendElement(interp, resultObj, ldaptcl->trapCmdObj);
01148            if (ldaptcl->traplist) {
01149               listObj = Tcl_NewObj();
01150               for (p = ldaptcl->traplist; *p; p++) {
01151                   Tcl_ListObjAppendElement(interp, listObj, 
01152                      Tcl_NewStringObj(ldaptclerrorcode[*p], -1));
01153               }
01154               Tcl_ListObjAppendElement(interp, resultObj, listObj);
01155            }
01156            Tcl_SetObjResult(interp, resultObj);
01157            return TCL_OK;
01158        }
01159        if (ldaptcl->trapCmdObj) {
01160            Tcl_DecrRefCount (ldaptcl->trapCmdObj);
01161            ldaptcl->trapCmdObj = NULL;
01162        }
01163        if (ldaptcl->traplist) {
01164            free(ldaptcl->traplist);
01165            ldaptcl->traplist = NULL;
01166        }
01167        Tcl_GetStringFromObj(objv[2], &l);
01168        if (l == 0)
01169            return TCL_OK;          /* just turn off trap */
01170        ldaptcl->trapCmdObj = objv[2];
01171        Tcl_IncrRefCount (ldaptcl->trapCmdObj);
01172        if (objc < 4)
01173            return TCL_OK;          /* no code list */
01174        if (Tcl_ListObjLength(interp, objv[3], &l) != TCL_OK)
01175            return TCL_ERROR;
01176        if (l == 0)
01177            return TCL_OK;          /* empty code list */
01178        ldaptcl->traplist = (int*)malloc(sizeof(int) * (l + 1));
01179        ldaptcl->traplist[l] = 0;
01180        for (i = 0; i < l; i++) {
01181            Tcl_ListObjIndex(interp, objv[3], i, &resultObj);
01182            code = LDAP_ErrorStringToCode(interp, Tcl_GetStringFromObj(resultObj, NULL));
01183            if (code == -1) {
01184               free(ldaptcl->traplist);
01185               ldaptcl->traplist = NULL;
01186               return TCL_ERROR;
01187            }
01188            ldaptcl->traplist[i] = code;
01189        }
01190        return TCL_OK;
01191     }
01192     if (STREQU (subCommand, "trapcodes")) {
01193        int code;
01194        Tcl_Obj *resultObj;
01195        Tcl_Obj *stringObj;
01196        resultObj = Tcl_GetObjResult(interp);
01197 
01198        for (code = 0; code < LDAPTCL_MAXERR; code++) {
01199            if (!ldaptclerrorcode[code]) continue;
01200            Tcl_ListObjAppendElement(interp, resultObj,
01201                      Tcl_NewStringObj(ldaptclerrorcode[code], -1));
01202        }
01203        return TCL_OK;
01204     }
01205 #ifdef LDAP_DEBUG
01206     if (STREQU (subCommand, "debug")) {
01207        if (objc != 3) {
01208            Tcl_AppendStringsToObj(resultObj, "Wrong # of arguments",
01209               (char*)NULL);
01210            return TCL_ERROR;
01211        }
01212        return Tcl_GetIntFromObj(interp, objv[2], &ldap_debug);
01213     }
01214 #endif
01215 
01216     /* FIX: this needs to enumerate all the possibilities */
01217     Tcl_AppendStringsToObj (resultObj,
01218                            "subcommand \"", 
01219                          subCommand, 
01220                          "\" must be one of \"add\", ",
01221                          "\"add_attributes\", ",
01222                          "\"bind\", \"cache\", \"delete\", ",
01223                          "\"delete_attributes\", \"modify\", ",
01224                          "\"modify_rdn\", \"rename_rdn\", ",
01225                          "\"replace_attributes\", ",
01226                          "\"search\" or \"unbind\".",
01227                            (char *)NULL);
01228     return TCL_ERROR;
01229 }
01230 
01231 /* 
01232  * Delete and LDAP command object
01233  *
01234  */
01235 static void
01236 NeoX_LdapObjDeleteCmd(clientData)
01237     ClientData    clientData;
01238 {
01239     LDAPTCL      *ldaptcl = (LDAPTCL *)clientData;
01240     LDAP         *ldap = ldaptcl->ldap;
01241 
01242     if (ldaptcl->trapCmdObj)
01243        Tcl_DecrRefCount (ldaptcl->trapCmdObj);
01244     if (ldaptcl->traplist)
01245        free(ldaptcl->traplist);
01246     ldap_unbind(ldap);
01247     free((char*) ldaptcl);
01248 }
01249 
01250 /*-----------------------------------------------------------------------------
01251  * NeoX_LdapObjCmd --
01252  *  
01253  * Implements the `ldap' command:
01254  *    ldap open newObjName host [port]
01255  *    ldap init newObjName host [port]
01256  *  
01257  * Results:
01258  *      A standard Tcl result.
01259  *      
01260  * Side effects:
01261  *      See the user documentation.
01262  *-----------------------------------------------------------------------------
01263  */     
01264 static int
01265 NeoX_LdapObjCmd (clientData, interp, objc, objv)
01266     ClientData    clientData;
01267     Tcl_Interp   *interp;
01268     int           objc;
01269     Tcl_Obj      *CONST objv[];
01270 {
01271     extern int    errno;
01272     char         *subCommand;
01273     char         *newCommand;
01274     char         *ldapHost;
01275     int           ldapPort = LDAP_PORT;
01276     LDAP         *ldap;
01277     LDAPTCL    *ldaptcl;
01278 
01279     Tcl_Obj      *resultObj = Tcl_GetObjResult (interp);
01280 
01281     if (objc < 3) {
01282        Tcl_WrongNumArgs (interp, 1, objv,
01283                             "(open|init) new_command host [port]|explode dn");
01284        return TCL_ERROR;
01285     }
01286 
01287     subCommand = Tcl_GetStringFromObj (objv[1], NULL);
01288 
01289     if (STREQU(subCommand, "explode")) {
01290        char *param;
01291        int nonames = 0;
01292        int list = 0;
01293        char **exploded, **p;
01294 
01295        param = Tcl_GetStringFromObj (objv[2], NULL);
01296        if (param[0] == '-') {
01297            if (STREQU(param, "-nonames")) {
01298               nonames = 1;
01299            } else if (STREQU(param, "-list")) {
01300               list = 1;
01301            } else {
01302               Tcl_WrongNumArgs (interp, 1, objv, "explode ?-nonames|-list? dn");
01303               return TCL_ERROR;
01304            }
01305        }
01306        if (nonames || list)
01307            param = Tcl_GetStringFromObj (objv[3], NULL);
01308        exploded = ldap_explode_dn(param, nonames);
01309        for (p = exploded; *p; p++) {
01310            if (list) {
01311               char *q = strchr(*p, '=');
01312               if (!q) {
01313                   Tcl_SetObjLength(resultObj, 0);
01314                   Tcl_AppendStringsToObj(resultObj, "rdn ", *p,
01315                      " missing '='", NULL);
01316                   ldap_value_free(exploded);
01317                   return TCL_ERROR;
01318               }
01319               *q = '\0';
01320               if (Tcl_ListObjAppendElement(interp, resultObj,
01321                      Tcl_NewStringObj(*p, -1)) != TCL_OK ||
01322                      Tcl_ListObjAppendElement(interp, resultObj,
01323                      Tcl_NewStringObj(q+1, -1)) != TCL_OK) {
01324                   ldap_value_free(exploded);
01325                   return TCL_ERROR;
01326               }
01327            } else {
01328               if (Tcl_ListObjAppendElement(interp, resultObj,
01329                      Tcl_NewStringObj(*p, -1))) {
01330                   ldap_value_free(exploded);
01331                   return TCL_ERROR;
01332               }
01333            }
01334        }
01335        ldap_value_free(exploded);
01336        return TCL_OK;
01337     }
01338 
01339 #ifdef UMICH_LDAP
01340     if (STREQU(subCommand, "friendly")) {
01341        char *friendly = ldap_dn2ufn(Tcl_GetStringFromObj(objv[2], NULL));
01342        Tcl_SetStringObj(resultObj, friendly, -1);
01343        free(friendly);
01344        return TCL_OK;
01345     }
01346 #endif
01347 
01348     newCommand = Tcl_GetStringFromObj (objv[2], NULL);
01349     ldapHost = Tcl_GetStringFromObj (objv[3], NULL);
01350 
01351     if (objc == 5) {
01352        if (Tcl_GetIntFromObj (interp, objv [4], &ldapPort) == TCL_ERROR) {
01353            Tcl_AppendStringsToObj (resultObj,
01354                                 "LDAP port number is non-numeric",
01355                                 (char *)NULL);
01356             return TCL_ERROR;
01357        }
01358     }
01359 
01360     if (STREQU (subCommand, "open")) {
01361        ldap = ldap_open (ldapHost, ldapPort);
01362     } else if (STREQU (subCommand, "init")) {
01363        int version = -1;
01364        int i;
01365        int value;
01366        char *subOption;
01367        char *subValue;
01368 
01369 #if LDAPTCL_PROTOCOL_VERSION_DEFAULT
01370        version = LDAPTCL_PROTOCOL_VERSION_DEFAULT;
01371 #endif
01372 
01373        for (i = 6; i < objc; i += 2)  {
01374            subOption =  Tcl_GetStringFromObj(objv[i-1], NULL);
01375            if (STREQU (subOption, "protocol_version")) {
01376 #ifdef LDAP_OPT_PROTOCOL_VERSION
01377               subValue = Tcl_GetStringFromObj(objv[i], NULL);
01378               if (STREQU (subValue, "2")) {
01379                   version = LDAP_VERSION2;
01380               }
01381               else if (STREQU (subValue, "3")) {
01382 #ifdef LDAP_VERSION3
01383                   version = LDAP_VERSION3;
01384 #else
01385                   Tcl_SetStringObj (resultObj, "protocol_version 3 not supported", -1);
01386                   return TCL_ERROR;
01387 #endif
01388               }
01389               else {
01390                   Tcl_SetStringObj (resultObj, "protocol_version must be '2' or '3'", -1);
01391                   return TCL_ERROR;
01392               }
01393 #else
01394               Tcl_SetStringObj (resultObj, "protocol_version not supported", -1);
01395               return TCL_ERROR;
01396 #endif
01397            } else if (STREQU (subOption, "port")) {
01398               if (Tcl_GetIntFromObj (interp, objv [i], &ldapPort) == TCL_ERROR) {
01399                   Tcl_AppendStringsToObj (resultObj,
01400                                        "LDAP port number is non-numeric",
01401                                        (char *)NULL);
01402                   return TCL_ERROR;
01403               }
01404            } else {
01405               Tcl_SetStringObj (resultObj, "valid options: protocol_version, port", -1);
01406               return TCL_ERROR;
01407            }
01408        }
01409        ldap = ldap_init (ldapHost, ldapPort);
01410 
01411 #ifdef LDAP_OPT_PROTOCOL_VERSION
01412        if (version != -1)
01413            ldap_set_option(ldap, LDAP_OPT_PROTOCOL_VERSION, &version);
01414 #endif
01415     } else {
01416        Tcl_AppendStringsToObj (resultObj, 
01417                             "option was not \"open\" or \"init\"");
01418        return TCL_ERROR;
01419     }
01420 
01421     if (ldap == (LDAP *)NULL) {
01422        Tcl_SetErrno(errno);
01423        Tcl_AppendStringsToObj (resultObj, 
01424                             Tcl_PosixError (interp), 
01425                             (char *)NULL);
01426        return TCL_ERROR;
01427     }
01428 
01429 #ifdef UMICH_LDAP
01430     ldap->ld_deref = LDAP_DEREF_NEVER;  /* Turn off alias dereferencing */
01431 #endif
01432 
01433     ldaptcl = (LDAPTCL *) malloc(sizeof(LDAPTCL));
01434     ldaptcl->ldap = ldap;
01435     ldaptcl->caching = 0;
01436     ldaptcl->timeout = 0;
01437     ldaptcl->maxmem = 0;
01438     ldaptcl->trapCmdObj = NULL;
01439     ldaptcl->traplist = NULL;
01440     ldaptcl->flags = 0;
01441 
01442     Tcl_CreateObjCommand (interp,
01443                        newCommand,
01444                           NeoX_LdapTargetObjCmd,
01445                           (ClientData) ldaptcl,
01446                           NeoX_LdapObjDeleteCmd);
01447     return TCL_OK;
01448 }
01449 
01450 /*-----------------------------------------------------------------------------
01451  * Neo_initLDAP --
01452  *     Initialize the LDAP interface.
01453  *-----------------------------------------------------------------------------
01454  */     
01455 int
01456 Ldaptcl_Init (interp)
01457 Tcl_Interp   *interp;
01458 {
01459     Tcl_CreateObjCommand (interp,
01460                        "ldap",
01461                           NeoX_LdapObjCmd,
01462                           (ClientData) NULL,
01463                           (Tcl_CmdDeleteProc*) NULL);
01464     /*
01465     if (Neo_initLDAPX(interp) != TCL_OK)
01466        return TCL_ERROR;
01467     */
01468     Tcl_PkgProvide(interp, "Ldaptcl", VERSION);
01469     return TCL_OK;
01470 }