diff options
Diffstat (limited to '')
| -rw-r--r-- | contrib/ldaptcl/neoXldap.c | 1470 |
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; +} |