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.
26 * $Id: neoXldap.c,v 1.5 1999/08/03 05:23:03 kunkee Exp $
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 */
114 #define LDAPTCL_INTERRCODES 0x001
116 #include "ldaptclerr.h"
119 LDAP_SetErrorCode(LDAPTCL *ldaptcl, int code, Tcl_Interp *interp)
126 code = ldap_get_lderrno(ldaptcl->ldap);
127 if ((ldaptcl->flags & LDAPTCL_INTERRCODES) || code > LDAPTCL_MAXERR ||
128 ldaptclerrorcode[code] == NULL) {
129 sprintf(shortbuf, "0x%03x", code);
132 errp = ldaptclerrorcode[code];
134 Tcl_SetErrorCode(interp, errp, NULL);
137 /*-----------------------------------------------------------------------------
138 * LDAP_ProcessOneSearchResult --
140 * Process one result return from an LDAP search.
143 * o interp - Tcl interpreter; Errors are returned in result.
144 * o ldap - LDAP structure pointer.
145 * o entry - LDAP message pointer.
146 * o destArrayNameObj - Name of Tcl array in which to store attributes.
147 * o evalCodeObj - Tcl_Obj pointer to code to eval against this result.
149 * o TCL_OK if processing succeeded..
150 * o TCL_ERROR if an error occured, with error message in interp.
151 *-----------------------------------------------------------------------------
154 LDAP_ProcessOneSearchResult (interp, ldap, entry, destArrayNameObj, evalCodeObj)
158 Tcl_Obj *destArrayNameObj;
159 Tcl_Obj *evalCodeObj;
162 Tcl_Obj *attributeNameObj;
163 Tcl_Obj *attributeDataObj;
166 struct berval **bvals;
170 Tcl_UnsetVar (interp, Tcl_GetStringFromObj (destArrayNameObj, NULL), 0);
172 dn = ldap_get_dn(ldap, entry);
174 if (Tcl_SetVar2(interp, /* set dn */
175 Tcl_GetStringFromObj(destArrayNameObj, NULL),
178 TCL_LEAVE_ERR_MSG) == NULL)
182 for (attributeName = ldap_first_attribute (ldap, entry, &ber);
183 attributeName != NULL;
184 attributeName = ldap_next_attribute(ldap, entry, ber)) {
186 bvals = ldap_get_values_len(ldap, entry, attributeName);
189 /* Note here that the U.of.M. ldap will return a null bvals
190 when the last attribute value has been deleted, but still
191 retains the attributeName. Even though this is documented
192 as an error, we ignore it to present a consistent interface
193 with Netscape's server
195 attributeNameObj = Tcl_NewStringObj (attributeName, -1);
196 Tcl_IncrRefCount (attributeNameObj);
197 attributeDataObj = Tcl_NewObj();
198 for (i = 0; bvals[i] != NULL; i++) {
199 Tcl_Obj *singleAttributeValueObj;
201 singleAttributeValueObj = Tcl_NewStringObj (bvals[i]->bv_val, -1);
202 if (Tcl_ListObjAppendElement (interp,
204 singleAttributeValueObj)
211 ldap_value_free_len(bvals);
213 if (Tcl_ObjSetVar2 (interp,
217 TCL_LEAVE_ERR_MSG) == NULL) {
220 Tcl_DecrRefCount (attributeNameObj);
223 return Tcl_EvalObj (interp, evalCodeObj);
226 /*-----------------------------------------------------------------------------
227 * LDAP_PerformSearch --
229 * Perform an LDAP search.
232 * o interp - Tcl interpreter; Errors are returned in result.
233 * o ldap - LDAP structure pointer.
234 * o base - Base DN from which to perform search.
235 * o scope - LDAP search scope, must be one of LDAP_SCOPE_BASE,
236 * LDAP_SCOPE_ONELEVEL, or LDAP_SCOPE_SUBTREE.
237 * o attrs - Pointer to array of char * pointers of desired
238 * attribute names, or NULL for all attributes.
239 * o filtpatt LDAP filter pattern.
240 * o value Value to get sprintf'ed into filter pattern.
241 * o destArrayNameObj - Name of Tcl array in which to store attributes.
242 * o evalCodeObj - Tcl_Obj pointer to code to eval against this result.
244 * o TCL_OK if processing succeeded..
245 * o TCL_ERROR if an error occured, with error message in interp.
246 *-----------------------------------------------------------------------------
249 LDAP_PerformSearch (interp, ldaptcl, base, scope, attrs, filtpatt, value,
250 destArrayNameObj, evalCodeObj, timeout_p, all, sortattr)
258 Tcl_Obj *destArrayNameObj;
259 Tcl_Obj *evalCodeObj;
260 struct timeval *timeout_p;
264 LDAP *ldap = ldaptcl->ldap;
269 int tclResult = TCL_OK;
271 LDAPMessage *resultMessage;
272 LDAPMessage *entryMessage;
278 resultObj = Tcl_GetObjResult (interp);
280 sprintf(filter, filtpatt, value);
283 if ((msgid = ldap_search (ldap, base, scope, filter, attrs, 0)) == -1) {
284 Tcl_AppendStringsToObj (resultObj,
285 "LDAP start search error: ",
286 LDAP_ERR_STRING(ldap),
288 LDAP_SetErrorCode(ldaptcl, -1, interp);
297 resultCode = ldap_result (ldap, msgid, all, timeout_p, &resultMessage);
298 if (resultCode != LDAP_RES_SEARCH_RESULT &&
299 resultCode != LDAP_RES_SEARCH_ENTRY)
303 sortKey = (strcasecmp(sortattr, "dn") == 0) ? NULL : sortattr;
304 ldap_sort_entries(ldap, &resultMessage, sortKey, strcasecmp);
306 entryMessage = ldap_first_entry(ldap, resultMessage);
308 while (entryMessage) {
309 tclResult = LDAP_ProcessOneSearchResult (interp,
314 if (tclResult != TCL_OK) {
315 if (tclResult == TCL_CONTINUE) {
317 } else if (tclResult == TCL_BREAK) {
321 } else if (tclResult == TCL_ERROR) {
323 sprintf(msg, "\n (\"search\" body line %d)",
325 Tcl_AddObjErrorInfo(interp, msg, -1);
333 entryMessage = ldap_next_entry(ldap, entryMessage);
335 if (resultCode == LDAP_RES_SEARCH_RESULT || all)
337 ldap_msgfree(resultMessage);
340 ldap_msgfree(resultMessage);
341 if (resultCode == LDAP_RES_SEARCH_ENTRY)
342 ldap_abandon(ldap, msgid);
345 if (resultCode == -1) {
346 Tcl_AppendStringsToObj (resultObj,
347 "LDAP result search error: ",
348 LDAP_ERR_STRING(ldap),
350 LDAP_SetErrorCode(ldaptcl, -1, interp);
353 if (resultCode == 0) {
354 Tcl_SetErrorCode (interp, "TIMEOUT", (char*) NULL);
355 Tcl_SetStringObj (resultObj, "LDAP timeout retrieving results", -1);
359 if (resultCode == LDAP_RES_SEARCH_RESULT ||
360 (all && resultCode == LDAP_RES_SEARCH_ENTRY))
364 if ((errorCode = ldap_result2error (ldap, resultMessage, 0))
366 Tcl_AppendStringsToObj (resultObj,
367 "LDAP search error: ",
368 ldap_err2string(errorCode),
370 ldap_msgfree(resultMessage);
371 LDAP_SetErrorCode(ldaptcl, errorCode, interp);
377 /*-----------------------------------------------------------------------------
378 * NeoX_LdapTargetObjCmd --
380 * Implements the body of commands created by Neo_LdapObjCmd.
383 * A standard Tcl result.
386 * See the user documentation.
387 *-----------------------------------------------------------------------------
390 NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
391 ClientData clientData;
394 Tcl_Obj *CONST objv[];
398 LDAPTCL *ldaptcl = (LDAPTCL *)clientData;
399 LDAP *ldap = ldaptcl->ldap;
402 int is_add_or_modify = 0;
404 char *m, *s, *errmsg;
408 Tcl_Obj *resultObj = Tcl_GetObjResult (interp);
411 return TclX_WrongArgs (interp,
413 "subcommand [args...]");
415 command = Tcl_GetStringFromObj (objv[0], NULL);
416 subCommand = Tcl_GetStringFromObj (objv[1], NULL);
418 /* object bind authtype name password */
419 if (STREQU (subCommand, "bind")) {
423 char *ldap_authString;
427 return TclX_WrongArgs (interp, objv [0], "bind authtype dn passwd");
429 ldap_authString = Tcl_GetStringFromObj (objv[2], NULL);
431 if (STREQU (ldap_authString, "simple")) {
432 ldap_authInt = LDAP_AUTH_SIMPLE;
435 else if (STREQU (ldap_authString, "kerberos_ldap")) {
436 ldap_authInt = LDAP_AUTH_KRBV41;
437 } else if (STREQU (ldap_authString, "kerberos_dsa")) {
438 ldap_authInt = LDAP_AUTH_KRBV42;
439 } else if (STREQU (ldap_authString, "kerberos_both")) {
440 ldap_authInt = LDAP_AUTH_KRBV4;
444 Tcl_AppendStringsToObj (resultObj,
450 "\" authtype must be one of \"simple\", ",
451 "\"kerberos_ldap\", \"kerberos_dsa\" ",
452 "or \"kerberos_both\"",
454 "\" authtype must be \"simple\", ",
460 binddn = Tcl_GetStringFromObj (objv[3], &stringLength);
461 if (stringLength == 0)
464 passwd = Tcl_GetStringFromObj (objv[4], &stringLength);
465 if (stringLength == 0)
468 /* ldap_bind_s(ldap, dn, pw, method) */
471 #define LDAP_BIND(ldap, dn, pw, method) \
472 ldap_bind_s(ldap, dn, pw, method)
474 #define LDAP_BIND(ldap, dn, pw, method) \
475 ldap_simple_bind_s(ldap, dn, pw)
477 if ((errcode = LDAP_BIND (ldap,
480 ldap_authInt)) != LDAP_SUCCESS) {
482 Tcl_AppendStringsToObj (resultObj,
484 ldap_err2string(errcode),
486 LDAP_SetErrorCode(ldaptcl, errcode, interp);
492 if (STREQU (subCommand, "unbind")) {
494 return TclX_WrongArgs (interp, objv [0], "unbind");
496 return Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], NULL));
499 /* object delete dn */
500 if (STREQU (subCommand, "delete")) {
502 return TclX_WrongArgs (interp, objv [0], "delete dn");
504 dn = Tcl_GetStringFromObj (objv [2], NULL);
505 if ((errcode = ldap_delete_s(ldap, dn)) != LDAP_SUCCESS) {
506 Tcl_AppendStringsToObj (resultObj,
507 "LDAP delete error: ",
508 ldap_err2string(errcode),
510 LDAP_SetErrorCode(ldaptcl, errcode, interp);
516 /* object rename_rdn dn rdn */
517 /* object modify_rdn dn rdn */
518 if (STREQU (subCommand, "rename_rdn") || STREQU (subCommand, "modify_rdn")) {
523 return TclX_WrongArgs (interp,
525 "delete_rdn|modify_rdn dn rdn");
527 dn = Tcl_GetStringFromObj (objv [2], NULL);
528 rdn = Tcl_GetStringFromObj (objv [3], NULL);
530 deleteOldRdn = (*subCommand == 'r');
532 if ((errcode = ldap_modrdn2_s (ldap, dn, rdn, deleteOldRdn)) != LDAP_SUCCESS) {
533 Tcl_AppendStringsToObj (resultObj,
537 ldap_err2string(errcode),
539 LDAP_SetErrorCode(ldaptcl, errcode, interp);
545 /* object add dn attributePairList */
546 /* object add_attributes dn attributePairList */
547 /* object replace_attributes dn attributePairList */
548 /* object delete_attributes dn attributePairList */
550 if (STREQU (subCommand, "add")) {
552 is_add_or_modify = 1;
555 if (STREQU (subCommand, "add_attributes")) {
556 is_add_or_modify = 1;
557 mod_op = LDAP_MOD_ADD;
558 } else if (STREQU (subCommand, "replace_attributes")) {
559 is_add_or_modify = 1;
560 mod_op = LDAP_MOD_REPLACE;
561 } else if (STREQU (subCommand, "delete_attributes")) {
562 is_add_or_modify = 1;
563 mod_op = LDAP_MOD_DELETE;
567 if (is_add_or_modify) {
571 char **valPtrs = NULL;
573 Tcl_Obj **attribObjv;
575 Tcl_Obj **valuesObjv;
580 Tcl_Obj *resultObj = Tcl_GetObjResult (interp);
583 Tcl_AppendStringsToObj (resultObj,
585 Tcl_GetStringFromObj (objv [0], NULL),
588 " dn attributePairList",
593 dn = Tcl_GetStringFromObj (objv [2], NULL);
595 if (Tcl_ListObjGetElements (interp, objv [3], &attribObjc, &attribObjv)
600 if (attribObjc & 1) {
601 Tcl_AppendStringsToObj (resultObj,
602 "attribute list does not contain an ",
603 "even number of key-value elements",
608 nPairs = attribObjc / 2;
610 modArray = (LDAPMod **)ckalloc (sizeof(LDAPMod *) * (nPairs + 1));
611 modArray[nPairs] = (LDAPMod *) NULL;
613 for (i = 0; i < nPairs; i++) {
614 mod = modArray[i] = (LDAPMod *) ckalloc (sizeof(LDAPMod));
615 mod->mod_op = mod_op;
616 mod->mod_type = Tcl_GetStringFromObj (attribObjv [i * 2], NULL);
618 if (Tcl_ListObjGetElements (interp, attribObjv [i * 2 + 1], &valuesObjc, &valuesObjv) == TCL_ERROR) {
619 /* FIX: cleanup memory here */
623 valPtrs = mod->mod_vals.modv_strvals = \
624 (char **)ckalloc (sizeof (char *) * (valuesObjc + 1));
625 valPtrs[valuesObjc] = (char *)NULL;
627 for (j = 0; j < valuesObjc; j++) {
628 valPtrs [j] = Tcl_GetStringFromObj (valuesObjv[j], NULL);
630 /* If it's "delete" and value is an empty string, make
631 * value be NULL to indicate entire attribute is to be
633 if ((*valPtrs [j] == '\0')
634 && (mod->mod_op == LDAP_MOD_DELETE)) {
641 result = ldap_add_s (ldap, dn, modArray);
643 result = ldap_modify_s (ldap, dn, modArray);
644 if (ldaptcl->caching)
645 ldap_uncache_entry (ldap, dn);
648 /* free the modArray elements, then the modArray itself. */
649 for (i = 0; i < nPairs; i++) {
650 ckfree ((char *) modArray[i]->mod_vals.modv_strvals);
651 ckfree ((char *) modArray[i]);
653 ckfree ((char *) modArray);
655 /* FIX: memory cleanup required all over the place here */
656 if (result != LDAP_SUCCESS) {
657 Tcl_AppendStringsToObj (resultObj,
661 ldap_err2string(result),
663 LDAP_SetErrorCode(ldaptcl, result, interp);
669 /* object search controlArray dn pattern */
670 if (STREQU (subCommand, "search")) {
671 char *controlArrayName;
672 Tcl_Obj *controlArrayNameObj;
682 char **attributesArray;
683 char *attributesString;
686 char *filterPatternString;
690 struct timeval timeout, *timeout_p;
698 Tcl_Obj *destArrayNameObj;
699 Tcl_Obj *evalCodeObj;
702 return TclX_WrongArgs (interp,
704 "search controlArray destArray code");
706 controlArrayNameObj = objv [2];
707 controlArrayName = Tcl_GetStringFromObj (controlArrayNameObj, NULL);
709 destArrayNameObj = objv [3];
711 evalCodeObj = objv [4];
713 baseString = Tcl_GetVar2 (interp,
718 if (baseString == (char *)NULL) {
719 Tcl_AppendStringsToObj (resultObj,
720 "required element \"base\" ",
721 "is missing from ldap control array \"",
728 filterPatternString = Tcl_GetVar2 (interp,
732 if (filterPatternString == (char *)NULL) {
733 filterPatternString = "objectclass=*";
736 /* Fetch scope setting from control array.
737 * If it doesn't exist, default to subtree scoping.
739 scopeString = Tcl_GetVar2 (interp, controlArrayName, "scope", 0);
740 if (scopeString == NULL) {
741 scope = LDAP_SCOPE_SUBTREE;
743 if (STREQU(scopeString, "base"))
744 scope = LDAP_SCOPE_BASE;
745 else if (STRNEQU(scopeString, "one", 3))
746 scope = LDAP_SCOPE_ONELEVEL;
747 else if (STRNEQU(scopeString, "sub", 3))
748 scope = LDAP_SCOPE_SUBTREE;
750 Tcl_AppendStringsToObj (resultObj,
751 "\"scope\" element of \"",
753 "\" array is not one of ",
754 "\"base\", \"onelevel\", ",
761 /* Fetch dereference control setting from control array.
762 * If it doesn't exist, default to never dereference. */
763 derefString = Tcl_GetVar2 (interp,
768 if (derefString == (char *)NULL) {
769 deref = LDAP_DEREF_NEVER;
771 if (STREQU(derefString, "never"))
772 deref = LDAP_DEREF_NEVER;
773 else if (STREQU(derefString, "search"))
774 deref = LDAP_DEREF_SEARCHING;
775 else if (STREQU(derefString, "find") == 0)
776 deref = LDAP_DEREF_FINDING;
777 else if (STREQU(derefString, "always"))
778 deref = LDAP_DEREF_ALWAYS;
780 Tcl_AppendStringsToObj (resultObj,
781 "\"deref\" element of \"",
783 "\" array is not one of ",
784 "\"never\", \"search\", \"find\", ",
791 /* Fetch list of attribute names from control array.
792 * If entry doesn't exist, default to NULL (all).
794 attributesString = Tcl_GetVar2 (interp,
798 if (attributesString == (char *)NULL) {
799 attributesArray = NULL;
801 if ((Tcl_SplitList (interp,
804 &attributesArray)) != TCL_OK) {
809 /* Fetch timeout value if there is one
811 timeoutString = Tcl_GetVar2 (interp,
816 if (timeoutString == (char *)NULL) {
820 if (Tcl_GetDouble(interp, timeoutString, &timeoutTime) != TCL_OK)
822 timeout.tv_sec = floor(timeoutTime);
823 timeout.tv_usec = (timeoutTime-timeout.tv_sec) * 1000000;
824 timeout_p = &timeout;
827 paramString = Tcl_GetVar2 (interp, controlArrayName, "cache", 0);
829 if (Tcl_GetInt(interp, paramString, &cacheThis) == TCL_ERROR)
833 paramString = Tcl_GetVar2 (interp, controlArrayName, "all", 0);
835 if (Tcl_GetInt(interp, paramString, &all) == TCL_ERROR)
839 sortattr = Tcl_GetVar2 (interp, controlArrayName, "sort", 0);
842 ldap->ld_deref = deref;
843 ldap->ld_timelimit = 0;
844 ldap->ld_sizelimit = 0;
845 ldap->ld_options = 0;
848 /* Caching control within the search: if the "cache" control array */
849 /* value is set, disable/enable caching accordingly */
851 if (cacheThis >= 0 && ldaptcl->caching != cacheThis) {
853 if (ldaptcl->timeout == 0) {
854 Tcl_SetStringObj(resultObj, "Caching never before enabled, I have no timeout value to use", -1);
857 ldap_enable_cache(ldap, ldaptcl->timeout, ldaptcl->maxmem);
860 ldap_disable_cache(ldap);
862 tclResult = LDAP_PerformSearch (interp,
874 /* Following the search, if we changed the caching behavior, change */
876 if (cacheThis >= 0 && ldaptcl->caching != cacheThis) {
878 ldap_disable_cache(ldap);
880 ldap_enable_cache(ldap, ldaptcl->timeout, ldaptcl->maxmem);
885 #if defined(UMICH_LDAP) || (defined(OPEN_LDAP) && !defined(LDAP_API_VERSION))
886 if (STREQU (subCommand, "cache")) {
891 return TclX_WrongArgs (interp,
893 "cache command [args...]");
895 cacheCommand = Tcl_GetStringFromObj (objv [2], NULL);
897 if (STREQU (cacheCommand, "uncache")) {
901 return TclX_WrongArgs (interp,
905 dn = Tcl_GetStringFromObj (objv [3], NULL);
906 ldap_uncache_entry (ldap, dn);
910 if (STREQU (cacheCommand, "enable")) {
911 long timeout = ldaptcl->timeout;
912 long maxmem = ldaptcl->maxmem;
915 return TclX_WrongArgs (interp,
917 "cache enable ?timeout? ?maxmem?");
920 if (Tcl_GetLongFromObj (interp, objv [3], &timeout) == TCL_ERROR)
924 Tcl_SetStringObj(resultObj,
925 objc > 3 ? "timeouts must be greater than 0" :
926 "no previous timeout to reference", -1);
931 if (Tcl_GetLongFromObj (interp, objv [4], &maxmem) == TCL_ERROR)
934 if (ldap_enable_cache (ldap, timeout, maxmem) == -1) {
935 Tcl_AppendStringsToObj (resultObj,
936 "LDAP cache enable error: ",
937 LDAP_ERR_STRING(ldap),
939 LDAP_SetErrorCode(ldaptcl, -1, interp);
942 ldaptcl->caching = 1;
943 ldaptcl->timeout = timeout;
944 ldaptcl->maxmem = maxmem;
948 if (objc != 3) goto badargs;
950 if (STREQU (cacheCommand, "disable")) {
951 ldap_disable_cache (ldap);
952 ldaptcl->caching = 0;
956 if (STREQU (cacheCommand, "destroy")) {
957 ldap_destroy_cache (ldap);
958 ldaptcl->caching = 0;
962 if (STREQU (cacheCommand, "flush")) {
963 ldap_flush_cache (ldap);
967 if (STREQU (cacheCommand, "no_errors")) {
968 ldap_set_cache_options (ldap, LDAP_CACHE_OPT_CACHENOERRS);
972 if (STREQU (cacheCommand, "all_errors")) {
973 ldap_set_cache_options (ldap, LDAP_CACHE_OPT_CACHEALLERRS);
977 if (STREQU (cacheCommand, "size_errors")) {
978 ldap_set_cache_options (ldap, 0);
981 Tcl_AppendStringsToObj (resultObj,
987 " must be one of \"enable\", ",
989 "\"destroy\", \"flush\", \"uncache\", ",
990 "\"no_errors\", \"size_errors\",",
991 " or \"all_errors\"",
997 if (STREQU (subCommand, "debug")) {
999 Tcl_AppendStringsToObj(resultObj, "Wrong # of arguments",
1003 return Tcl_GetIntFromObj(interp, objv[2], &ldap_debug);
1007 /* FIX: this needs to enumerate all the possibilities */
1008 Tcl_AppendStringsToObj (resultObj,
1011 "\" must be one of \"add\", ",
1012 "\"add_attributes\", ",
1013 "\"bind\", \"cache\", \"delete\", ",
1014 "\"delete_attributes\", \"modify\", ",
1015 "\"modify_rdn\", \"rename_rdn\", ",
1016 "\"replace_attributes\", ",
1017 "\"search\" or \"unbind\".",
1023 * Delete and LDAP command object
1027 NeoX_LdapObjDeleteCmd(clientData)
1028 ClientData clientData;
1030 LDAPTCL *ldaptcl = (LDAPTCL *)clientData;
1031 LDAP *ldap = ldaptcl->ldap;
1034 ckfree((char*) ldaptcl);
1037 /*-----------------------------------------------------------------------------
1038 * NeoX_LdapObjCmd --
1040 * Implements the `ldap' command:
1041 * ldap open newObjName host [port]
1042 * ldap init newObjName host [port]
1045 * A standard Tcl result.
1048 * See the user documentation.
1049 *-----------------------------------------------------------------------------
1052 NeoX_LdapObjCmd (clientData, interp, objc, objv)
1053 ClientData clientData;
1056 Tcl_Obj *CONST objv[];
1066 Tcl_Obj *resultObj = Tcl_GetObjResult (interp);
1068 if (objc < 3 || objc > 5)
1069 return TclX_WrongArgs (interp, objv [0],
1070 "(open|init) new_command host [port]|explode dn");
1072 subCommand = Tcl_GetStringFromObj (objv[1], NULL);
1074 if (STREQU(subCommand, "explode")) {
1078 char **exploded, **p;
1080 param = Tcl_GetStringFromObj (objv[2], NULL);
1081 if (param[0] == '-') {
1082 if (STREQU(param, "-nonames")) {
1084 } else if (STREQU(param, "-list")) {
1087 return TclX_WrongArgs (interp, objv [0], "explode ?-nonames|-list? dn");
1090 if (nonames || list)
1091 param = Tcl_GetStringFromObj (objv[3], NULL);
1092 exploded = ldap_explode_dn(param, nonames);
1093 for (p = exploded; *p; p++) {
1095 char *q = strchr(*p, '=');
1097 Tcl_SetObjLength(resultObj, 0);
1098 Tcl_AppendStringsToObj(resultObj, "rdn ", *p,
1099 " missing '='", NULL);
1100 ldap_value_free(exploded);
1104 if (Tcl_ListObjAppendElement(interp, resultObj,
1105 Tcl_NewStringObj(*p, -1)) != TCL_OK ||
1106 Tcl_ListObjAppendElement(interp, resultObj,
1107 Tcl_NewStringObj(q+1, -1)) != TCL_OK) {
1108 ldap_value_free(exploded);
1112 if (Tcl_ListObjAppendElement(interp, resultObj,
1113 Tcl_NewStringObj(*p, -1))) {
1114 ldap_value_free(exploded);
1119 ldap_value_free(exploded);
1124 if (STREQU(subCommand, "friendly")) {
1125 char *friendly = ldap_dn2ufn(Tcl_GetStringFromObj(objv[2], NULL));
1126 Tcl_SetStringObj(resultObj, friendly, -1);
1132 newCommand = Tcl_GetStringFromObj (objv[2], NULL);
1133 ldapHost = Tcl_GetStringFromObj (objv[3], NULL);
1136 if (Tcl_GetIntFromObj (interp, objv [4], &ldapPort) == TCL_ERROR) {
1137 Tcl_AppendStringsToObj (resultObj,
1138 "LDAP port number is non-numeric",
1144 if (STREQU (subCommand, "open")) {
1145 ldap = ldap_open (ldapHost, ldapPort);
1146 } else if (STREQU (subCommand, "init")) {
1147 ldap = ldap_init (ldapHost, ldapPort);
1149 Tcl_AppendStringsToObj (resultObj,
1150 "option was not \"open\" or \"init\"");
1154 if (ldap == (LDAP *)NULL) {
1155 Tcl_SetErrno(errno);
1156 Tcl_AppendStringsToObj (resultObj,
1157 Tcl_PosixError (interp),
1163 ldap->ld_deref = LDAP_DEREF_NEVER; /* Turn off alias dereferencing */
1166 ldaptcl = (LDAPTCL *) ckalloc(sizeof(LDAPTCL));
1167 ldaptcl->ldap = ldap;
1168 ldaptcl->caching = 0;
1169 ldaptcl->timeout = 0;
1170 ldaptcl->maxmem = 0;
1173 Tcl_CreateObjCommand (interp,
1175 NeoX_LdapTargetObjCmd,
1176 (ClientData) ldaptcl,
1177 NeoX_LdapObjDeleteCmd);
1181 /*-----------------------------------------------------------------------------
1183 * Initialize the LDAP interface.
1184 *-----------------------------------------------------------------------------
1187 Ldaptcl_Init (interp)
1190 Tcl_CreateObjCommand (interp,
1194 (Tcl_CmdDeleteProc*) NULL);
1195 Tcl_PkgProvide(interp, "Ldaptcl", VERSION);