2 * NeoSoft Tcl client extensions to Lightweight Directory Access Protocol.
4 * Copyright (c) 1998-1999 NeoSoft, Inc.
7 * This software may be used, modified, copied, distributed, and sold,
8 * in both source and binary form provided that these copyrights are
9 * retained and their terms are followed.
11 * Under no circumstances are the authors or NeoSoft Inc. responsible
12 * for the proper functioning of this software, nor do the authors
13 * assume any liability for damages incurred with its use.
15 * Redistribution and use in source and binary forms are permitted
16 * provided that this notice is preserved and that due credit is given
19 * NeoSoft, Inc. may not be used to endorse or promote products derived
20 * from this software without specific prior written permission. This
21 * software is provided ``as is'' without express or implied warranty.
23 * Requests for permission may be sent to NeoSoft Inc, 1770 St. James Place,
24 * Suite 500, Houston, TX, 77056.
31 * This code was originally developed by Karl Lehenbauer to work with
32 * Umich-3.3 LDAP. It was debugged against the Netscape LDAP server
33 * and their much more reliable SDK, and again backported to the
34 * Umich-3.3 client code. The UMICH_LDAP define is used to include
35 * code that will work with the Umich-3.3 LDAP, but not with Netscape's
36 * SDK. OpenLDAP may support some of these, but they have not been tested.
37 * Currently supported by Randy Kunkee (kunkee@OpenLDAP.org).
41 * Add timeout to controlArray to set timeout for ldap_result.
45 #include "tclExtend.h"
54 * Macros to do string compares. They pre-check the first character before
55 * checking of the strings are equal.
58 #define STREQU(str1, str2) \
59 (((str1) [0] == (str2) [0]) && (strcmp (str1, str2) == 0))
60 #define STRNEQU(str1, str2, n) \
61 (((str1) [0] == (str2) [0]) && (strncmp (str1, str2, n) == 0))
64 * The following section defines some common macros used by the rest
65 * of the code. It's ugly, and can use some work. This code was
66 * originally developed to work with Umich-3.3 LDAP. It was debugged
67 * against the Netscape LDAP server and the much more reliable SDK,
68 * and then again backported to the Umich-3.3 client code.
71 #if defined(OPEN_LDAP)
72 /* LDAP_API_VERSION must be defined per the current draft spec
73 ** it's value will be assigned RFC number. However, as
74 ** no RFC is defined, it's value is currently implementation
75 ** specific (though I would hope it's value is greater than 1823).
76 ** In OpenLDAP 2.x-devel, its 2000 + the draft number, ie 2002.
77 ** This section is for OPENLDAP.
79 #define ldap_memfree(p) free(p)
80 #ifdef LDAP_OPT_ERROR_NUMBER
81 #define ldap_get_lderrno(ld) (ldap_get_option(ld, LDAP_OPT_ERROR_NUMBER, &lderrno), lderrno)
83 #define ldap_get_lderrno(ld) (ld->ld_errno)
85 #define LDAP_ERR_STRING(ld) \
86 ldap_err2string(ldap_get_lderrno(ld))
87 #elif defined( LDAP_OPT_SIZELIMIT )
89 ** Netscape SDK w/ ldap_set_option, ldap_get_option
91 #define LDAP_ERR_STRING(ld) \
92 ldap_err2string(ldap_get_lderrno(ldap))
94 /* U-Mich/OpenLDAP 1.x API */
95 /* RFC-1823 w/ changes */
97 #define ldap_memfree(p) free(p)
98 #define ldap_ber_free(p, n) ber_free(p, n)
99 #define ldap_value_free_len(bvals) ber_bvecfree(bvals)
100 #define ldap_get_lderrno(ld) (ld->ld_errno)
101 #define LDAP_ERR_STRING(ld) \
102 ldap_err2string(ld->ld_errno)
105 typedef struct ldaptclobj {
107 int caching; /* flag 1/0 if caching is enabled */
108 long timeout; /* timeout from last cache enable */
109 long maxmem; /* maxmem from last cache enable */
110 Tcl_Obj *trapCmdObj; /* error handler */
111 int *traplist; /* list of errorCodes to trap */
116 #define LDAPTCL_INTERRCODES 0x001
118 #include "ldaptclerr.h"
121 LDAP_SetErrorCode(LDAPTCL *ldaptcl, int code, Tcl_Interp *interp)
128 code = ldap_get_lderrno(ldaptcl->ldap);
129 if ((ldaptcl->flags & LDAPTCL_INTERRCODES) || code > LDAPTCL_MAXERR ||
130 ldaptclerrorcode[code] == NULL) {
131 sprintf(shortbuf, "0x%03x", code);
134 errp = ldaptclerrorcode[code];
136 Tcl_SetErrorCode(interp, errp, NULL);
137 if (ldaptcl->trapCmdObj) {
140 if (ldaptcl->traplist != NULL) {
141 for (i = ldaptcl->traplist; *i && *i != code; i++)
145 (void) Tcl_EvalObj(interp, ldaptcl->trapCmdObj);
150 LDAP_ErrorStringToCode(Tcl_Interp *interp, char *s)
155 offset = (strncasecmp(s, "LDAP_", 5) == 0) ? 0 : 5;
156 for (code = 0; code < LDAPTCL_MAXERR; code++) {
157 if (!ldaptclerrorcode[code]) continue;
158 if (strcasecmp(s, ldaptclerrorcode[code]+offset) == 0)
161 Tcl_ResetResult(interp);
162 Tcl_AppendResult(interp, s, " is an invalid code", (char *) NULL);
166 /*-----------------------------------------------------------------------------
167 * LDAP_ProcessOneSearchResult --
169 * Process one result return from an LDAP search.
172 * o interp - Tcl interpreter; Errors are returned in result.
173 * o ldap - LDAP structure pointer.
174 * o entry - LDAP message pointer.
175 * o destArrayNameObj - Name of Tcl array in which to store attributes.
176 * o evalCodeObj - Tcl_Obj pointer to code to eval against this result.
178 * o TCL_OK if processing succeeded..
179 * o TCL_ERROR if an error occured, with error message in interp.
180 *-----------------------------------------------------------------------------
183 LDAP_ProcessOneSearchResult (interp, ldap, entry, destArrayNameObj, evalCodeObj)
187 Tcl_Obj *destArrayNameObj;
188 Tcl_Obj *evalCodeObj;
191 Tcl_Obj *attributeNameObj;
192 Tcl_Obj *attributeDataObj;
195 struct berval **bvals;
199 Tcl_UnsetVar (interp, Tcl_GetStringFromObj (destArrayNameObj, NULL), 0);
201 dn = ldap_get_dn(ldap, entry);
203 if (Tcl_SetVar2(interp, /* set dn */
204 Tcl_GetStringFromObj(destArrayNameObj, NULL),
207 TCL_LEAVE_ERR_MSG) == NULL)
211 attributeNameObj = Tcl_NewObj();
212 Tcl_IncrRefCount (attributeNameObj);
213 for (attributeName = ldap_first_attribute (ldap, entry, &ber);
214 attributeName != NULL;
215 attributeName = ldap_next_attribute(ldap, entry, ber)) {
217 bvals = ldap_get_values_len(ldap, entry, attributeName);
220 /* Note here that the U.of.M. ldap will return a null bvals
221 when the last attribute value has been deleted, but still
222 retains the attributeName. Even though this is documented
223 as an error, we ignore it to present a consistent interface
224 with Netscape's server
226 attributeDataObj = Tcl_NewObj();
227 Tcl_SetStringObj(attributeNameObj, attributeName, -1);
228 for (i = 0; bvals[i] != NULL; i++) {
229 Tcl_Obj *singleAttributeValueObj;
231 singleAttributeValueObj = Tcl_NewStringObj(bvals[i]->bv_val, bvals[i]->bv_len);
232 if (Tcl_ListObjAppendElement (interp,
234 singleAttributeValueObj)
241 ldap_value_free_len(bvals);
243 if (Tcl_ObjSetVar2 (interp,
247 TCL_LEAVE_ERR_MSG) == NULL) {
252 Tcl_DecrRefCount (attributeNameObj);
253 return Tcl_EvalObj (interp, evalCodeObj);
256 /*-----------------------------------------------------------------------------
257 * LDAP_PerformSearch --
259 * Perform an LDAP search.
262 * o interp - Tcl interpreter; Errors are returned in result.
263 * o ldap - LDAP structure pointer.
264 * o base - Base DN from which to perform search.
265 * o scope - LDAP search scope, must be one of LDAP_SCOPE_BASE,
266 * LDAP_SCOPE_ONELEVEL, or LDAP_SCOPE_SUBTREE.
267 * o attrs - Pointer to array of char * pointers of desired
268 * attribute names, or NULL for all attributes.
269 * o filtpatt LDAP filter pattern.
270 * o value Value to get sprintf'ed into filter pattern.
271 * o destArrayNameObj - Name of Tcl array in which to store attributes.
272 * o evalCodeObj - Tcl_Obj pointer to code to eval against this result.
274 * o TCL_OK if processing succeeded..
275 * o TCL_ERROR if an error occured, with error message in interp.
276 *-----------------------------------------------------------------------------
279 LDAP_PerformSearch (interp, ldaptcl, base, scope, attrs, filtpatt, value,
280 destArrayNameObj, evalCodeObj, timeout_p, all, sortattr)
288 Tcl_Obj *destArrayNameObj;
289 Tcl_Obj *evalCodeObj;
290 struct timeval *timeout_p;
294 LDAP *ldap = ldaptcl->ldap;
299 int tclResult = TCL_OK;
301 LDAPMessage *resultMessage = 0;
302 LDAPMessage *entryMessage = 0;
307 sprintf(filter, filtpatt, value);
310 if ((msgid = ldap_search (ldap, base, scope, filter, attrs, 0)) == -1) {
311 Tcl_AppendResult (interp,
312 "LDAP start search error: ",
313 LDAP_ERR_STRING(ldap),
315 LDAP_SetErrorCode(ldaptcl, -1, interp);
324 resultCode = ldap_result (ldap, msgid, all, timeout_p, &resultMessage);
325 if (resultCode != LDAP_RES_SEARCH_RESULT &&
326 resultCode != LDAP_RES_SEARCH_ENTRY)
330 sortKey = (strcasecmp(sortattr, "dn") == 0) ? NULL : sortattr;
331 ldap_sort_entries(ldap, &resultMessage, sortKey, strcasecmp);
333 entryMessage = ldap_first_entry(ldap, resultMessage);
335 while (entryMessage) {
336 tclResult = LDAP_ProcessOneSearchResult (interp,
341 if (tclResult != TCL_OK) {
342 if (tclResult == TCL_CONTINUE) {
344 } else if (tclResult == TCL_BREAK) {
348 } else if (tclResult == TCL_ERROR) {
350 sprintf(msg, "\n (\"search\" body line %d)",
352 Tcl_AddObjErrorInfo(interp, msg, -1);
360 entryMessage = ldap_next_entry(ldap, entryMessage);
362 if (resultCode == LDAP_RES_SEARCH_RESULT || all)
365 ldap_msgfree(resultMessage);
366 resultMessage = NULL;
370 ldap_msgfree(resultMessage);
371 if (resultCode == LDAP_RES_SEARCH_ENTRY)
372 ldap_abandon(ldap, msgid);
375 if (resultCode == -1) {
376 Tcl_ResetResult (interp);
377 Tcl_AppendResult (interp,
378 "LDAP result search error: ",
379 LDAP_ERR_STRING(ldap),
381 LDAP_SetErrorCode(ldaptcl, -1, interp);
385 if ((errorCode = ldap_result2error (ldap, resultMessage, 0))
387 Tcl_ResetResult (interp);
388 Tcl_AppendResult (interp,
389 "LDAP search error: ",
390 ldap_err2string(errorCode),
393 ldap_msgfree(resultMessage);
394 LDAP_SetErrorCode(ldaptcl, errorCode, interp);
398 ldap_msgfree(resultMessage);
402 /*-----------------------------------------------------------------------------
403 * NeoX_LdapTargetObjCmd --
405 * Implements the body of commands created by Neo_LdapObjCmd.
408 * A standard Tcl result.
411 * See the user documentation.
412 *-----------------------------------------------------------------------------
415 NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
416 ClientData clientData;
419 Tcl_Obj *CONST objv[];
423 LDAPTCL *ldaptcl = (LDAPTCL *)clientData;
424 LDAP *ldap = ldaptcl->ldap;
427 int is_add_or_modify = 0;
429 char *m, *s, *errmsg;
433 Tcl_Obj *resultObj = Tcl_GetObjResult (interp);
436 return TclX_WrongArgs (interp,
438 "subcommand [args...]");
440 command = Tcl_GetStringFromObj (objv[0], NULL);
441 subCommand = Tcl_GetStringFromObj (objv[1], NULL);
443 /* object bind authtype name password */
444 if (STREQU (subCommand, "bind")) {
448 char *ldap_authString;
452 return TclX_WrongArgs (interp, objv [0], "bind authtype dn passwd");
454 ldap_authString = Tcl_GetStringFromObj (objv[2], NULL);
456 if (STREQU (ldap_authString, "simple")) {
457 ldap_authInt = LDAP_AUTH_SIMPLE;
460 else if (STREQU (ldap_authString, "kerberos_ldap")) {
461 ldap_authInt = LDAP_AUTH_KRBV41;
462 } else if (STREQU (ldap_authString, "kerberos_dsa")) {
463 ldap_authInt = LDAP_AUTH_KRBV42;
464 } else if (STREQU (ldap_authString, "kerberos_both")) {
465 ldap_authInt = LDAP_AUTH_KRBV4;
469 Tcl_AppendStringsToObj (resultObj,
475 "\" authtype must be one of \"simple\", ",
476 "\"kerberos_ldap\", \"kerberos_dsa\" ",
477 "or \"kerberos_both\"",
479 "\" authtype must be \"simple\", ",
485 binddn = Tcl_GetStringFromObj (objv[3], &stringLength);
486 if (stringLength == 0)
489 passwd = Tcl_GetStringFromObj (objv[4], &stringLength);
490 if (stringLength == 0)
493 /* ldap_bind_s(ldap, dn, pw, method) */
496 #define LDAP_BIND(ldap, dn, pw, method) \
497 ldap_bind_s(ldap, dn, pw, method)
499 #define LDAP_BIND(ldap, dn, pw, method) \
500 ldap_simple_bind_s(ldap, dn, pw)
502 if ((errcode = LDAP_BIND (ldap,
505 ldap_authInt)) != LDAP_SUCCESS) {
507 Tcl_AppendStringsToObj (resultObj,
509 ldap_err2string(errcode),
511 LDAP_SetErrorCode(ldaptcl, errcode, interp);
517 if (STREQU (subCommand, "unbind")) {
519 return TclX_WrongArgs (interp, objv [0], "unbind");
521 return Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], NULL));
524 /* object delete dn */
525 if (STREQU (subCommand, "delete")) {
527 return TclX_WrongArgs (interp, objv [0], "delete dn");
529 dn = Tcl_GetStringFromObj (objv [2], NULL);
530 if ((errcode = ldap_delete_s(ldap, dn)) != LDAP_SUCCESS) {
531 Tcl_AppendStringsToObj (resultObj,
532 "LDAP delete error: ",
533 ldap_err2string(errcode),
535 LDAP_SetErrorCode(ldaptcl, errcode, interp);
541 /* object rename_rdn dn rdn */
542 /* object modify_rdn dn rdn */
543 if (STREQU (subCommand, "rename_rdn") || STREQU (subCommand, "modify_rdn")) {
548 return TclX_WrongArgs (interp,
550 "delete_rdn|modify_rdn dn rdn");
552 dn = Tcl_GetStringFromObj (objv [2], NULL);
553 rdn = Tcl_GetStringFromObj (objv [3], NULL);
555 deleteOldRdn = (*subCommand == 'r');
557 if ((errcode = ldap_modrdn2_s (ldap, dn, rdn, deleteOldRdn)) != LDAP_SUCCESS) {
558 Tcl_AppendStringsToObj (resultObj,
562 ldap_err2string(errcode),
564 LDAP_SetErrorCode(ldaptcl, errcode, interp);
570 /* object add dn attributePairList */
571 /* object add_attributes dn attributePairList */
572 /* object replace_attributes dn attributePairList */
573 /* object delete_attributes dn attributePairList */
575 if (STREQU (subCommand, "add")) {
577 is_add_or_modify = 1;
580 if (STREQU (subCommand, "add_attributes")) {
581 is_add_or_modify = 1;
582 mod_op = LDAP_MOD_ADD;
583 } else if (STREQU (subCommand, "replace_attributes")) {
584 is_add_or_modify = 1;
585 mod_op = LDAP_MOD_REPLACE;
586 } else if (STREQU (subCommand, "delete_attributes")) {
587 is_add_or_modify = 1;
588 mod_op = LDAP_MOD_DELETE;
592 if (is_add_or_modify) {
596 char **valPtrs = NULL;
598 Tcl_Obj **attribObjv;
600 Tcl_Obj **valuesObjv;
605 Tcl_Obj *resultObj = Tcl_GetObjResult (interp);
608 Tcl_AppendStringsToObj (resultObj,
610 Tcl_GetStringFromObj (objv [0], NULL),
613 " dn attributePairList",
618 dn = Tcl_GetStringFromObj (objv [2], NULL);
620 if (Tcl_ListObjGetElements (interp, objv [3], &attribObjc, &attribObjv)
625 if (attribObjc & 1) {
626 Tcl_AppendStringsToObj (resultObj,
627 "attribute list does not contain an ",
628 "even number of key-value elements",
633 nPairs = attribObjc / 2;
635 modArray = (LDAPMod **)malloc (sizeof(LDAPMod *) * (nPairs + 1));
636 modArray[nPairs] = (LDAPMod *) NULL;
638 for (i = 0; i < nPairs; i++) {
639 mod = modArray[i] = (LDAPMod *) malloc (sizeof(LDAPMod));
640 mod->mod_op = mod_op;
641 mod->mod_type = Tcl_GetStringFromObj (attribObjv [i * 2], NULL);
643 if (Tcl_ListObjGetElements (interp, attribObjv [i * 2 + 1], &valuesObjc, &valuesObjv) == TCL_ERROR) {
644 /* FIX: cleanup memory here */
648 valPtrs = mod->mod_vals.modv_strvals = \
649 (char **)malloc (sizeof (char *) * (valuesObjc + 1));
650 valPtrs[valuesObjc] = (char *)NULL;
652 for (j = 0; j < valuesObjc; j++) {
653 valPtrs [j] = Tcl_GetStringFromObj (valuesObjv[j], NULL);
655 /* If it's "delete" and value is an empty string, make
656 * value be NULL to indicate entire attribute is to be
658 if ((*valPtrs [j] == '\0')
659 && (mod->mod_op == LDAP_MOD_DELETE || mod->mod_op == LDAP_MOD_REPLACE)) {
666 result = ldap_add_s (ldap, dn, modArray);
668 result = ldap_modify_s (ldap, dn, modArray);
669 if (ldaptcl->caching)
670 ldap_uncache_entry (ldap, dn);
673 /* free the modArray elements, then the modArray itself. */
674 for (i = 0; i < nPairs; i++) {
675 free ((char *) modArray[i]->mod_vals.modv_strvals);
676 free ((char *) modArray[i]);
678 free ((char *) modArray);
680 /* FIX: memory cleanup required all over the place here */
681 if (result != LDAP_SUCCESS) {
682 Tcl_AppendStringsToObj (resultObj,
686 ldap_err2string(result),
688 LDAP_SetErrorCode(ldaptcl, result, interp);
694 /* object search controlArray dn pattern */
695 if (STREQU (subCommand, "search")) {
696 char *controlArrayName;
697 Tcl_Obj *controlArrayNameObj;
707 char **attributesArray;
708 char *attributesString;
711 char *filterPatternString;
715 struct timeval timeout, *timeout_p;
723 Tcl_Obj *destArrayNameObj;
724 Tcl_Obj *evalCodeObj;
727 return TclX_WrongArgs (interp,
729 "search controlArray destArray code");
731 controlArrayNameObj = objv [2];
732 controlArrayName = Tcl_GetStringFromObj (controlArrayNameObj, NULL);
734 destArrayNameObj = objv [3];
736 evalCodeObj = objv [4];
738 baseString = Tcl_GetVar2 (interp,
743 if (baseString == (char *)NULL) {
744 Tcl_AppendStringsToObj (resultObj,
745 "required element \"base\" ",
746 "is missing from ldap control array \"",
753 filterPatternString = Tcl_GetVar2 (interp,
757 if (filterPatternString == (char *)NULL) {
758 filterPatternString = "(objectclass=*)";
761 /* Fetch scope setting from control array.
762 * If it doesn't exist, default to subtree scoping.
764 scopeString = Tcl_GetVar2 (interp, controlArrayName, "scope", 0);
765 if (scopeString == NULL) {
766 scope = LDAP_SCOPE_SUBTREE;
768 if (STREQU(scopeString, "base"))
769 scope = LDAP_SCOPE_BASE;
770 else if (STRNEQU(scopeString, "one", 3))
771 scope = LDAP_SCOPE_ONELEVEL;
772 else if (STRNEQU(scopeString, "sub", 3))
773 scope = LDAP_SCOPE_SUBTREE;
775 Tcl_AppendStringsToObj (resultObj,
776 "\"scope\" element of \"",
778 "\" array is not one of ",
779 "\"base\", \"onelevel\", ",
786 /* Fetch dereference control setting from control array.
787 * If it doesn't exist, default to never dereference. */
788 derefString = Tcl_GetVar2 (interp,
793 if (derefString == (char *)NULL) {
794 deref = LDAP_DEREF_NEVER;
796 if (STREQU(derefString, "never"))
797 deref = LDAP_DEREF_NEVER;
798 else if (STREQU(derefString, "search"))
799 deref = LDAP_DEREF_SEARCHING;
800 else if (STREQU(derefString, "find") == 0)
801 deref = LDAP_DEREF_FINDING;
802 else if (STREQU(derefString, "always"))
803 deref = LDAP_DEREF_ALWAYS;
805 Tcl_AppendStringsToObj (resultObj,
806 "\"deref\" element of \"",
808 "\" array is not one of ",
809 "\"never\", \"search\", \"find\", ",
816 /* Fetch list of attribute names from control array.
817 * If entry doesn't exist, default to NULL (all).
819 attributesString = Tcl_GetVar2 (interp,
823 if (attributesString == (char *)NULL) {
824 attributesArray = NULL;
826 if ((Tcl_SplitList (interp,
829 &attributesArray)) != TCL_OK) {
834 /* Fetch timeout value if there is one
836 timeoutString = Tcl_GetVar2 (interp,
841 if (timeoutString == (char *)NULL) {
845 if (Tcl_GetDouble(interp, timeoutString, &timeoutTime) != TCL_OK)
847 timeout.tv_sec = floor(timeoutTime);
848 timeout.tv_usec = (timeoutTime-timeout.tv_sec) * 1000000;
849 timeout_p = &timeout;
852 paramString = Tcl_GetVar2 (interp, controlArrayName, "cache", 0);
854 if (Tcl_GetInt(interp, paramString, &cacheThis) == TCL_ERROR)
858 paramString = Tcl_GetVar2 (interp, controlArrayName, "all", 0);
860 if (Tcl_GetInt(interp, paramString, &all) == TCL_ERROR)
864 sortattr = Tcl_GetVar2 (interp, controlArrayName, "sort", 0);
867 ldap->ld_deref = deref;
868 ldap->ld_timelimit = 0;
869 ldap->ld_sizelimit = 0;
870 ldap->ld_options = 0;
873 /* Caching control within the search: if the "cache" control array */
874 /* value is set, disable/enable caching accordingly */
877 if (cacheThis >= 0 && ldaptcl->caching != cacheThis) {
879 if (ldaptcl->timeout == 0) {
880 Tcl_SetStringObj(resultObj, "Caching never before enabled, I have no timeout value to use", -1);
883 ldap_enable_cache(ldap, ldaptcl->timeout, ldaptcl->maxmem);
886 ldap_disable_cache(ldap);
889 tclResult = LDAP_PerformSearch (interp,
901 /* Following the search, if we changed the caching behavior, change */
904 if (cacheThis >= 0 && ldaptcl->caching != cacheThis) {
906 ldap_disable_cache(ldap);
908 ldap_enable_cache(ldap, ldaptcl->timeout, ldaptcl->maxmem);
914 #if defined(UMICH_LDAP) || (defined(OPEN_LDAP) && !defined(LDAP_API_VERSION))
915 if (STREQU (subCommand, "cache")) {
920 return TclX_WrongArgs (interp,
922 "cache command [args...]");
924 cacheCommand = Tcl_GetStringFromObj (objv [2], NULL);
926 if (STREQU (cacheCommand, "uncache")) {
930 return TclX_WrongArgs (interp,
934 dn = Tcl_GetStringFromObj (objv [3], NULL);
935 ldap_uncache_entry (ldap, dn);
939 if (STREQU (cacheCommand, "enable")) {
940 long timeout = ldaptcl->timeout;
941 long maxmem = ldaptcl->maxmem;
944 return TclX_WrongArgs (interp,
946 "cache enable ?timeout? ?maxmem?");
949 if (Tcl_GetLongFromObj (interp, objv [3], &timeout) == TCL_ERROR)
953 Tcl_SetStringObj(resultObj,
954 objc > 3 ? "timeouts must be greater than 0" :
955 "no previous timeout to reference", -1);
960 if (Tcl_GetLongFromObj (interp, objv [4], &maxmem) == TCL_ERROR)
963 if (ldap_enable_cache (ldap, timeout, maxmem) == -1) {
964 Tcl_AppendStringsToObj (resultObj,
965 "LDAP cache enable error: ",
966 LDAP_ERR_STRING(ldap),
968 LDAP_SetErrorCode(ldaptcl, -1, interp);
971 ldaptcl->caching = 1;
972 ldaptcl->timeout = timeout;
973 ldaptcl->maxmem = maxmem;
977 if (objc != 3) goto badargs;
979 if (STREQU (cacheCommand, "disable")) {
980 ldap_disable_cache (ldap);
981 ldaptcl->caching = 0;
985 if (STREQU (cacheCommand, "destroy")) {
986 ldap_destroy_cache (ldap);
987 ldaptcl->caching = 0;
991 if (STREQU (cacheCommand, "flush")) {
992 ldap_flush_cache (ldap);
996 if (STREQU (cacheCommand, "no_errors")) {
997 ldap_set_cache_options (ldap, LDAP_CACHE_OPT_CACHENOERRS);
1001 if (STREQU (cacheCommand, "all_errors")) {
1002 ldap_set_cache_options (ldap, LDAP_CACHE_OPT_CACHEALLERRS);
1006 if (STREQU (cacheCommand, "size_errors")) {
1007 ldap_set_cache_options (ldap, 0);
1010 Tcl_AppendStringsToObj (resultObj,
1016 " must be one of \"enable\", ",
1018 "\"destroy\", \"flush\", \"uncache\", ",
1019 "\"no_errors\", \"size_errors\",",
1020 " or \"all_errors\"",
1025 if (STREQU (subCommand, "trap")) {
1026 Tcl_Obj *listObj, *resultObj;
1030 return TclX_WrongArgs (interp, objv [0],
1031 "trap command ?errorCode-list?");
1033 if (!ldaptcl->trapCmdObj)
1035 resultObj = Tcl_NewListObj(0, NULL);
1036 Tcl_ListObjAppendElement(interp, resultObj, ldaptcl->trapCmdObj);
1037 if (ldaptcl->traplist) {
1038 listObj = Tcl_NewObj();
1039 for (p = ldaptcl->traplist; *p; p++) {
1040 Tcl_ListObjAppendElement(interp, listObj,
1041 Tcl_NewStringObj(ldaptclerrorcode[*p], -1));
1043 Tcl_ListObjAppendElement(interp, resultObj, listObj);
1045 Tcl_SetObjResult(interp, resultObj);
1048 if (ldaptcl->trapCmdObj) {
1049 Tcl_DecrRefCount (ldaptcl->trapCmdObj);
1050 ldaptcl->trapCmdObj = NULL;
1052 if (ldaptcl->traplist) {
1053 free(ldaptcl->traplist);
1054 ldaptcl->traplist = NULL;
1056 Tcl_GetStringFromObj(objv[2], &l);
1058 return TCL_OK; /* just turn off trap */
1059 ldaptcl->trapCmdObj = objv[2];
1060 Tcl_IncrRefCount (ldaptcl->trapCmdObj);
1062 return TCL_OK; /* no code list */
1063 if (Tcl_ListObjLength(interp, objv[3], &l) != TCL_OK)
1066 return TCL_OK; /* empty code list */
1067 ldaptcl->traplist = (int*)malloc(sizeof(int) * (l + 1));
1068 ldaptcl->traplist[l] = 0;
1069 for (i = 0; i < l; i++) {
1070 Tcl_ListObjIndex(interp, objv[3], i, &resultObj);
1071 code = LDAP_ErrorStringToCode(interp, Tcl_GetStringFromObj(resultObj, NULL));
1073 free(ldaptcl->traplist);
1074 ldaptcl->traplist = NULL;
1077 ldaptcl->traplist[i] = code;
1081 if (STREQU (subCommand, "trapcodes")) {
1085 resultObj = Tcl_GetObjResult(interp);
1087 for (code = 0; code < LDAPTCL_MAXERR; code++) {
1088 if (!ldaptclerrorcode[code]) continue;
1089 Tcl_ListObjAppendElement(interp, resultObj,
1090 Tcl_NewStringObj(ldaptclerrorcode[code], -1));
1095 if (STREQU (subCommand, "debug")) {
1097 Tcl_AppendStringsToObj(resultObj, "Wrong # of arguments",
1101 return Tcl_GetIntFromObj(interp, objv[2], &ldap_debug);
1105 /* FIX: this needs to enumerate all the possibilities */
1106 Tcl_AppendStringsToObj (resultObj,
1109 "\" must be one of \"add\", ",
1110 "\"add_attributes\", ",
1111 "\"bind\", \"cache\", \"delete\", ",
1112 "\"delete_attributes\", \"modify\", ",
1113 "\"modify_rdn\", \"rename_rdn\", ",
1114 "\"replace_attributes\", ",
1115 "\"search\" or \"unbind\".",
1121 * Delete and LDAP command object
1125 NeoX_LdapObjDeleteCmd(clientData)
1126 ClientData clientData;
1128 LDAPTCL *ldaptcl = (LDAPTCL *)clientData;
1129 LDAP *ldap = ldaptcl->ldap;
1131 if (ldaptcl->trapCmdObj)
1132 Tcl_DecrRefCount (ldaptcl->trapCmdObj);
1133 if (ldaptcl->traplist)
1134 free(ldaptcl->traplist);
1136 free((char*) ldaptcl);
1139 /*-----------------------------------------------------------------------------
1140 * NeoX_LdapObjCmd --
1142 * Implements the `ldap' command:
1143 * ldap open newObjName host [port]
1144 * ldap init newObjName host [port]
1147 * A standard Tcl result.
1150 * See the user documentation.
1151 *-----------------------------------------------------------------------------
1154 NeoX_LdapObjCmd (clientData, interp, objc, objv)
1155 ClientData clientData;
1158 Tcl_Obj *CONST objv[];
1168 Tcl_Obj *resultObj = Tcl_GetObjResult (interp);
1170 if (objc < 3 || objc > 5)
1171 return TclX_WrongArgs (interp, objv [0],
1172 "(open|init) new_command host [port]|explode dn");
1174 subCommand = Tcl_GetStringFromObj (objv[1], NULL);
1176 if (STREQU(subCommand, "explode")) {
1180 char **exploded, **p;
1182 param = Tcl_GetStringFromObj (objv[2], NULL);
1183 if (param[0] == '-') {
1184 if (STREQU(param, "-nonames")) {
1186 } else if (STREQU(param, "-list")) {
1189 return TclX_WrongArgs (interp, objv [0], "explode ?-nonames|-list? dn");
1192 if (nonames || list)
1193 param = Tcl_GetStringFromObj (objv[3], NULL);
1194 exploded = ldap_explode_dn(param, nonames);
1195 for (p = exploded; *p; p++) {
1197 char *q = strchr(*p, '=');
1199 Tcl_SetObjLength(resultObj, 0);
1200 Tcl_AppendStringsToObj(resultObj, "rdn ", *p,
1201 " missing '='", NULL);
1202 ldap_value_free(exploded);
1206 if (Tcl_ListObjAppendElement(interp, resultObj,
1207 Tcl_NewStringObj(*p, -1)) != TCL_OK ||
1208 Tcl_ListObjAppendElement(interp, resultObj,
1209 Tcl_NewStringObj(q+1, -1)) != TCL_OK) {
1210 ldap_value_free(exploded);
1214 if (Tcl_ListObjAppendElement(interp, resultObj,
1215 Tcl_NewStringObj(*p, -1))) {
1216 ldap_value_free(exploded);
1221 ldap_value_free(exploded);
1226 if (STREQU(subCommand, "friendly")) {
1227 char *friendly = ldap_dn2ufn(Tcl_GetStringFromObj(objv[2], NULL));
1228 Tcl_SetStringObj(resultObj, friendly, -1);
1234 newCommand = Tcl_GetStringFromObj (objv[2], NULL);
1235 ldapHost = Tcl_GetStringFromObj (objv[3], NULL);
1238 if (Tcl_GetIntFromObj (interp, objv [4], &ldapPort) == TCL_ERROR) {
1239 Tcl_AppendStringsToObj (resultObj,
1240 "LDAP port number is non-numeric",
1246 if (STREQU (subCommand, "open")) {
1247 ldap = ldap_open (ldapHost, ldapPort);
1248 } else if (STREQU (subCommand, "init")) {
1249 ldap = ldap_init (ldapHost, ldapPort);
1251 Tcl_AppendStringsToObj (resultObj,
1252 "option was not \"open\" or \"init\"");
1256 if (ldap == (LDAP *)NULL) {
1257 Tcl_SetErrno(errno);
1258 Tcl_AppendStringsToObj (resultObj,
1259 Tcl_PosixError (interp),
1265 ldap->ld_deref = LDAP_DEREF_NEVER; /* Turn off alias dereferencing */
1268 ldaptcl = (LDAPTCL *) malloc(sizeof(LDAPTCL));
1269 ldaptcl->ldap = ldap;
1270 ldaptcl->caching = 0;
1271 ldaptcl->timeout = 0;
1272 ldaptcl->maxmem = 0;
1273 ldaptcl->trapCmdObj = NULL;
1274 ldaptcl->traplist = NULL;
1277 Tcl_CreateObjCommand (interp,
1279 NeoX_LdapTargetObjCmd,
1280 (ClientData) ldaptcl,
1281 NeoX_LdapObjDeleteCmd);
1285 /*-----------------------------------------------------------------------------
1287 * Initialize the LDAP interface.
1288 *-----------------------------------------------------------------------------
1291 Ldaptcl_Init (interp)
1294 Tcl_CreateObjCommand (interp,
1298 (Tcl_CmdDeleteProc*) NULL);
1299 Tcl_PkgProvide(interp, "Ldaptcl", VERSION);