]> git.sur5r.net Git - openldap/blobdiff - contrib/ldaptcl/neoXldap.c
Fix single-value delete, replace
[openldap] / contrib / ldaptcl / neoXldap.c
index e19fa9712f6bb1ea8b33799776c856c657f88cb1..a9f1a8f2b9a271f650057a5bd9bea97c268b7b86 100644 (file)
@@ -23,7 +23,7 @@
  * Requests for permission may be sent to NeoSoft Inc, 1770 St. James Place,
  * Suite 500, Houston, TX, 77056.
  *
- * $Id: neoXldap.c,v 1.5 1999/02/05 18:45:14 kunkee Exp $
+ * $OpenLDAP$
  *
  */
 
  * Umich-3.3 client code.  The UMICH_LDAP define is used to include
  * code that will work with the Umich-3.3 LDAP, but not with Netscape's
  * SDK.  OpenLDAP may support some of these, but they have not been tested.
- * Current support is by Randy Kunkee.
+ * Currently supported by Randy Kunkee (kunkee@OpenLDAP.org).
+ */
+
+/*
+ * Add timeout to controlArray to set timeout for ldap_result.
+ * 4/14/99 - Randy
  */
 
 #include "tclExtend.h"
@@ -42,6 +47,8 @@
 #include <lber.h>
 #include <ldap.h>
 #include <string.h>
+#include <sys/time.h>
+#include <math.h>
 
 /*
  * Macros to do string compares.  They pre-check the first character before
@@ -50,6 +57,8 @@
 
 #define STREQU(str1, str2) \
        (((str1) [0] == (str2) [0]) && (strcmp (str1, str2) == 0))
+#define STRNEQU(str1, str2, n) \
+       (((str1) [0] == (str2) [0]) && (strncmp (str1, str2, n) == 0))
 
 /*
  * The following section defines some common macros used by the rest
@@ -58,8 +67,8 @@
  * against the Netscape LDAP server and the much more reliable SDK,
  * and then again backported to the Umich-3.3 client code.
  */
-
-#if defined(LDAP_API_VERSION)
+#define OPEN_LDAP 1
+#if defined(OPEN_LDAP)
        /* LDAP_API_VERSION must be defined per the current draft spec
        ** it's value will be assigned RFC number.  However, as
        ** no RFC is defined, it's value is currently implementation
        ** In OpenLDAP 2.x-devel, its 2000 + the draft number, ie 2002.
        ** This section is for OPENLDAP.
        */
-#define ldap_attributefree(p) ldap_memfree(p)
+#ifndef LDAP_API_FEATURE_X_OPENLDAP
+#define ldap_memfree(p) free(p)
+#endif
+#ifdef LDAP_OPT_ERROR_NUMBER
+#define ldap_get_lderrno(ld)   (ldap_get_option(ld, LDAP_OPT_ERROR_NUMBER, &lderrno), lderrno)
+#else
+#define ldap_get_lderrno(ld) (ld->ld_errno)
+#endif
 #define LDAP_ERR_STRING(ld)  \
-       ldap_err2string(ldap_get_lderrno(ldap))
+       ldap_err2string(ldap_get_lderrno(ld))
 #elif defined( LDAP_OPT_SIZELIMIT )
        /*
        ** Netscape SDK w/ ldap_set_option, ldap_get_option
        */
-#define ldap_attributefree(p) ldap_memfree(p)
 #define LDAP_ERR_STRING(ld)  \
-       ldap_err2string(ldap_get_lderrno(ldap, (char**)NULL, (char**)NULL))
+       ldap_err2string(ldap_get_lderrno(ldap))
 #else
        /* U-Mich/OpenLDAP 1.x API */
        /* RFC-1823 w/ changes */
-#define UMICH_LDAP
+#define UMICH_LDAP 1
 #define ldap_memfree(p) free(p)
 #define ldap_ber_free(p, n) ber_free(p, n)
-#define ldap_get_lderrno(ld, dummy1, dummy2) (ld->ld_errno)
 #define ldap_value_free_len(bvals) ber_bvecfree(bvals)
-#define ldap_attributefree(p) 
+#define ldap_get_lderrno(ld) (ld->ld_errno)
 #define LDAP_ERR_STRING(ld)  \
-       ldap_err2string(ldap_get_lderrno(ldap))
+       ldap_err2string(ld->ld_errno)
 #endif
 
-#if defined(LDAP_API_VERSION)
-#ifdef LDAP_OPT_ERROR_NUMBER
-static int ldap_get_lderrno(LDAP *ld)
+typedef struct ldaptclobj {
+    LDAP       *ldap;
+    int                caching;        /* flag 1/0 if caching is enabled */
+    long       timeout;        /* timeout from last cache enable */
+    long       maxmem;         /* maxmem from last cache enable */
+    Tcl_Obj    *trapCmdObj;    /* error handler */
+    int                *traplist;      /* list of errorCodes to trap */
+    int                flags;
+} LDAPTCL;
+
+
+#define LDAPTCL_INTERRCODES    0x001
+
+#include "ldaptclerr.h"
+
+static
+LDAP_SetErrorCode(LDAPTCL *ldaptcl, int code, Tcl_Interp *interp)
 {
-    int ld_errno = 0;
-    ldap_get_option(ld, LDAP_OPT_ERROR_NUMBER, (void*)&ld_errno);
-    return ld_errno;
+    char shortbuf[16];
+    char *errp;
+    int   lderrno;
+
+    if (code == -1)
+       code = ldap_get_lderrno(ldaptcl->ldap);
+    if ((ldaptcl->flags & LDAPTCL_INTERRCODES) || code > LDAPTCL_MAXERR ||
+      ldaptclerrorcode[code] == NULL) {
+       sprintf(shortbuf, "0x%03x", code);
+       errp = shortbuf;
+    } else
+       errp = ldaptclerrorcode[code];
+
+    Tcl_SetErrorCode(interp, errp, NULL);
+    if (ldaptcl->trapCmdObj) {
+       int *i;
+       Tcl_Obj *cmdObj;
+       if (ldaptcl->traplist != NULL) {
+           for (i = ldaptcl->traplist; *i && *i != code; i++)
+               ;
+           if (*i == 0) return;
+       }
+       (void) Tcl_EvalObj(interp, ldaptcl->trapCmdObj);
+    }
 }
-#endif
-#endif
-
 
+static
+LDAP_ErrorStringToCode(Tcl_Interp *interp, char *s)
+{
+    int offset;
+    int code;
+
+    offset = (strncasecmp(s, "LDAP_", 5) == 0) ? 0 : 5;
+    for (code = 0; code < LDAPTCL_MAXERR; code++) {
+       if (!ldaptclerrorcode[code]) continue;
+       if (strcasecmp(s, ldaptclerrorcode[code]+offset) == 0)
+           return code;
+    }
+    Tcl_ResetResult(interp);
+    Tcl_AppendResult(interp, s, " is an invalid code", (char *) NULL);
+    return -1;
+}
 
 /*-----------------------------------------------------------------------------
  * LDAP_ProcessOneSearchResult --
@@ -119,7 +181,7 @@ static int ldap_get_lderrno(LDAP *ld)
  *   o TCL_ERROR if an error occured, with error message in interp.
  *-----------------------------------------------------------------------------
  */
-static int
+int
 LDAP_ProcessOneSearchResult (interp, ldap, entry, destArrayNameObj, evalCodeObj)
     Tcl_Interp     *interp;
     LDAP           *ldap;
@@ -134,6 +196,7 @@ LDAP_ProcessOneSearchResult (interp, ldap, entry, destArrayNameObj, evalCodeObj)
     BerElement     *ber; 
     struct berval **bvals;
     char          *dn;
+    int                    lderrno;
 
     Tcl_UnsetVar (interp, Tcl_GetStringFromObj (destArrayNameObj, NULL), 0);
 
@@ -147,6 +210,13 @@ LDAP_ProcessOneSearchResult (interp, ldap, entry, destArrayNameObj, evalCodeObj)
            return TCL_ERROR;
        ldap_memfree(dn);
     }
+    attributeNameObj = Tcl_NewObj();
+    Tcl_IncrRefCount (attributeNameObj);
+
+    /* Note that attributeName below is allocated for OL2+ libldap, so it
+       must be freed with ldap_memfree().  Test below is admittedly a hack.
+    */
+
     for (attributeName = ldap_first_attribute (ldap, entry, &ber); 
       attributeName != NULL;
       attributeName = ldap_next_attribute(ldap, entry, ber)) {
@@ -160,17 +230,20 @@ LDAP_ProcessOneSearchResult (interp, ldap, entry, destArrayNameObj, evalCodeObj)
               as an error, we ignore it to present a consistent interface
               with Netscape's server
            */
-           attributeNameObj = Tcl_NewStringObj (attributeName, -1);
-           Tcl_IncrRefCount (attributeNameObj);
            attributeDataObj = Tcl_NewObj();
+           Tcl_SetStringObj(attributeNameObj, attributeName, -1);
+#if LDAP_API_VERSION >= 2004
+           ldap_memfree(attributeName);        /* free if newer API */
+#endif
            for (i = 0; bvals[i] != NULL; i++) {
                Tcl_Obj *singleAttributeValueObj;
 
-               singleAttributeValueObj = Tcl_NewStringObj (bvals[i]->bv_val, -1);
+               singleAttributeValueObj = Tcl_NewStringObj(bvals[i]->bv_val, bvals[i]->bv_len);
                if (Tcl_ListObjAppendElement (interp, 
                                              attributeDataObj, 
                                              singleAttributeValueObj) 
                  == TCL_ERROR) {
+                   ber_free(ber, 0);
                    return TCL_ERROR;
                }
            }
@@ -184,10 +257,9 @@ LDAP_ProcessOneSearchResult (interp, ldap, entry, destArrayNameObj, evalCodeObj)
                                TCL_LEAVE_ERR_MSG) == NULL) {
                return TCL_ERROR;
            }
-           Tcl_DecrRefCount (attributeNameObj);
        }
-       ldap_attributefree(attributeName);
     }
+    Tcl_DecrRefCount (attributeNameObj);
     return Tcl_EvalObj (interp, evalCodeObj);
 }
 
@@ -213,10 +285,11 @@ LDAP_ProcessOneSearchResult (interp, ldap, entry, destArrayNameObj, evalCodeObj)
  *   o TCL_ERROR if an error occured, with error message in interp.
  *-----------------------------------------------------------------------------
  */
-static int 
-LDAP_PerformSearch (interp, ldap, base, scope, attrs, filtpatt, value, destArrayNameObj, evalCodeObj)
+int 
+LDAP_PerformSearch (interp, ldaptcl, base, scope, attrs, filtpatt, value,
+       destArrayNameObj, evalCodeObj, timeout_p, all, sortattr)
     Tcl_Interp     *interp;
-    LDAP           *ldap;
+    LDAPTCL        *ldaptcl;
     char           *base;
     int             scope;
     char          **attrs;
@@ -224,93 +297,115 @@ LDAP_PerformSearch (interp, ldap, base, scope, attrs, filtpatt, value, destArray
     char           *value;
     Tcl_Obj        *destArrayNameObj;
     Tcl_Obj        *evalCodeObj;
+    struct timeval *timeout_p;
+    int                    all;
+    char          *sortattr;
 {
+    LDAP        *ldap = ldaptcl->ldap;
     char          filter[BUFSIZ];
     int           resultCode;
     int           errorCode;
     int                  abandon;
     int                  tclResult = TCL_OK;
     int                  msgid;
-    LDAPMessage  *resultMessage;
-    LDAPMessage  *entryMessage;
-
-    Tcl_Obj      *resultObj;
-    int                  lderr;
+    LDAPMessage  *resultMessage = 0;
+    LDAPMessage  *entryMessage = 0;
+    char         *sortKey;
 
-    resultObj = Tcl_GetObjResult (interp);
+    int                  lderrno;
 
     sprintf(filter, filtpatt, value);
 
+    fflush(stderr);
     if ((msgid = ldap_search (ldap, base, scope, filter, attrs, 0)) == -1) {
-       Tcl_AppendStringsToObj (resultObj,
+       Tcl_AppendResult (interp,
                                "LDAP start search error: ",
                                        LDAP_ERR_STRING(ldap),
                                (char *)NULL);
+       LDAP_SetErrorCode(ldaptcl, -1, interp);
        return TCL_ERROR;
     }
 
     abandon = 0;
-    while ((resultCode = ldap_result (ldap, 
-                             msgid, 
-                             0,
-                             NULL,
-                             &resultMessage)) == LDAP_RES_SEARCH_ENTRY) {
+    if (sortattr)
+       all = 1;
+    tclResult = TCL_OK;
+    while (!abandon) {
+       resultCode = ldap_result (ldap, msgid, all, timeout_p, &resultMessage);
+       if (resultCode != LDAP_RES_SEARCH_RESULT &&
+           resultCode != LDAP_RES_SEARCH_ENTRY)
+               break;
 
+       if (sortattr) {
+           sortKey = (strcasecmp(sortattr, "dn") == 0) ? NULL : sortattr;
+           ldap_sort_entries(ldap, &resultMessage, sortKey, strcasecmp);
+       }
        entryMessage = ldap_first_entry(ldap, resultMessage);
 
-       tclResult = LDAP_ProcessOneSearchResult  (interp, 
-                               ldap, 
-                               entryMessage,
-                               destArrayNameObj,
-                               evalCodeObj);
-       ldap_msgfree(resultMessage);
-       if (tclResult != TCL_OK) {
-           if (tclResult == TCL_CONTINUE) {
-               tclResult = TCL_OK;
-           } else if (tclResult == TCL_BREAK) {
-               tclResult = TCL_OK;
-               abandon = 1;
-               break;
-           } else if (tclResult == TCL_ERROR) {
-               char msg[100];
-               sprintf(msg, "\n    (\"search\" body line %d)",
-                       interp->errorLine);
-               Tcl_AddObjErrorInfo(interp, msg, -1);
-               abandon = 1;
-               break;
-           } else {
-               abandon = 1;
-               break;
+       while (entryMessage) {
+           tclResult = LDAP_ProcessOneSearchResult  (interp, 
+                                   ldap, 
+                                   entryMessage,
+                                   destArrayNameObj,
+                                   evalCodeObj);
+           if (tclResult != TCL_OK) {
+               if (tclResult == TCL_CONTINUE) {
+                   tclResult = TCL_OK;
+               } else if (tclResult == TCL_BREAK) {
+                   tclResult = TCL_OK;
+                   abandon = 1;
+                   break;
+               } else if (tclResult == TCL_ERROR) {
+                   char msg[100];
+                   sprintf(msg, "\n    (\"search\" body line %d)",
+                           interp->errorLine);
+                   Tcl_AddObjErrorInfo(interp, msg, -1);
+                   abandon = 1;
+                   break;
+               } else {
+                   abandon = 1;
+                   break;
+               }
            }
+           entryMessage = ldap_next_entry(ldap, entryMessage);
        }
+       if (resultCode == LDAP_RES_SEARCH_RESULT || all)
+           break;
+       if (resultMessage)
+       ldap_msgfree(resultMessage);
+       resultMessage = NULL;
     }
-
     if (abandon) {
-       ldap_abandon(ldap, msgid);
-    } else {
-       if (resultCode == LDAP_RES_SEARCH_RESULT) {
-           if ((errorCode = ldap_result2error (ldap, resultMessage, 0))
-             != LDAP_SUCCESS) {
-             Tcl_AppendStringsToObj (resultObj,
-                                     "LDAP search error: ",
-                                     ldap_err2string(errorCode),
-                                     (char *)NULL);
-             ldap_msgfree(resultMessage);
-             return TCL_ERROR;
-           }
-       }
-
-
-       if (resultCode == -1) {
-           Tcl_AppendStringsToObj (resultObj,
-                                   "LDAP result search error: ",
-                                   LDAP_ERR_STRING(ldap),
-                                   (char *)NULL);
-           return TCL_ERROR;
-       } else
+       if (resultMessage)
            ldap_msgfree(resultMessage);
+       if (resultCode == LDAP_RES_SEARCH_ENTRY)
+           ldap_abandon(ldap, msgid);
+       return tclResult;
+    }
+    if (resultCode == -1) {
+       Tcl_ResetResult (interp);
+       Tcl_AppendResult (interp,
+                               "LDAP result search error: ",
+                               LDAP_ERR_STRING(ldap),
+                               (char *)NULL);
+       LDAP_SetErrorCode(ldaptcl, -1, interp);
+       return TCL_ERROR;
     }
 
+    if ((errorCode = ldap_result2error (ldap, resultMessage, 0))
+      != LDAP_SUCCESS) {
+      Tcl_ResetResult (interp);
+      Tcl_AppendResult (interp,
+                             "LDAP search error: ",
+                             ldap_err2string(errorCode),
+                             (char *)NULL);
+      if (resultMessage)
+         ldap_msgfree(resultMessage);
+      LDAP_SetErrorCode(ldaptcl, errorCode, interp);
+      return TCL_ERROR;
+    }
+    if (resultMessage)
+       ldap_msgfree(resultMessage);
     return tclResult;
 }
 
@@ -326,7 +421,7 @@ LDAP_PerformSearch (interp, ldap, base, scope, attrs, filtpatt, value, destArray
  *      See the user documentation.
  *-----------------------------------------------------------------------------
  */     
-static int
+int
 NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
     ClientData    clientData;
     Tcl_Interp   *interp;
@@ -335,20 +430,23 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
 {
     char         *command;
     char         *subCommand;
-    LDAP         *ldap = (LDAP *)clientData;
+    LDAPTCL      *ldaptcl = (LDAPTCL *)clientData;
+    LDAP         *ldap = ldaptcl->ldap;
     char         *dn;
     int           is_add = 0;
     int           is_add_or_modify = 0;
     int           mod_op = 0;
     char        *m, *s, *errmsg;
     int                 errcode;
+    int                 tclResult;
+    int                 lderrno;       /* might be used by LDAP_ERR_STRING macro */
 
     Tcl_Obj      *resultObj = Tcl_GetObjResult (interp);
 
-    if (objc < 2)
-       return TclX_WrongArgs (interp,
-                             objv [0],
-                             "subcommand [args...]");
+    if (objc < 2) {
+       Tcl_WrongNumArgs (interp, 1, objv, "subcommand [args...]");
+       return TCL_ERROR;
+    }
 
     command = Tcl_GetStringFromObj (objv[0], NULL);
     subCommand = Tcl_GetStringFromObj (objv[1], NULL);
@@ -361,8 +459,10 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
        char     *ldap_authString;
        int       ldap_authInt;
 
-       if (objc != 5)
-           return TclX_WrongArgs (interp, objv [0], "bind authtype dn passwd");
+       if (objc != 5) {
+           Tcl_WrongNumArgs (interp, 2, objv, "authtype dn passwd");
+           return TCL_ERROR;
+       }
 
        ldap_authString = Tcl_GetStringFromObj (objv[2], NULL);
 
@@ -421,22 +521,27 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
                                    "LDAP bind error: ",
                                    ldap_err2string(errcode),
                                    (char *)NULL);
+           LDAP_SetErrorCode(ldaptcl, errcode, interp);
            return TCL_ERROR;
        }
        return TCL_OK;
     }
 
     if (STREQU (subCommand, "unbind")) {
-       if (objc != 2)
-           return TclX_WrongArgs (interp, objv [0], "unbind");
+       if (objc != 2) {
+           Tcl_WrongNumArgs (interp, 2, objv, "");
+           return TCL_ERROR;
+       }
 
        return Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], NULL));
     }
 
     /* object delete dn */
     if (STREQU (subCommand, "delete")) {
-       if (objc != 3)
-           return TclX_WrongArgs (interp, objv [0], "delete dn");
+       if (objc != 3) {
+           Tcl_WrongNumArgs (interp, 2, objv, "dn");
+           return TCL_ERROR;
+       }
 
        dn = Tcl_GetStringFromObj (objv [2], NULL);
        if ((errcode = ldap_delete_s(ldap, dn)) != LDAP_SUCCESS) {
@@ -444,6 +549,7 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
                                   "LDAP delete error: ",
                                   ldap_err2string(errcode),
                                   (char *)NULL);
+          LDAP_SetErrorCode(ldaptcl, errcode, interp);
           return TCL_ERROR;
        }
        return TCL_OK;
@@ -455,10 +561,10 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
        char    *rdn;
        int      deleteOldRdn;
 
-       if (objc != 4)
-           return TclX_WrongArgs (interp, 
-                                  objv [0], 
-                                  "delete_rdn|modify_rdn dn rdn");
+       if (objc != 4) {
+           Tcl_WrongNumArgs (interp, 2, objv, "dn rdn");
+           return TCL_ERROR;
+       }
 
        dn = Tcl_GetStringFromObj (objv [2], NULL);
        rdn = Tcl_GetStringFromObj (objv [3], NULL);
@@ -472,6 +578,7 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
                                    " error: ",
                                    ldap_err2string(errcode),
                                    (char *)NULL);
+           LDAP_SetErrorCode(ldaptcl, errcode, interp);
            return TCL_ERROR;
        }
        return TCL_OK;
@@ -508,13 +615,15 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
        Tcl_Obj    **attribObjv;
        int          valuesObjc;
        Tcl_Obj    **valuesObjv;
-       int          nPairs;
+       int          nPairs, allPairs;
        int          i;
        int          j;
+       int          pairIndex;
+       int          modIndex;
 
        Tcl_Obj      *resultObj = Tcl_GetObjResult (interp);
 
-       if (objc != 4) {
+       if (objc < 4 || objc > 4 && is_add || is_add == 0 && objc&1) {
            Tcl_AppendStringsToObj (resultObj,
                                    "wrong # args: ",
                                    Tcl_GetStringFromObj (objv [0], NULL),
@@ -522,41 +631,56 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
                                    subCommand,
                                    " dn attributePairList",
                                    (char *)NULL);
+           if (!is_add)
+               Tcl_AppendStringsToObj (resultObj,
+                   " ?[add|delete|replace] attributePairList ...?", (char *)NULL);
            return TCL_ERROR;
        }
 
        dn = Tcl_GetStringFromObj (objv [2], NULL);
 
-       if (Tcl_ListObjGetElements (interp, objv [3], &attribObjc, &attribObjv)
-         == TCL_ERROR) {
-          return TCL_ERROR;
+       allPairs = 0;
+       for (i = 3; i < objc; i += 2) {
+           if (Tcl_ListObjLength (interp, objv[i], &j) == TCL_ERROR)
+               return TCL_ERROR;
+           if (j & 1) {
+               Tcl_AppendStringsToObj (resultObj,
+                                       "attribute list does not contain an ",
+                                       "even number of key-value elements",
+                                       (char *)NULL);
+               return TCL_ERROR;
+           }
+           allPairs += j / 2;
        }
 
-        if (attribObjc & 1) {
-           Tcl_AppendStringsToObj (resultObj,
-                                   "attribute list does not contain an ",
-                                   "even number of key-value elements",
-                                   (char *)NULL);
-           return TCL_ERROR;
+       modArray = (LDAPMod **)malloc (sizeof(LDAPMod *) * (allPairs + 1));
+
+       pairIndex = 3;
+       modIndex = 0;
+
+       do {
+
+       if (Tcl_ListObjGetElements (interp, objv [pairIndex], &attribObjc, &attribObjv)
+         == TCL_ERROR) {
+          mod_op = -1;
+          goto badop;
        }
 
        nPairs = attribObjc / 2;
 
-       modArray = (LDAPMod **)ckalloc (sizeof(LDAPMod *) * (nPairs + 1));
-       modArray[nPairs] = (LDAPMod *) NULL;
-
        for (i = 0; i < nPairs; i++) {
-           mod = modArray[i] = (LDAPMod *) ckalloc (sizeof(LDAPMod));
+           mod = modArray[modIndex++] = (LDAPMod *) malloc (sizeof(LDAPMod));
            mod->mod_op = mod_op;
            mod->mod_type = Tcl_GetStringFromObj (attribObjv [i * 2], NULL);
 
            if (Tcl_ListObjGetElements (interp, attribObjv [i * 2 + 1], &valuesObjc, &valuesObjv) == TCL_ERROR) {
                /* FIX: cleanup memory here */
-               return TCL_ERROR;
+               mod_op = -1;
+               goto badop;
            }
 
            valPtrs = mod->mod_vals.modv_strvals = \
-               (char **)ckalloc (sizeof (char *) * (valuesObjc + 1));
+               (char **)malloc (sizeof (char *) * (valuesObjc + 1));
            valPtrs[valuesObjc] = (char *)NULL;
 
            for (j = 0; j < valuesObjc; j++) {
@@ -566,24 +690,54 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
                 * value be NULL to indicate entire attribute is to be 
                 * deleted */
                if ((*valPtrs [j] == '\0') 
-                   && (mod->mod_op == LDAP_MOD_DELETE)) {
+                   && (mod->mod_op == LDAP_MOD_DELETE || mod->mod_op == LDAP_MOD_REPLACE)) {
                        valPtrs [j] = NULL;
                }
            }
        }
 
-        if (is_add) {
+       pairIndex += 2;
+       if (mod_op != -1 && pairIndex < objc) {
+           subCommand = Tcl_GetStringFromObj (objv[pairIndex - 1], NULL);
+           mod_op = -1;
+           if (STREQU (subCommand, "add")) {
+               mod_op = LDAP_MOD_ADD;
+           } else if (STREQU (subCommand, "replace")) {
+               mod_op = LDAP_MOD_REPLACE;
+           } else if (STREQU (subCommand, "delete")) {
+               mod_op = LDAP_MOD_DELETE;
+           }
+           if (mod_op == -1) {
+               Tcl_SetStringObj (resultObj,
+                       "Additional operators must be one of"
+                       " add, replace, or delete", -1);
+               mod_op = -1;
+               goto badop;
+           }
+       }
+
+       } while (mod_op != -1 && pairIndex < objc);
+       modArray[modIndex] = (LDAPMod *) NULL;
+
+       if (is_add) {
            result = ldap_add_s (ldap, dn, modArray);
        } else {
            result = ldap_modify_s (ldap, dn, modArray);
+           if (ldaptcl->caching)
+               ldap_uncache_entry (ldap, dn);
        }
 
         /* free the modArray elements, then the modArray itself. */
-       for (i = 0; i < nPairs; i++) {
-           ckfree ((char *) modArray[i]->mod_vals.modv_strvals);
-           ckfree ((char *) modArray[i]);
+badop:
+       for (i = 0; i < modIndex; i++) {
+           free ((char *) modArray[i]->mod_vals.modv_strvals);
+           free ((char *) modArray[i]);
        }
-       ckfree ((char *) modArray);
+       free ((char *) modArray);
+
+       /* after modArray is allocated, mod_op = -1 upon error for cleanup */
+       if (mod_op == -1)
+           return TCL_ERROR;
 
        /* FIX: memory cleanup required all over the place here */
         if (result != LDAP_SUCCESS) {
@@ -593,6 +747,7 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
                                    " error: ",
                                    ldap_err2string(result),
                                    (char *)NULL);
+           LDAP_SetErrorCode(ldaptcl, result, interp);
            return TCL_ERROR;
        }
        return TCL_OK;
@@ -617,13 +772,24 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
 
        char        *filterPatternString;
 
+       char        *timeoutString;
+       double       timeoutTime;
+       struct timeval timeout, *timeout_p;
+
+       char        *paramString;
+       int          cacheThis = -1;
+       int          all = 0;
+
+       char        *sortattr;
+
        Tcl_Obj     *destArrayNameObj;
        Tcl_Obj     *evalCodeObj;
 
-       if (objc != 5)
-           return TclX_WrongArgs (interp, 
-                                  objv [0],
-                                  "search controlArray destArray code");
+       if (objc != 5) {
+           Tcl_WrongNumArgs (interp, 2, objv,
+                                  "controlArray destArray code");
+           return TCL_ERROR;
+       }
 
         controlArrayNameObj = objv [2];
        controlArrayName = Tcl_GetStringFromObj (controlArrayNameObj, NULL);
@@ -652,14 +818,7 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
                                           "filter",
                                           0);
        if (filterPatternString == (char *)NULL) {
-           Tcl_AppendStringsToObj (resultObj,
-                                   "required element \"filter\" ",
-                                   "is missing from ldap control array \"",
-                                   controlArrayName,
-                                   "\"",
-                                   (char *)NULL);
-
-           return TCL_ERROR;
+           filterPatternString = "(objectclass=*)";
        }
 
        /* Fetch scope setting from control array.
@@ -671,29 +830,29 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
        } else {
            if (STREQU(scopeString, "base")) 
                scope = LDAP_SCOPE_BASE;
-           else if (STREQU(scopeString, "onelevel"))
+           else if (STRNEQU(scopeString, "one", 3))
                scope = LDAP_SCOPE_ONELEVEL;
-           else if (STREQU(scopeString, "subtree"))
+           else if (STRNEQU(scopeString, "sub", 3))
                scope = LDAP_SCOPE_SUBTREE;
            else {
                Tcl_AppendStringsToObj (resultObj,
                                        "\"scope\" element of \"",
                                        controlArrayName,
                                        "\" array is not one of ",
-                                       "\"base\", \"one_level\", ",
+                                       "\"base\", \"onelevel\", ",
                                        "or \"subtree\"",
                                      (char *) NULL);
                return TCL_ERROR;
            }
        }
 
+#ifdef LDAP_OPT_DEREF                                
        /* Fetch dereference control setting from control array.
         * If it doesn't exist, default to never dereference. */
        derefString = Tcl_GetVar2 (interp,
                                   controlArrayName,
                                   "deref",
                                   0);
-                                     
        if (derefString == (char *)NULL) {
            deref = LDAP_DEREF_NEVER;
        } else {
@@ -701,7 +860,7 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
                deref = LDAP_DEREF_NEVER;
            else if (STREQU(derefString, "search"))
                deref = LDAP_DEREF_SEARCHING;
-           else if (STREQU(derefString, "find") == 0)
+           else if (STREQU(derefString, "find"))
                deref = LDAP_DEREF_FINDING;
            else if (STREQU(derefString, "always"))
                deref = LDAP_DEREF_ALWAYS;
@@ -716,6 +875,7 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
                return TCL_ERROR;
            }
        }
+#endif
 
        /* Fetch list of attribute names from control array.
         * If entry doesn't exist, default to NULL (all).
@@ -735,6 +895,38 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
            }
        }
 
+       /* Fetch timeout value if there is one
+        */
+       timeoutString = Tcl_GetVar2 (interp,
+                                       controlArrayName,
+                                       "timeout", 
+                                       0);
+       timeout.tv_usec = 0;
+       if (timeoutString == (char *)NULL) {
+           timeout_p = NULL;
+           timeout.tv_sec = 0;
+       } else {
+           if (Tcl_GetDouble(interp, timeoutString, &timeoutTime) != TCL_OK)
+               return TCL_ERROR;
+           timeout.tv_sec = floor(timeoutTime);
+           timeout.tv_usec = (timeoutTime-timeout.tv_sec) * 1000000;
+           timeout_p = &timeout;
+       }
+
+       paramString = Tcl_GetVar2 (interp, controlArrayName, "cache", 0);
+       if (paramString) {
+           if (Tcl_GetInt(interp, paramString, &cacheThis) == TCL_ERROR)
+               return TCL_ERROR;
+       }
+
+       paramString = Tcl_GetVar2 (interp, controlArrayName, "all", 0);
+       if (paramString) {
+           if (Tcl_GetInt(interp, paramString, &all) == TCL_ERROR)
+               return TCL_ERROR;
+       }
+
+       sortattr = Tcl_GetVar2 (interp, controlArrayName, "sort", 0);
+
 #ifdef UMICH_LDAP
        ldap->ld_deref = deref; 
        ldap->ld_timelimit = 0;
@@ -742,36 +934,109 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
        ldap->ld_options = 0;
 #endif
 
-        return LDAP_PerformSearch (interp, 
-                                   ldap, 
+       /* Caching control within the search: if the "cache" control array */
+       /* value is set, disable/enable caching accordingly */
+
+#if 0
+       if (cacheThis >= 0 && ldaptcl->caching != cacheThis) {
+           if (cacheThis) {
+               if (ldaptcl->timeout == 0) {
+                   Tcl_SetStringObj(resultObj, "Caching never before enabled, I have no timeout value to use", -1);
+                   return TCL_ERROR;
+               }
+               ldap_enable_cache(ldap, ldaptcl->timeout, ldaptcl->maxmem);
+           }
+           else
+               ldap_disable_cache(ldap);
+       }
+#endif
+
+#ifdef LDAP_OPT_DEREF
+       ldap_set_option(ldap, LDAP_OPT_DEREF, &deref);
+#endif
+
+       tclResult = LDAP_PerformSearch (interp, 
+                                   ldaptcl, 
                                    baseString, 
                                    scope, 
                                    attributesArray, 
                                    filterPatternString, 
                                    "",
                                    destArrayNameObj,
-                                   evalCodeObj);
+                                   evalCodeObj,
+                                   timeout_p,
+                                   all,
+                                   sortattr);
+       /* Following the search, if we changed the caching behavior, change */
+       /* it back. */
+#if 0
+       if (cacheThis >= 0 && ldaptcl->caching != cacheThis) {
+           if (cacheThis)
+               ldap_disable_cache(ldap);
+           else
+               ldap_enable_cache(ldap, ldaptcl->timeout, ldaptcl->maxmem);
+       }
+#ifdef LDAP_OPT_DEREF
+       deref = LDAP_DEREF_NEVER;
+       ldap_set_option(ldap, LDAP_OPT_DEREF, &deref);
+#endif
+#endif
+       return tclResult;
+    }
+
+    /* object compare dn attr value */
+    if (STREQU (subCommand, "compare")) {
+       char        *dn;
+       char        *attr;
+       char        *value;
+       int          result;
+       int          lderrno;
+
+       if (objc != 5) {
+           Tcl_WrongNumArgs (interp, 
+                                  2, objv,
+                                  "dn attribute value");
+           return TCL_ERROR;
+       }
+
+       dn = Tcl_GetStringFromObj (objv[2], NULL);
+       attr = Tcl_GetStringFromObj (objv[3], NULL);
+       value = Tcl_GetStringFromObj (objv[4], NULL);
+       
+       result = ldap_compare_s (ldap, dn, attr, value);
+       if (result == LDAP_COMPARE_TRUE || result == LDAP_COMPARE_FALSE) {
+           Tcl_SetBooleanObj(resultObj, result == LDAP_COMPARE_TRUE);
+           return TCL_OK;
+       }
+       LDAP_SetErrorCode(ldaptcl, result, interp);
+       Tcl_AppendStringsToObj (resultObj,
+                               "LDAP compare error: ",
+                               LDAP_ERR_STRING(ldap),
+                               (char *)NULL);
+       return TCL_ERROR;
     }
 
-#if UMICH_LDAP
     if (STREQU (subCommand, "cache")) {
+#if defined(UMICH_LDAP) || (defined(OPEN_LDAP) && !defined(LDAP_API_VERSION))
        char *cacheCommand;
 
-       if (objc < 3)
+       if (objc < 3) {
          badargs:
-           return TclX_WrongArgs (interp, 
-                                  objv [0],
-                                  "cache command [args...]");
+           Tcl_WrongNumArgs (interp, 2, objv [0], "command [args...]");
+           return TCL_ERROR;
+       }
 
        cacheCommand = Tcl_GetStringFromObj (objv [2], NULL);
 
        if (STREQU (cacheCommand, "uncache")) {
            char *dn;
 
-           if (objc != 4)
-               return TclX_WrongArgs (interp, 
-                                      objv [0],
-                                      "cache uncache dn");
+           if (objc != 4) {
+               Tcl_WrongNumArgs (interp, 
+                                      3, objv,
+                                      "dn");
+               return TCL_ERROR;
+           }
 
             dn = Tcl_GetStringFromObj (objv [3], NULL);
            ldap_uncache_entry (ldap, dn);
@@ -779,27 +1044,40 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
        }
 
        if (STREQU (cacheCommand, "enable")) {
-           long   timeout;
-           long   maxmem;
+           long   timeout = ldaptcl->timeout;
+           long   maxmem = ldaptcl->maxmem;
 
-           if (objc != 5)
-               return TclX_WrongArgs (interp, 
-                                      objv [0],
-                                      "cache enable timeout maxmem");
-
-            if (Tcl_GetLongFromObj (interp, objv [3], &timeout) == TCL_ERROR)
+           if (objc > 5) {
+               Tcl_WrongNumArgs (interp, 3, objv, "?timeout? ?maxmem?");
                return TCL_ERROR;
+           }
 
-            if (Tcl_GetLongFromObj (interp, objv [4], &maxmem) == TCL_ERROR)
+           if (objc > 3) {
+               if (Tcl_GetLongFromObj (interp, objv [3], &timeout) == TCL_ERROR)
+                   return TCL_ERROR;
+           }
+           if (timeout == 0) {
+               Tcl_SetStringObj(resultObj,
+                   objc > 3 ? "timeouts must be greater than 0" : 
+                   "no previous timeout to reference", -1);
                return TCL_ERROR;
+           }
+
+           if (objc > 4)
+               if (Tcl_GetLongFromObj (interp, objv [4], &maxmem) == TCL_ERROR)
+                   return TCL_ERROR;
 
            if (ldap_enable_cache (ldap, timeout, maxmem) == -1) {
                Tcl_AppendStringsToObj (resultObj,
                                        "LDAP cache enable error: ",
                                        LDAP_ERR_STRING(ldap),
                                        (char *)NULL);
+               LDAP_SetErrorCode(ldaptcl, -1, interp);
                return TCL_ERROR;
            }
+           ldaptcl->caching = 1;
+           ldaptcl->timeout = timeout;
+           ldaptcl->maxmem = maxmem;
            return TCL_OK;
        }
 
@@ -807,11 +1085,13 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
 
        if (STREQU (cacheCommand, "disable")) {
            ldap_disable_cache (ldap);
+           ldaptcl->caching = 0;
            return TCL_OK;
        }
 
        if (STREQU (cacheCommand, "destroy")) {
            ldap_destroy_cache (ldap);
+           ldaptcl->caching = 0;
            return TCL_OK;
        }
 
@@ -847,8 +1127,81 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
                                " or \"all_errors\"",
                                (char *)NULL);
        return TCL_ERROR;
-    }
+#else
+       return TCL_OK;
 #endif
+    }
+    if (STREQU (subCommand, "trap")) {
+       Tcl_Obj *listObj, *resultObj;
+       int *p, l, i, code;
+
+       if (objc > 4) {
+           Tcl_WrongNumArgs (interp, 2, objv,
+                                  "command ?errorCode-list?");
+           return TCL_ERROR;
+       }
+       if (objc == 2) {
+           if (!ldaptcl->trapCmdObj)
+               return TCL_OK;
+           resultObj = Tcl_NewListObj(0, NULL);
+           Tcl_ListObjAppendElement(interp, resultObj, ldaptcl->trapCmdObj);
+           if (ldaptcl->traplist) {
+               listObj = Tcl_NewObj();
+               for (p = ldaptcl->traplist; *p; p++) {
+                   Tcl_ListObjAppendElement(interp, listObj, 
+                       Tcl_NewStringObj(ldaptclerrorcode[*p], -1));
+               }
+               Tcl_ListObjAppendElement(interp, resultObj, listObj);
+           }
+           Tcl_SetObjResult(interp, resultObj);
+           return TCL_OK;
+       }
+       if (ldaptcl->trapCmdObj) {
+           Tcl_DecrRefCount (ldaptcl->trapCmdObj);
+           ldaptcl->trapCmdObj = NULL;
+       }
+       if (ldaptcl->traplist) {
+           free(ldaptcl->traplist);
+           ldaptcl->traplist = NULL;
+       }
+       Tcl_GetStringFromObj(objv[2], &l);
+       if (l == 0)
+           return TCL_OK;              /* just turn off trap */
+       ldaptcl->trapCmdObj = objv[2];
+       Tcl_IncrRefCount (ldaptcl->trapCmdObj);
+       if (objc < 4)
+           return TCL_OK;              /* no code list */
+       if (Tcl_ListObjLength(interp, objv[3], &l) != TCL_OK)
+           return TCL_ERROR;
+       if (l == 0)
+           return TCL_OK;              /* empty code list */
+       ldaptcl->traplist = (int*)malloc(sizeof(int) * (l + 1));
+       ldaptcl->traplist[l] = 0;
+       for (i = 0; i < l; i++) {
+           Tcl_ListObjIndex(interp, objv[3], i, &resultObj);
+           code = LDAP_ErrorStringToCode(interp, Tcl_GetStringFromObj(resultObj, NULL));
+           if (code == -1) {
+               free(ldaptcl->traplist);
+               ldaptcl->traplist = NULL;
+               return TCL_ERROR;
+           }
+           ldaptcl->traplist[i] = code;
+       }
+       return TCL_OK;
+    }
+    if (STREQU (subCommand, "trapcodes")) {
+       int code;
+       Tcl_Obj *resultObj;
+       Tcl_Obj *stringObj;
+       resultObj = Tcl_GetObjResult(interp);
+
+       for (code = 0; code < LDAPTCL_MAXERR; code++) {
+           if (!ldaptclerrorcode[code]) continue;
+           Tcl_ListObjAppendElement(interp, resultObj,
+                       Tcl_NewStringObj(ldaptclerrorcode[code], -1));
+       }
+       return TCL_OK;
+    }
 #ifdef LDAP_DEBUG
     if (STREQU (subCommand, "debug")) {
        if (objc != 3) {
@@ -883,9 +1236,15 @@ static void
 NeoX_LdapObjDeleteCmd(clientData)
     ClientData    clientData;
 {
-    LDAP         *ldap = (LDAP *)clientData;
+    LDAPTCL      *ldaptcl = (LDAPTCL *)clientData;
+    LDAP         *ldap = ldaptcl->ldap;
 
+    if (ldaptcl->trapCmdObj)
+       Tcl_DecrRefCount (ldaptcl->trapCmdObj);
+    if (ldaptcl->traplist)
+       free(ldaptcl->traplist);
     ldap_unbind(ldap);
+    free((char*) ldaptcl);
 }
 
 /*-----------------------------------------------------------------------------
@@ -913,14 +1272,17 @@ NeoX_LdapObjCmd (clientData, interp, objc, objv)
     char         *subCommand;
     char         *newCommand;
     char         *ldapHost;
-    int           ldapPort = 389;
+    int           ldapPort = LDAP_PORT;
     LDAP         *ldap;
+    LDAPTCL     *ldaptcl;
 
     Tcl_Obj      *resultObj = Tcl_GetObjResult (interp);
 
-    if (objc < 3 || objc > 5)
-       return TclX_WrongArgs (interp, objv [0],
+    if (objc < 3) {
+       Tcl_WrongNumArgs (interp, 1, objv,
                               "(open|init) new_command host [port]|explode dn");
+       return TCL_ERROR;
+    }
 
     subCommand = Tcl_GetStringFromObj (objv[1], NULL);
 
@@ -937,7 +1299,8 @@ NeoX_LdapObjCmd (clientData, interp, objc, objv)
            } else if (STREQU(param, "-list")) {
                list = 1;
            } else {
-               return TclX_WrongArgs (interp, objv [0], "explode ?-nonames|-list? dn");
+               Tcl_WrongNumArgs (interp, 1, objv, "explode ?-nonames|-list? dn");
+               return TCL_ERROR;
            }
        }
        if (nonames || list)
@@ -997,7 +1360,58 @@ NeoX_LdapObjCmd (clientData, interp, objc, objv)
     if (STREQU (subCommand, "open")) {
        ldap = ldap_open (ldapHost, ldapPort);
     } else if (STREQU (subCommand, "init")) {
+       int version = -1;
+       int i;
+       int value;
+       char *subOption;
+       char *subValue;
+
+#if LDAPTCL_PROTOCOL_VERSION_DEFAULT
+       version = LDAPTCL_PROTOCOL_VERSION_DEFAULT;
+#endif
+
+       for (i = 6; i < objc; i += 2)  {
+           subOption =  Tcl_GetStringFromObj(objv[i-1], NULL);
+           if (STREQU (subOption, "protocol_version")) {
+#ifdef LDAP_OPT_PROTOCOL_VERSION
+               subValue = Tcl_GetStringFromObj(objv[i], NULL);
+               if (STREQU (subValue, "2")) {
+                   version = LDAP_VERSION2;
+               }
+               else if (STREQU (subValue, "3")) {
+#ifdef LDAP_VERSION3
+                   version = LDAP_VERSION3;
+#else
+                   Tcl_SetStringObj (resultObj, "protocol_version 3 not supported", -1);
+                   return TCL_ERROR;
+#endif
+               }
+               else {
+                   Tcl_SetStringObj (resultObj, "protocol_version must be '2' or '3'", -1);
+                   return TCL_ERROR;
+               }
+#else
+               Tcl_SetStringObj (resultObj, "protocol_version not supported", -1);
+               return TCL_ERROR;
+#endif
+           } else if (STREQU (subOption, "port")) {
+               if (Tcl_GetIntFromObj (interp, objv [i], &ldapPort) == TCL_ERROR) {
+                   Tcl_AppendStringsToObj (resultObj,
+                                           "LDAP port number is non-numeric",
+                                           (char *)NULL);
+                   return TCL_ERROR;
+               }
+           } else {
+               Tcl_SetStringObj (resultObj, "valid options: protocol_version, port", -1);
+               return TCL_ERROR;
+           }
+       }
        ldap = ldap_init (ldapHost, ldapPort);
+
+#if LDAP_OPT_PROTOCOL_VERSION
+       if (version != -1)
+           ldap_set_option(ldap, LDAP_OPT_PROTOCOL_VERSION, &version);
+#endif
     } else {
        Tcl_AppendStringsToObj (resultObj, 
                                "option was not \"open\" or \"init\"");
@@ -1016,10 +1430,19 @@ NeoX_LdapObjCmd (clientData, interp, objc, objv)
     ldap->ld_deref = LDAP_DEREF_NEVER;  /* Turn off alias dereferencing */
 #endif
 
+    ldaptcl = (LDAPTCL *) malloc(sizeof(LDAPTCL));
+    ldaptcl->ldap = ldap;
+    ldaptcl->caching = 0;
+    ldaptcl->timeout = 0;
+    ldaptcl->maxmem = 0;
+    ldaptcl->trapCmdObj = NULL;
+    ldaptcl->traplist = NULL;
+    ldaptcl->flags = 0;
+
     Tcl_CreateObjCommand (interp,
                          newCommand,
                           NeoX_LdapTargetObjCmd,
-                          (ClientData) ldap,
+                          (ClientData) ldaptcl,
                           NeoX_LdapObjDeleteCmd);
     return TCL_OK;
 }
@@ -1038,6 +1461,10 @@ Tcl_Interp   *interp;
                           NeoX_LdapObjCmd,
                           (ClientData) NULL,
                           (Tcl_CmdDeleteProc*) NULL);
-    Tcl_PkgProvide(interp, "Ldaptcl", "1.1");
+    /*
+    if (Neo_initLDAPX(interp) != TCL_OK)
+       return TCL_ERROR;
+    */
+    Tcl_PkgProvide(interp, "Ldaptcl", VERSION);
     return TCL_OK;
 }