summaryrefslogtreecommitdiffstats
path: root/contrib/ldaptcl/neoXldap.c
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/ldaptcl/neoXldap.c')
-rw-r--r--contrib/ldaptcl/neoXldap.c1470
1 files changed, 1470 insertions, 0 deletions
diff --git a/contrib/ldaptcl/neoXldap.c b/contrib/ldaptcl/neoXldap.c
new file mode 100644
index 0000000..b1ce03e
--- /dev/null
+++ b/contrib/ldaptcl/neoXldap.c
@@ -0,0 +1,1470 @@
+/*
+ * NeoSoft Tcl client extensions to Lightweight Directory Access Protocol.
+ *
+ * Copyright (c) 1998-1999 NeoSoft, Inc.
+ * All Rights Reserved.
+ *
+ * This software may be used, modified, copied, distributed, and sold,
+ * in both source and binary form provided that these copyrights are
+ * retained and their terms are followed.
+ *
+ * Under no circumstances are the authors or NeoSoft Inc. responsible
+ * for the proper functioning of this software, nor do the authors
+ * assume any liability for damages incurred with its use.
+ *
+ * Redistribution and use in source and binary forms are permitted
+ * provided that this notice is preserved and that due credit is given
+ * to NeoSoft, Inc.
+ *
+ * NeoSoft, Inc. may not be used to endorse or promote products derived
+ * from this software without specific prior written permission. This
+ * software is provided ``as is'' without express or implied warranty.
+ *
+ * Requests for permission may be sent to NeoSoft Inc, 1770 St. James Place,
+ * Suite 500, Houston, TX, 77056.
+ *
+ * $OpenLDAP$
+ *
+ */
+
+/*
+ * This code was originally developed by Karl Lehenbauer to work with
+ * Umich-3.3 LDAP. It was debugged against the Netscape LDAP server
+ * and their much more reliable SDK, and again backported to the
+ * 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.
+ * 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"
+
+#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
+ * checking of the strings are equal.
+ */
+
+#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
+ * of the code. It's ugly, and can use some work. This code was
+ * originally developed to work with Umich-3.3 LDAP. It was debugged
+ * against the Netscape LDAP server and the much more reliable SDK,
+ * and then again backported to the Umich-3.3 client code.
+ */
+#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
+ ** specific (though I would hope it's value is greater than 1823).
+ ** 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
+#define ldap_get_lderrno(ld) (ld->ld_errno)
+#endif
+#define LDAP_ERR_STRING(ld) \
+ ldap_err2string(ldap_get_lderrno(ld))
+#elif defined( LDAP_OPT_SIZELIMIT )
+ /*
+ ** Netscape SDK w/ ldap_set_option, ldap_get_option
+ */
+#define LDAP_ERR_STRING(ld) \
+ ldap_err2string(ldap_get_lderrno(ldap))
+#else
+ /* U-Mich/OpenLDAP 1.x API */
+ /* RFC-1823 w/ changes */
+#define UMICH_LDAP 1
+#define ldap_memfree(p) free(p)
+#define ldap_ber_free(p, n) ber_free(p, n)
+#define ldap_value_free_len(bvals) ber_bvecfree(bvals)
+#define ldap_get_lderrno(ld) (ld->ld_errno)
+#define LDAP_ERR_STRING(ld) \
+ ldap_err2string(ld->ld_errno)
+#endif
+
+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)
+{
+ 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);
+ }
+}
+
+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 --
+ *
+ * Process one result return from an LDAP search.
+ *
+ * Paramaters:
+ * o interp - Tcl interpreter; Errors are returned in result.
+ * o ldap - LDAP structure pointer.
+ * o entry - LDAP message pointer.
+ * o destArrayNameObj - Name of Tcl array in which to store attributes.
+ * o evalCodeObj - Tcl_Obj pointer to code to eval against this result.
+ * Returns:
+ * o TCL_OK if processing succeeded..
+ * o TCL_ERROR if an error occured, with error message in interp.
+ *-----------------------------------------------------------------------------
+ */
+int
+LDAP_ProcessOneSearchResult (interp, ldap, entry, destArrayNameObj, evalCodeObj)
+ Tcl_Interp *interp;
+ LDAP *ldap;
+ LDAPMessage *entry;
+ Tcl_Obj *destArrayNameObj;
+ Tcl_Obj *evalCodeObj;
+{
+ char *attributeName;
+ Tcl_Obj *attributeNameObj;
+ Tcl_Obj *attributeDataObj;
+ int i;
+ BerElement *ber;
+ struct berval **bvals;
+ char *dn;
+ int lderrno;
+
+ Tcl_UnsetVar (interp, Tcl_GetStringFromObj (destArrayNameObj, NULL), 0);
+
+ dn = ldap_get_dn(ldap, entry);
+ if (dn != NULL) {
+ if (Tcl_SetVar2(interp, /* set dn */
+ Tcl_GetStringFromObj(destArrayNameObj, NULL),
+ "dn",
+ dn,
+ TCL_LEAVE_ERR_MSG) == NULL)
+ 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)) {
+
+ bvals = ldap_get_values_len(ldap, entry, attributeName);
+
+ if (bvals != NULL) {
+ /* Note here that the U.of.M. ldap will return a null bvals
+ when the last attribute value has been deleted, but still
+ retains the attributeName. Even though this is documented
+ as an error, we ignore it to present a consistent interface
+ with Netscape's server
+ */
+ 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, bvals[i]->bv_len);
+ if (Tcl_ListObjAppendElement (interp,
+ attributeDataObj,
+ singleAttributeValueObj)
+ == TCL_ERROR) {
+ ber_free(ber, 0);
+ return TCL_ERROR;
+ }
+ }
+
+ ldap_value_free_len(bvals);
+
+ if (Tcl_ObjSetVar2 (interp,
+ destArrayNameObj,
+ attributeNameObj,
+ attributeDataObj,
+ TCL_LEAVE_ERR_MSG) == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ }
+ Tcl_DecrRefCount (attributeNameObj);
+ return Tcl_EvalObj (interp, evalCodeObj);
+}
+
+/*-----------------------------------------------------------------------------
+ * LDAP_PerformSearch --
+ *
+ * Perform an LDAP search.
+ *
+ * Paramaters:
+ * o interp - Tcl interpreter; Errors are returned in result.
+ * o ldap - LDAP structure pointer.
+ * o base - Base DN from which to perform search.
+ * o scope - LDAP search scope, must be one of LDAP_SCOPE_BASE,
+ * LDAP_SCOPE_ONELEVEL, or LDAP_SCOPE_SUBTREE.
+ * o attrs - Pointer to array of char * pointers of desired
+ * attribute names, or NULL for all attributes.
+ * o filtpatt LDAP filter pattern.
+ * o value Value to get sprintf'ed into filter pattern.
+ * o destArrayNameObj - Name of Tcl array in which to store attributes.
+ * o evalCodeObj - Tcl_Obj pointer to code to eval against this result.
+ * Returns:
+ * o TCL_OK if processing succeeded..
+ * o TCL_ERROR if an error occured, with error message in interp.
+ *-----------------------------------------------------------------------------
+ */
+int
+LDAP_PerformSearch (interp, ldaptcl, base, scope, attrs, filtpatt, value,
+ destArrayNameObj, evalCodeObj, timeout_p, all, sortattr)
+ Tcl_Interp *interp;
+ LDAPTCL *ldaptcl;
+ char *base;
+ int scope;
+ char **attrs;
+ char *filtpatt;
+ 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 = 0;
+ LDAPMessage *entryMessage = 0;
+ char *sortKey;
+
+ int lderrno;
+
+ sprintf(filter, filtpatt, value);
+
+ fflush(stderr);
+ if ((msgid = ldap_search (ldap, base, scope, filter, attrs, 0)) == -1) {
+ Tcl_AppendResult (interp,
+ "LDAP start search error: ",
+ LDAP_ERR_STRING(ldap),
+ (char *)NULL);
+ LDAP_SetErrorCode(ldaptcl, -1, interp);
+ return TCL_ERROR;
+ }
+
+ abandon = 0;
+ 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);
+
+ 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) {
+ 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;
+}
+
+/*-----------------------------------------------------------------------------
+ * NeoX_LdapTargetObjCmd --
+ *
+ * Implements the body of commands created by Neo_LdapObjCmd.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *-----------------------------------------------------------------------------
+ */
+int
+NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ char *command;
+ char *subCommand;
+ 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) {
+ Tcl_WrongNumArgs (interp, 1, objv, "subcommand [args...]");
+ return TCL_ERROR;
+ }
+
+ command = Tcl_GetStringFromObj (objv[0], NULL);
+ subCommand = Tcl_GetStringFromObj (objv[1], NULL);
+
+ /* object bind authtype name password */
+ if (STREQU (subCommand, "bind")) {
+ char *binddn;
+ char *passwd;
+ int stringLength;
+ char *ldap_authString;
+ int ldap_authInt;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs (interp, 2, objv, "authtype dn passwd");
+ return TCL_ERROR;
+ }
+
+ ldap_authString = Tcl_GetStringFromObj (objv[2], NULL);
+
+ if (STREQU (ldap_authString, "simple")) {
+ ldap_authInt = LDAP_AUTH_SIMPLE;
+ }
+#ifdef UMICH_LDAP
+ else if (STREQU (ldap_authString, "kerberos_ldap")) {
+ ldap_authInt = LDAP_AUTH_KRBV41;
+ } else if (STREQU (ldap_authString, "kerberos_dsa")) {
+ ldap_authInt = LDAP_AUTH_KRBV42;
+ } else if (STREQU (ldap_authString, "kerberos_both")) {
+ ldap_authInt = LDAP_AUTH_KRBV4;
+ }
+#endif
+ else {
+ Tcl_AppendStringsToObj (resultObj,
+ "\"",
+ command,
+ " ",
+ subCommand,
+#ifdef UMICH_LDAP
+ "\" authtype must be one of \"simple\", ",
+ "\"kerberos_ldap\", \"kerberos_dsa\" ",
+ "or \"kerberos_both\"",
+#else
+ "\" authtype must be \"simple\", ",
+#endif
+ (char *)NULL);
+ return TCL_ERROR;
+ }
+
+ binddn = Tcl_GetStringFromObj (objv[3], &stringLength);
+ if (stringLength == 0)
+ binddn = NULL;
+
+ passwd = Tcl_GetStringFromObj (objv[4], &stringLength);
+ if (stringLength == 0)
+ passwd = NULL;
+
+/* ldap_bind_s(ldap, dn, pw, method) */
+
+#ifdef UMICH_LDAP
+#define LDAP_BIND(ldap, dn, pw, method) \
+ ldap_bind_s(ldap, dn, pw, method)
+#else
+#define LDAP_BIND(ldap, dn, pw, method) \
+ ldap_simple_bind_s(ldap, dn, pw)
+#endif
+ if ((errcode = LDAP_BIND (ldap,
+ binddn,
+ passwd,
+ ldap_authInt)) != LDAP_SUCCESS) {
+
+ Tcl_AppendStringsToObj (resultObj,
+ "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) {
+ 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) {
+ Tcl_WrongNumArgs (interp, 2, objv, "dn");
+ return TCL_ERROR;
+ }
+
+ dn = Tcl_GetStringFromObj (objv [2], NULL);
+ if ((errcode = ldap_delete_s(ldap, dn)) != LDAP_SUCCESS) {
+ Tcl_AppendStringsToObj (resultObj,
+ "LDAP delete error: ",
+ ldap_err2string(errcode),
+ (char *)NULL);
+ LDAP_SetErrorCode(ldaptcl, errcode, interp);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+ }
+
+ /* object rename_rdn dn rdn */
+ /* object modify_rdn dn rdn */
+ if (STREQU (subCommand, "rename_rdn") || STREQU (subCommand, "modify_rdn")) {
+ char *rdn;
+ int deleteOldRdn;
+
+ 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);
+
+ deleteOldRdn = (*subCommand == 'r');
+
+ if ((errcode = ldap_modrdn2_s (ldap, dn, rdn, deleteOldRdn)) != LDAP_SUCCESS) {
+ Tcl_AppendStringsToObj (resultObj,
+ "LDAP ",
+ subCommand,
+ " error: ",
+ ldap_err2string(errcode),
+ (char *)NULL);
+ LDAP_SetErrorCode(ldaptcl, errcode, interp);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+ }
+
+ /* object add dn attributePairList */
+ /* object add_attributes dn attributePairList */
+ /* object replace_attributes dn attributePairList */
+ /* object delete_attributes dn attributePairList */
+
+ if (STREQU (subCommand, "add")) {
+ is_add = 1;
+ is_add_or_modify = 1;
+ } else {
+ is_add = 0;
+ if (STREQU (subCommand, "add_attributes")) {
+ is_add_or_modify = 1;
+ mod_op = LDAP_MOD_ADD;
+ } else if (STREQU (subCommand, "replace_attributes")) {
+ is_add_or_modify = 1;
+ mod_op = LDAP_MOD_REPLACE;
+ } else if (STREQU (subCommand, "delete_attributes")) {
+ is_add_or_modify = 1;
+ mod_op = LDAP_MOD_DELETE;
+ }
+ }
+
+ if (is_add_or_modify) {
+ int result;
+ LDAPMod **modArray;
+ LDAPMod *mod;
+ char **valPtrs = NULL;
+ int attribObjc;
+ Tcl_Obj **attribObjv;
+ int valuesObjc;
+ Tcl_Obj **valuesObjv;
+ int nPairs, allPairs;
+ int i;
+ int j;
+ int pairIndex;
+ int modIndex;
+
+ Tcl_Obj *resultObj = Tcl_GetObjResult (interp);
+
+ if (objc < 4 || objc > 4 && is_add || is_add == 0 && objc&1) {
+ Tcl_AppendStringsToObj (resultObj,
+ "wrong # args: ",
+ Tcl_GetStringFromObj (objv [0], NULL),
+ " ",
+ 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);
+
+ 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;
+ }
+
+ 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;
+
+ for (i = 0; i < nPairs; i++) {
+ 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 */
+ mod_op = -1;
+ goto badop;
+ }
+
+ valPtrs = mod->mod_vals.modv_strvals = \
+ (char **)malloc (sizeof (char *) * (valuesObjc + 1));
+ valPtrs[valuesObjc] = (char *)NULL;
+
+ for (j = 0; j < valuesObjc; j++) {
+ valPtrs [j] = Tcl_GetStringFromObj (valuesObjv[j], NULL);
+
+ /* If it's "delete" and value is an empty string, make
+ * 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_REPLACE)) {
+ valPtrs [j] = NULL;
+ }
+ }
+ }
+
+ 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. */
+badop:
+ for (i = 0; i < modIndex; i++) {
+ free ((char *) modArray[i]->mod_vals.modv_strvals);
+ free ((char *) modArray[i]);
+ }
+ 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) {
+ Tcl_AppendStringsToObj (resultObj,
+ "LDAP ",
+ subCommand,
+ " error: ",
+ ldap_err2string(result),
+ (char *)NULL);
+ LDAP_SetErrorCode(ldaptcl, result, interp);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+ }
+
+ /* object search controlArray dn pattern */
+ if (STREQU (subCommand, "search")) {
+ char *controlArrayName;
+ Tcl_Obj *controlArrayNameObj;
+
+ char *scopeString;
+ int scope;
+
+ char *derefString;
+ int deref;
+
+ char *baseString;
+
+ char **attributesArray;
+ char *attributesString;
+ int attributesArgc;
+
+ 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) {
+ Tcl_WrongNumArgs (interp, 2, objv,
+ "controlArray destArray code");
+ return TCL_ERROR;
+ }
+
+ controlArrayNameObj = objv [2];
+ controlArrayName = Tcl_GetStringFromObj (controlArrayNameObj, NULL);
+
+ destArrayNameObj = objv [3];
+
+ evalCodeObj = objv [4];
+
+ baseString = Tcl_GetVar2 (interp,
+ controlArrayName,
+ "base",
+ 0);
+
+ if (baseString == (char *)NULL) {
+ Tcl_AppendStringsToObj (resultObj,
+ "required element \"base\" ",
+ "is missing from ldap control array \"",
+ controlArrayName,
+ "\"",
+ (char *)NULL);
+ return TCL_ERROR;
+ }
+
+ filterPatternString = Tcl_GetVar2 (interp,
+ controlArrayName,
+ "filter",
+ 0);
+ if (filterPatternString == (char *)NULL) {
+ filterPatternString = "(objectclass=*)";
+ }
+
+ /* Fetch scope setting from control array.
+ * If it doesn't exist, default to subtree scoping.
+ */
+ scopeString = Tcl_GetVar2 (interp, controlArrayName, "scope", 0);
+ if (scopeString == NULL) {
+ scope = LDAP_SCOPE_SUBTREE;
+ } else {
+ if (STREQU(scopeString, "base"))
+ scope = LDAP_SCOPE_BASE;
+ else if (STRNEQU(scopeString, "one", 3))
+ scope = LDAP_SCOPE_ONELEVEL;
+ else if (STRNEQU(scopeString, "sub", 3))
+ scope = LDAP_SCOPE_SUBTREE;
+ else {
+ Tcl_AppendStringsToObj (resultObj,
+ "\"scope\" element of \"",
+ controlArrayName,
+ "\" array is not one of ",
+ "\"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 {
+ if (STREQU(derefString, "never"))
+ deref = LDAP_DEREF_NEVER;
+ else if (STREQU(derefString, "search"))
+ deref = LDAP_DEREF_SEARCHING;
+ else if (STREQU(derefString, "find"))
+ deref = LDAP_DEREF_FINDING;
+ else if (STREQU(derefString, "always"))
+ deref = LDAP_DEREF_ALWAYS;
+ else {
+ Tcl_AppendStringsToObj (resultObj,
+ "\"deref\" element of \"",
+ controlArrayName,
+ "\" array is not one of ",
+ "\"never\", \"search\", \"find\", ",
+ "or \"always\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+#endif
+
+ /* Fetch list of attribute names from control array.
+ * If entry doesn't exist, default to NULL (all).
+ */
+ attributesString = Tcl_GetVar2 (interp,
+ controlArrayName,
+ "attributes",
+ 0);
+ if (attributesString == (char *)NULL) {
+ attributesArray = NULL;
+ } else {
+ if ((Tcl_SplitList (interp,
+ attributesString,
+ &attributesArgc,
+ &attributesArray)) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ /* 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;
+ ldap->ld_sizelimit = 0;
+ ldap->ld_options = 0;
+#endif
+
+ /* 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,
+ 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 (STREQU (subCommand, "cache")) {
+#if defined(UMICH_LDAP) || (defined(OPEN_LDAP) && !defined(LDAP_API_VERSION))
+ char *cacheCommand;
+
+ if (objc < 3) {
+ badargs:
+ 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) {
+ Tcl_WrongNumArgs (interp,
+ 3, objv,
+ "dn");
+ return TCL_ERROR;
+ }
+
+ dn = Tcl_GetStringFromObj (objv [3], NULL);
+ ldap_uncache_entry (ldap, dn);
+ return TCL_OK;
+ }
+
+ if (STREQU (cacheCommand, "enable")) {
+ long timeout = ldaptcl->timeout;
+ long maxmem = ldaptcl->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)
+ 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;
+ }
+
+ if (objc != 3) goto badargs;
+
+ 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;
+ }
+
+ if (STREQU (cacheCommand, "flush")) {
+ ldap_flush_cache (ldap);
+ return TCL_OK;
+ }
+
+ if (STREQU (cacheCommand, "no_errors")) {
+ ldap_set_cache_options (ldap, LDAP_CACHE_OPT_CACHENOERRS);
+ return TCL_OK;
+ }
+
+ if (STREQU (cacheCommand, "all_errors")) {
+ ldap_set_cache_options (ldap, LDAP_CACHE_OPT_CACHEALLERRS);
+ return TCL_OK;
+ }
+
+ if (STREQU (cacheCommand, "size_errors")) {
+ ldap_set_cache_options (ldap, 0);
+ return TCL_OK;
+ }
+ Tcl_AppendStringsToObj (resultObj,
+ "\"",
+ command,
+ " ",
+ subCommand,
+ "\" subcommand",
+ " must be one of \"enable\", ",
+ "\"disable\", ",
+ "\"destroy\", \"flush\", \"uncache\", ",
+ "\"no_errors\", \"size_errors\",",
+ " 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) {
+ Tcl_AppendStringsToObj(resultObj, "Wrong # of arguments",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ return Tcl_GetIntFromObj(interp, objv[2], &ldap_debug);
+ }
+#endif
+
+ /* FIX: this needs to enumerate all the possibilities */
+ Tcl_AppendStringsToObj (resultObj,
+ "subcommand \"",
+ subCommand,
+ "\" must be one of \"add\", ",
+ "\"add_attributes\", ",
+ "\"bind\", \"cache\", \"delete\", ",
+ "\"delete_attributes\", \"modify\", ",
+ "\"modify_rdn\", \"rename_rdn\", ",
+ "\"replace_attributes\", ",
+ "\"search\" or \"unbind\".",
+ (char *)NULL);
+ return TCL_ERROR;
+}
+
+/*
+ * Delete and LDAP command object
+ *
+ */
+static void
+NeoX_LdapObjDeleteCmd(clientData)
+ ClientData 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);
+}
+
+/*-----------------------------------------------------------------------------
+ * NeoX_LdapObjCmd --
+ *
+ * Implements the `ldap' command:
+ * ldap open newObjName host [port]
+ * ldap init newObjName host [port]
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *-----------------------------------------------------------------------------
+ */
+static int
+NeoX_LdapObjCmd (clientData, interp, objc, objv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ extern int errno;
+ char *subCommand;
+ char *newCommand;
+ char *ldapHost;
+ int ldapPort = LDAP_PORT;
+ LDAP *ldap;
+ LDAPTCL *ldaptcl;
+
+ Tcl_Obj *resultObj = Tcl_GetObjResult (interp);
+
+ 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);
+
+ if (STREQU(subCommand, "explode")) {
+ char *param;
+ int nonames = 0;
+ int list = 0;
+ char **exploded, **p;
+
+ param = Tcl_GetStringFromObj (objv[2], NULL);
+ if (param[0] == '-') {
+ if (STREQU(param, "-nonames")) {
+ nonames = 1;
+ } else if (STREQU(param, "-list")) {
+ list = 1;
+ } else {
+ Tcl_WrongNumArgs (interp, 1, objv, "explode ?-nonames|-list? dn");
+ return TCL_ERROR;
+ }
+ }
+ if (nonames || list)
+ param = Tcl_GetStringFromObj (objv[3], NULL);
+ exploded = ldap_explode_dn(param, nonames);
+ for (p = exploded; *p; p++) {
+ if (list) {
+ char *q = strchr(*p, '=');
+ if (!q) {
+ Tcl_SetObjLength(resultObj, 0);
+ Tcl_AppendStringsToObj(resultObj, "rdn ", *p,
+ " missing '='", NULL);
+ ldap_value_free(exploded);
+ return TCL_ERROR;
+ }
+ *q = '\0';
+ if (Tcl_ListObjAppendElement(interp, resultObj,
+ Tcl_NewStringObj(*p, -1)) != TCL_OK ||
+ Tcl_ListObjAppendElement(interp, resultObj,
+ Tcl_NewStringObj(q+1, -1)) != TCL_OK) {
+ ldap_value_free(exploded);
+ return TCL_ERROR;
+ }
+ } else {
+ if (Tcl_ListObjAppendElement(interp, resultObj,
+ Tcl_NewStringObj(*p, -1))) {
+ ldap_value_free(exploded);
+ return TCL_ERROR;
+ }
+ }
+ }
+ ldap_value_free(exploded);
+ return TCL_OK;
+ }
+
+#ifdef UMICH_LDAP
+ if (STREQU(subCommand, "friendly")) {
+ char *friendly = ldap_dn2ufn(Tcl_GetStringFromObj(objv[2], NULL));
+ Tcl_SetStringObj(resultObj, friendly, -1);
+ free(friendly);
+ return TCL_OK;
+ }
+#endif
+
+ newCommand = Tcl_GetStringFromObj (objv[2], NULL);
+ ldapHost = Tcl_GetStringFromObj (objv[3], NULL);
+
+ if (objc == 5) {
+ if (Tcl_GetIntFromObj (interp, objv [4], &ldapPort) == TCL_ERROR) {
+ Tcl_AppendStringsToObj (resultObj,
+ "LDAP port number is non-numeric",
+ (char *)NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ 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);
+
+#ifdef 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\"");
+ return TCL_ERROR;
+ }
+
+ if (ldap == (LDAP *)NULL) {
+ Tcl_SetErrno(errno);
+ Tcl_AppendStringsToObj (resultObj,
+ Tcl_PosixError (interp),
+ (char *)NULL);
+ return TCL_ERROR;
+ }
+
+#ifdef UMICH_LDAP
+ 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) ldaptcl,
+ NeoX_LdapObjDeleteCmd);
+ return TCL_OK;
+}
+
+/*-----------------------------------------------------------------------------
+ * Neo_initLDAP --
+ * Initialize the LDAP interface.
+ *-----------------------------------------------------------------------------
+ */
+int
+Ldaptcl_Init (interp)
+Tcl_Interp *interp;
+{
+ Tcl_CreateObjCommand (interp,
+ "ldap",
+ NeoX_LdapObjCmd,
+ (ClientData) NULL,
+ (Tcl_CmdDeleteProc*) NULL);
+ /*
+ if (Neo_initLDAPX(interp) != TCL_OK)
+ return TCL_ERROR;
+ */
+ Tcl_PkgProvide(interp, "Ldaptcl", VERSION);
+ return TCL_OK;
+}