]> git.sur5r.net Git - openldap/blobdiff - contrib/ldaptcl/neoXldap.c
Fix single-value delete, replace
[openldap] / contrib / ldaptcl / neoXldap.c
index d7e56a5d05c60ca11775a5eab14d5d090d150df6..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/08/03 05:23:03 kunkee Exp $
+ * $OpenLDAP$
  *
  */
 
@@ -76,7 +76,9 @@
        ** In OpenLDAP 2.x-devel, its 2000 + the draft number, ie 2002.
        ** This section is for OPENLDAP.
        */
+#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
@@ -107,6 +109,8 @@ typedef struct ldaptclobj {
     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;
 
@@ -118,7 +122,7 @@ typedef struct ldaptclobj {
 static
 LDAP_SetErrorCode(LDAPTCL *ldaptcl, int code, Tcl_Interp *interp)
 {
-    char shortbuf[6];
+    char shortbuf[16];
     char *errp;
     int   lderrno;
 
@@ -132,6 +136,33 @@ LDAP_SetErrorCode(LDAPTCL *ldaptcl, int code, Tcl_Interp *interp)
        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);
+    }
+}
+
+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;
 }
 
 /*-----------------------------------------------------------------------------
@@ -179,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)) {
@@ -192,18 +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) {
-                   ldap_ber_free(ber, 0);
+                   ber_free(ber, 0);
                    return TCL_ERROR;
                }
            }
@@ -217,10 +257,9 @@ LDAP_ProcessOneSearchResult (interp, ldap, entry, destArrayNameObj, evalCodeObj)
                                TCL_LEAVE_ERR_MSG) == NULL) {
                return TCL_ERROR;
            }
-           Tcl_DecrRefCount (attributeNameObj);
        }
     }
-    ldap_ber_free(ber, 0);
+    Tcl_DecrRefCount (attributeNameObj);
     return Tcl_EvalObj (interp, evalCodeObj);
 }
 
@@ -269,20 +308,17 @@ LDAP_PerformSearch (interp, ldaptcl, base, scope, attrs, filtpatt, value,
     int                  abandon;
     int                  tclResult = TCL_OK;
     int                  msgid;
-    LDAPMessage  *resultMessage;
-    LDAPMessage  *entryMessage;
+    LDAPMessage  *resultMessage = 0;
+    LDAPMessage  *entryMessage = 0;
     char         *sortKey;
 
-    Tcl_Obj      *resultObj;
     int                  lderrno;
 
-    resultObj = Tcl_GetObjResult (interp);
-
     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);
@@ -335,43 +371,41 @@ LDAP_PerformSearch (interp, ldaptcl, base, scope, attrs, filtpatt, value,
        }
        if (resultCode == LDAP_RES_SEARCH_RESULT || all)
            break;
+       if (resultMessage)
        ldap_msgfree(resultMessage);
+       resultMessage = NULL;
     }
     if (abandon) {
-       ldap_msgfree(resultMessage);
+       if (resultMessage)
+           ldap_msgfree(resultMessage);
        if (resultCode == LDAP_RES_SEARCH_ENTRY)
            ldap_abandon(ldap, msgid);
        return tclResult;
     }
     if (resultCode == -1) {
-       Tcl_AppendStringsToObj (resultObj,
+       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 (resultCode == 0) {
-       Tcl_SetErrorCode (interp, "TIMEOUT", (char*) NULL);
-       Tcl_SetStringObj (resultObj, "LDAP timeout retrieving results", -1);
-       return TCL_ERROR;
-    }
-    /*
-    if (resultCode == LDAP_RES_SEARCH_RESULT || 
-       (all && resultCode == LDAP_RES_SEARCH_ENTRY))
-           return tclResult;
-    */
 
     if ((errorCode = ldap_result2error (ldap, resultMessage, 0))
       != LDAP_SUCCESS) {
-      Tcl_AppendStringsToObj (resultObj,
+      Tcl_ResetResult (interp);
+      Tcl_AppendResult (interp,
                              "LDAP search error: ",
                              ldap_err2string(errorCode),
                              (char *)NULL);
-      ldap_msgfree(resultMessage);
+      if (resultMessage)
+         ldap_msgfree(resultMessage);
       LDAP_SetErrorCode(ldaptcl, errorCode, interp);
       return TCL_ERROR;
     }
+    if (resultMessage)
+       ldap_msgfree(resultMessage);
     return tclResult;
 }
 
@@ -405,13 +439,14 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
     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);
@@ -424,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);
 
@@ -491,16 +528,20 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
     }
 
     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) {
@@ -520,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);
@@ -574,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),
@@ -588,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++) {
@@ -632,13 +690,36 @@ 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);
@@ -647,11 +728,16 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
        }
 
         /* 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) {
@@ -699,10 +785,11 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
        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);
@@ -731,7 +818,7 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
                                           "filter",
                                           0);
        if (filterPatternString == (char *)NULL) {
-           filterPatternString = "objectclass=*";
+           filterPatternString = "(objectclass=*)";
        }
 
        /* Fetch scope setting from control array.
@@ -759,13 +846,13 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
            }
        }
 
+#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 {
@@ -773,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;
@@ -788,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).
@@ -849,6 +937,7 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
        /* 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) {
@@ -860,6 +949,12 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
            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, 
@@ -874,34 +969,74 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
                                    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;
     }
 
-#if defined(UMICH_LDAP) || (defined(OPEN_LDAP) && !defined(LDAP_API_VERSION))
+    /* 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 (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);
@@ -912,10 +1047,10 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
            long   timeout = ldaptcl->timeout;
            long   maxmem = ldaptcl->maxmem;
 
-           if (objc > 5)
-               return TclX_WrongArgs (interp, 
-                                      objv [0],
-                                      "cache enable ?timeout? ?maxmem?");
+           if (objc > 5) {
+               Tcl_WrongNumArgs (interp, 3, objv, "?timeout? ?maxmem?");
+               return TCL_ERROR;
+           }
 
            if (objc > 3) {
                if (Tcl_GetLongFromObj (interp, objv [3], &timeout) == TCL_ERROR)
@@ -992,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) {
@@ -1031,8 +1239,12 @@ NeoX_LdapObjDeleteCmd(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);
-    ckfree((char*) ldaptcl);
+    free((char*) ldaptcl);
 }
 
 /*-----------------------------------------------------------------------------
@@ -1060,15 +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);
 
@@ -1085,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)
@@ -1145,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\"");
@@ -1164,11 +1430,13 @@ NeoX_LdapObjCmd (clientData, interp, objc, objv)
     ldap->ld_deref = LDAP_DEREF_NEVER;  /* Turn off alias dereferencing */
 #endif
 
-    ldaptcl = (LDAPTCL *) ckalloc(sizeof(LDAPTCL));
+    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,
@@ -1193,6 +1461,10 @@ Tcl_Interp   *interp;
                           NeoX_LdapObjCmd,
                           (ClientData) NULL,
                           (Tcl_CmdDeleteProc*) NULL);
+    /*
+    if (Neo_initLDAPX(interp) != TCL_OK)
+       return TCL_ERROR;
+    */
     Tcl_PkgProvide(interp, "Ldaptcl", VERSION);
     return TCL_OK;
 }