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_attributefree(p) ldap_memfree(p)
80 #define ldap_memfree(p) free(p)
81 #ifdef LDAP_OPT_ERROR_NUMBER
82 #define ldap_get_lderrno(ld) (ldap_get_option(ld, LDAP_OPT_ERROR_NUMBER, &lderrno), lderrno)
84 #define ldap_get_lderrno(ld) (ld->ld_errno)
86 #define LDAP_ERR_STRING(ld) \
87 ldap_err2string(ldap_get_lderrno(ld))
88 #elif defined( LDAP_OPT_SIZELIMIT )
90 ** Netscape SDK w/ ldap_set_option, ldap_get_option
92 #define ldap_attributefree(p) ldap_memfree(p)
93 #define LDAP_ERR_STRING(ld) \
94 ldap_err2string(ldap_get_lderrno(ldap))
96 /* U-Mich/OpenLDAP 1.x API */
97 /* RFC-1823 w/ changes */
99 #define ldap_memfree(p) free(p)
100 #define ldap_ber_free(p, n) ber_free(p, n)
101 #define ldap_value_free_len(bvals) ber_bvecfree(bvals)
102 #define ldap_attributefree(p)
103 #define ldap_get_lderrno(ld) (ld->ld_errno)
104 #define LDAP_ERR_STRING(ld) \
105 ldap_err2string(ld->ld_errno)
108 typedef struct ldaptclobj {
110 int caching; /* flag 1/0 if caching is enabled */
111 long timeout; /* timeout from last cache enable */
112 long maxmem; /* maxmem from last cache enable */
117 #define LDAPTCL_INTERRCODES 0x001
119 #include "ldaptclerr.h"
122 LDAP_SetErrorCode(LDAPTCL *ldaptcl, int code, Tcl_Interp *interp)
129 code = ldap_get_lderrno(ldaptcl->ldap);
130 if ((ldaptcl->flags & LDAPTCL_INTERRCODES) || code > LDAPTCL_MAXERR ||
131 ldaptclerrorcode[code] == NULL) {
132 sprintf(shortbuf, "0x%03x", code);
135 errp = ldaptclerrorcode[code];
137 Tcl_SetErrorCode(interp, errp, NULL);
140 /*-----------------------------------------------------------------------------
141 * LDAP_ProcessOneSearchResult --
143 * Process one result return from an LDAP search.
146 * o interp - Tcl interpreter; Errors are returned in result.
147 * o ldap - LDAP structure pointer.
148 * o entry - LDAP message pointer.
149 * o destArrayNameObj - Name of Tcl array in which to store attributes.
150 * o evalCodeObj - Tcl_Obj pointer to code to eval against this result.
152 * o TCL_OK if processing succeeded..
153 * o TCL_ERROR if an error occured, with error message in interp.
154 *-----------------------------------------------------------------------------
157 LDAP_ProcessOneSearchResult (interp, ldap, entry, destArrayNameObj, evalCodeObj)
161 Tcl_Obj *destArrayNameObj;
162 Tcl_Obj *evalCodeObj;
165 Tcl_Obj *attributeNameObj;
166 Tcl_Obj *attributeDataObj;
169 struct berval **bvals;
173 Tcl_UnsetVar (interp, Tcl_GetStringFromObj (destArrayNameObj, NULL), 0);
175 dn = ldap_get_dn(ldap, entry);
177 if (Tcl_SetVar2(interp, /* set dn */
178 Tcl_GetStringFromObj(destArrayNameObj, NULL),
181 TCL_LEAVE_ERR_MSG) == NULL)
185 for (attributeName = ldap_first_attribute (ldap, entry, &ber);
186 attributeName != NULL;
187 attributeName = ldap_next_attribute(ldap, entry, ber)) {
189 bvals = ldap_get_values_len(ldap, entry, attributeName);
192 /* Note here that the U.of.M. ldap will return a null bvals
193 when the last attribute value has been deleted, but still
194 retains the attributeName. Even though this is documented
195 as an error, we ignore it to present a consistent interface
196 with Netscape's server
198 attributeNameObj = Tcl_NewStringObj (attributeName, -1);
199 Tcl_IncrRefCount (attributeNameObj);
200 attributeDataObj = Tcl_NewObj();
201 for (i = 0; bvals[i] != NULL; i++) {
202 Tcl_Obj *singleAttributeValueObj;
204 singleAttributeValueObj = Tcl_NewStringObj (bvals[i]->bv_val, -1);
205 if (Tcl_ListObjAppendElement (interp,
207 singleAttributeValueObj)
213 ldap_value_free_len(bvals);
215 if (Tcl_ObjSetVar2 (interp,
219 TCL_LEAVE_ERR_MSG) == NULL) {
222 Tcl_DecrRefCount (attributeNameObj);
224 ldap_attributefree(attributeName);
226 return Tcl_EvalObj (interp, evalCodeObj);
229 /*-----------------------------------------------------------------------------
230 * LDAP_PerformSearch --
232 * Perform an LDAP search.
235 * o interp - Tcl interpreter; Errors are returned in result.
236 * o ldap - LDAP structure pointer.
237 * o base - Base DN from which to perform search.
238 * o scope - LDAP search scope, must be one of LDAP_SCOPE_BASE,
239 * LDAP_SCOPE_ONELEVEL, or LDAP_SCOPE_SUBTREE.
240 * o attrs - Pointer to array of char * pointers of desired
241 * attribute names, or NULL for all attributes.
242 * o filtpatt LDAP filter pattern.
243 * o value Value to get sprintf'ed into filter pattern.
244 * o destArrayNameObj - Name of Tcl array in which to store attributes.
245 * o evalCodeObj - Tcl_Obj pointer to code to eval against this result.
247 * o TCL_OK if processing succeeded..
248 * o TCL_ERROR if an error occured, with error message in interp.
249 *-----------------------------------------------------------------------------
252 LDAP_PerformSearch (interp, ldaptcl, base, scope, attrs, filtpatt, value,
253 destArrayNameObj, evalCodeObj, timeout_p, all, sortattr)
261 Tcl_Obj *destArrayNameObj;
262 Tcl_Obj *evalCodeObj;
263 struct timeval *timeout_p;
267 LDAP *ldap = ldaptcl->ldap;
272 int tclResult = TCL_OK;
274 LDAPMessage *resultMessage;
275 LDAPMessage *entryMessage;
281 resultObj = Tcl_GetObjResult (interp);
283 sprintf(filter, filtpatt, value);
286 if ((msgid = ldap_search (ldap, base, scope, filter, attrs, 0)) == -1) {
287 Tcl_AppendStringsToObj (resultObj,
288 "LDAP start search error: ",
289 LDAP_ERR_STRING(ldap),
291 LDAP_SetErrorCode(ldaptcl, -1, interp);
300 resultCode = ldap_result (ldap, msgid, all, timeout_p, &resultMessage);
301 if (resultCode != LDAP_RES_SEARCH_RESULT &&
302 resultCode != LDAP_RES_SEARCH_ENTRY)
306 sortKey = (strcasecmp(sortattr, "dn") == 0) ? NULL : sortattr;
307 ldap_sort_entries(ldap, &resultMessage, sortKey, strcasecmp);
309 entryMessage = ldap_first_entry(ldap, resultMessage);
311 while (entryMessage) {
312 tclResult = LDAP_ProcessOneSearchResult (interp,
317 if (tclResult != TCL_OK) {
318 if (tclResult == TCL_CONTINUE) {
320 } else if (tclResult == TCL_BREAK) {
324 } else if (tclResult == TCL_ERROR) {
326 sprintf(msg, "\n (\"search\" body line %d)",
328 Tcl_AddObjErrorInfo(interp, msg, -1);
336 entryMessage = ldap_next_entry(ldap, entryMessage);
338 if (resultCode == LDAP_RES_SEARCH_RESULT || all)
340 ldap_msgfree(resultMessage);
343 ldap_msgfree(resultMessage);
344 if (resultCode == LDAP_RES_SEARCH_ENTRY)
345 ldap_abandon(ldap, msgid);
348 if (resultCode == -1) {
349 Tcl_AppendStringsToObj (resultObj,
350 "LDAP result search error: ",
351 LDAP_ERR_STRING(ldap),
353 LDAP_SetErrorCode(ldaptcl, -1, interp);
356 if (resultCode == 0) {
357 Tcl_SetErrorCode (interp, "TIMEOUT", (char*) NULL);
358 Tcl_SetStringObj (resultObj, "LDAP timeout retrieving results", -1);
362 if (resultCode == LDAP_RES_SEARCH_RESULT ||
363 (all && resultCode == LDAP_RES_SEARCH_ENTRY))
367 if ((errorCode = ldap_result2error (ldap, resultMessage, 0))
369 Tcl_AppendStringsToObj (resultObj,
370 "LDAP search error: ",
371 ldap_err2string(errorCode),
373 ldap_msgfree(resultMessage);
374 LDAP_SetErrorCode(ldaptcl, errorCode, interp);
380 /*-----------------------------------------------------------------------------
381 * NeoX_LdapTargetObjCmd --
383 * Implements the body of commands created by Neo_LdapObjCmd.
386 * A standard Tcl result.
389 * See the user documentation.
390 *-----------------------------------------------------------------------------
393 NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
394 ClientData clientData;
397 Tcl_Obj *CONST objv[];
401 LDAPTCL *ldaptcl = (LDAPTCL *)clientData;
402 LDAP *ldap = ldaptcl->ldap;
405 int is_add_or_modify = 0;
407 char *m, *s, *errmsg;
411 Tcl_Obj *resultObj = Tcl_GetObjResult (interp);
414 return TclX_WrongArgs (interp,
416 "subcommand [args...]");
418 command = Tcl_GetStringFromObj (objv[0], NULL);
419 subCommand = Tcl_GetStringFromObj (objv[1], NULL);
421 /* object bind authtype name password */
422 if (STREQU (subCommand, "bind")) {
426 char *ldap_authString;
430 return TclX_WrongArgs (interp, objv [0], "bind authtype dn passwd");
432 ldap_authString = Tcl_GetStringFromObj (objv[2], NULL);
434 if (STREQU (ldap_authString, "simple")) {
435 ldap_authInt = LDAP_AUTH_SIMPLE;
438 else if (STREQU (ldap_authString, "kerberos_ldap")) {
439 ldap_authInt = LDAP_AUTH_KRBV41;
440 } else if (STREQU (ldap_authString, "kerberos_dsa")) {
441 ldap_authInt = LDAP_AUTH_KRBV42;
442 } else if (STREQU (ldap_authString, "kerberos_both")) {
443 ldap_authInt = LDAP_AUTH_KRBV4;
447 Tcl_AppendStringsToObj (resultObj,
453 "\" authtype must be one of \"simple\", ",
454 "\"kerberos_ldap\", \"kerberos_dsa\" ",
455 "or \"kerberos_both\"",
457 "\" authtype must be \"simple\", ",
463 binddn = Tcl_GetStringFromObj (objv[3], &stringLength);
464 if (stringLength == 0)
467 passwd = Tcl_GetStringFromObj (objv[4], &stringLength);
468 if (stringLength == 0)
471 /* ldap_bind_s(ldap, dn, pw, method) */
474 #define LDAP_BIND(ldap, dn, pw, method) \
475 ldap_bind_s(ldap, dn, pw, method)
477 #define LDAP_BIND(ldap, dn, pw, method) \
478 ldap_simple_bind_s(ldap, dn, pw)
480 if ((errcode = LDAP_BIND (ldap,
483 ldap_authInt)) != LDAP_SUCCESS) {
485 Tcl_AppendStringsToObj (resultObj,
487 ldap_err2string(errcode),
489 LDAP_SetErrorCode(ldaptcl, errcode, interp);
495 if (STREQU (subCommand, "unbind")) {
497 return TclX_WrongArgs (interp, objv [0], "unbind");
499 return Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], NULL));
502 /* object delete dn */
503 if (STREQU (subCommand, "delete")) {
505 return TclX_WrongArgs (interp, objv [0], "delete dn");
507 dn = Tcl_GetStringFromObj (objv [2], NULL);
508 if ((errcode = ldap_delete_s(ldap, dn)) != LDAP_SUCCESS) {
509 Tcl_AppendStringsToObj (resultObj,
510 "LDAP delete error: ",
511 ldap_err2string(errcode),
513 LDAP_SetErrorCode(ldaptcl, errcode, interp);
519 /* object rename_rdn dn rdn */
520 /* object modify_rdn dn rdn */
521 if (STREQU (subCommand, "rename_rdn") || STREQU (subCommand, "modify_rdn")) {
526 return TclX_WrongArgs (interp,
528 "delete_rdn|modify_rdn dn rdn");
530 dn = Tcl_GetStringFromObj (objv [2], NULL);
531 rdn = Tcl_GetStringFromObj (objv [3], NULL);
533 deleteOldRdn = (*subCommand == 'r');
535 if ((errcode = ldap_modrdn2_s (ldap, dn, rdn, deleteOldRdn)) != LDAP_SUCCESS) {
536 Tcl_AppendStringsToObj (resultObj,
540 ldap_err2string(errcode),
542 LDAP_SetErrorCode(ldaptcl, errcode, interp);
548 /* object add dn attributePairList */
549 /* object add_attributes dn attributePairList */
550 /* object replace_attributes dn attributePairList */
551 /* object delete_attributes dn attributePairList */
553 if (STREQU (subCommand, "add")) {
555 is_add_or_modify = 1;
558 if (STREQU (subCommand, "add_attributes")) {
559 is_add_or_modify = 1;
560 mod_op = LDAP_MOD_ADD;
561 } else if (STREQU (subCommand, "replace_attributes")) {
562 is_add_or_modify = 1;
563 mod_op = LDAP_MOD_REPLACE;
564 } else if (STREQU (subCommand, "delete_attributes")) {
565 is_add_or_modify = 1;
566 mod_op = LDAP_MOD_DELETE;
570 if (is_add_or_modify) {
574 char **valPtrs = NULL;
576 Tcl_Obj **attribObjv;
578 Tcl_Obj **valuesObjv;
583 Tcl_Obj *resultObj = Tcl_GetObjResult (interp);
586 Tcl_AppendStringsToObj (resultObj,
588 Tcl_GetStringFromObj (objv [0], NULL),
591 " dn attributePairList",
596 dn = Tcl_GetStringFromObj (objv [2], NULL);
598 if (Tcl_ListObjGetElements (interp, objv [3], &attribObjc, &attribObjv)
603 if (attribObjc & 1) {
604 Tcl_AppendStringsToObj (resultObj,
605 "attribute list does not contain an ",
606 "even number of key-value elements",
611 nPairs = attribObjc / 2;
613 modArray = (LDAPMod **)ckalloc (sizeof(LDAPMod *) * (nPairs + 1));
614 modArray[nPairs] = (LDAPMod *) NULL;
616 for (i = 0; i < nPairs; i++) {
617 mod = modArray[i] = (LDAPMod *) ckalloc (sizeof(LDAPMod));
618 mod->mod_op = mod_op;
619 mod->mod_type = Tcl_GetStringFromObj (attribObjv [i * 2], NULL);
621 if (Tcl_ListObjGetElements (interp, attribObjv [i * 2 + 1], &valuesObjc, &valuesObjv) == TCL_ERROR) {
622 /* FIX: cleanup memory here */
626 valPtrs = mod->mod_vals.modv_strvals = \
627 (char **)ckalloc (sizeof (char *) * (valuesObjc + 1));
628 valPtrs[valuesObjc] = (char *)NULL;
630 for (j = 0; j < valuesObjc; j++) {
631 valPtrs [j] = Tcl_GetStringFromObj (valuesObjv[j], NULL);
633 /* If it's "delete" and value is an empty string, make
634 * value be NULL to indicate entire attribute is to be
636 if ((*valPtrs [j] == '\0')
637 && (mod->mod_op == LDAP_MOD_DELETE)) {
644 result = ldap_add_s (ldap, dn, modArray);
646 result = ldap_modify_s (ldap, dn, modArray);
647 if (ldaptcl->caching)
648 ldap_uncache_entry (ldap, dn);
651 /* free the modArray elements, then the modArray itself. */
652 for (i = 0; i < nPairs; i++) {
653 ckfree ((char *) modArray[i]->mod_vals.modv_strvals);
654 ckfree ((char *) modArray[i]);
656 ckfree ((char *) modArray);
658 /* FIX: memory cleanup required all over the place here */
659 if (result != LDAP_SUCCESS) {
660 Tcl_AppendStringsToObj (resultObj,
664 ldap_err2string(result),
666 LDAP_SetErrorCode(ldaptcl, result, interp);
672 /* object search controlArray dn pattern */
673 if (STREQU (subCommand, "search")) {
674 char *controlArrayName;
675 Tcl_Obj *controlArrayNameObj;
685 char **attributesArray;
686 char *attributesString;
689 char *filterPatternString;
693 struct timeval timeout, *timeout_p;
701 Tcl_Obj *destArrayNameObj;
702 Tcl_Obj *evalCodeObj;
705 return TclX_WrongArgs (interp,
707 "search controlArray destArray code");
709 controlArrayNameObj = objv [2];
710 controlArrayName = Tcl_GetStringFromObj (controlArrayNameObj, NULL);
712 destArrayNameObj = objv [3];
714 evalCodeObj = objv [4];
716 baseString = Tcl_GetVar2 (interp,
721 if (baseString == (char *)NULL) {
722 Tcl_AppendStringsToObj (resultObj,
723 "required element \"base\" ",
724 "is missing from ldap control array \"",
731 filterPatternString = Tcl_GetVar2 (interp,
735 if (filterPatternString == (char *)NULL) {
736 filterPatternString = "objectclass=*";
739 /* Fetch scope setting from control array.
740 * If it doesn't exist, default to subtree scoping.
742 scopeString = Tcl_GetVar2 (interp, controlArrayName, "scope", 0);
743 if (scopeString == NULL) {
744 scope = LDAP_SCOPE_SUBTREE;
746 if (STREQU(scopeString, "base"))
747 scope = LDAP_SCOPE_BASE;
748 else if (STRNEQU(scopeString, "one", 3))
749 scope = LDAP_SCOPE_ONELEVEL;
750 else if (STRNEQU(scopeString, "sub", 3))
751 scope = LDAP_SCOPE_SUBTREE;
753 Tcl_AppendStringsToObj (resultObj,
754 "\"scope\" element of \"",
756 "\" array is not one of ",
757 "\"base\", \"onelevel\", ",
764 /* Fetch dereference control setting from control array.
765 * If it doesn't exist, default to never dereference. */
766 derefString = Tcl_GetVar2 (interp,
771 if (derefString == (char *)NULL) {
772 deref = LDAP_DEREF_NEVER;
774 if (STREQU(derefString, "never"))
775 deref = LDAP_DEREF_NEVER;
776 else if (STREQU(derefString, "search"))
777 deref = LDAP_DEREF_SEARCHING;
778 else if (STREQU(derefString, "find") == 0)
779 deref = LDAP_DEREF_FINDING;
780 else if (STREQU(derefString, "always"))
781 deref = LDAP_DEREF_ALWAYS;
783 Tcl_AppendStringsToObj (resultObj,
784 "\"deref\" element of \"",
786 "\" array is not one of ",
787 "\"never\", \"search\", \"find\", ",
794 /* Fetch list of attribute names from control array.
795 * If entry doesn't exist, default to NULL (all).
797 attributesString = Tcl_GetVar2 (interp,
801 if (attributesString == (char *)NULL) {
802 attributesArray = NULL;
804 if ((Tcl_SplitList (interp,
807 &attributesArray)) != TCL_OK) {
812 /* Fetch timeout value if there is one
814 timeoutString = Tcl_GetVar2 (interp,
819 if (timeoutString == (char *)NULL) {
823 if (Tcl_GetDouble(interp, timeoutString, &timeoutTime) != TCL_OK)
825 timeout.tv_sec = floor(timeoutTime);
826 timeout.tv_usec = (timeoutTime-timeout.tv_sec) * 1000000;
827 timeout_p = &timeout;
830 paramString = Tcl_GetVar2 (interp, controlArrayName, "cache", 0);
832 if (Tcl_GetInt(interp, paramString, &cacheThis) == TCL_ERROR)
836 paramString = Tcl_GetVar2 (interp, controlArrayName, "all", 0);
838 if (Tcl_GetInt(interp, paramString, &all) == TCL_ERROR)
842 sortattr = Tcl_GetVar2 (interp, controlArrayName, "sort", 0);
845 ldap->ld_deref = deref;
846 ldap->ld_timelimit = 0;
847 ldap->ld_sizelimit = 0;
848 ldap->ld_options = 0;
851 /* Caching control within the search: if the "cache" control array */
852 /* value is set, disable/enable caching accordingly */
854 if (cacheThis >= 0 && ldaptcl->caching != cacheThis) {
856 if (ldaptcl->timeout == 0) {
857 Tcl_SetStringObj(resultObj, "Caching never before enabled, I have no timeout value to use", -1);
860 ldap_enable_cache(ldap, ldaptcl->timeout, ldaptcl->maxmem);
863 ldap_disable_cache(ldap);
865 tclResult = LDAP_PerformSearch (interp,
877 /* Following the search, if we changed the caching behavior, change */
879 if (cacheThis >= 0 && ldaptcl->caching != cacheThis) {
881 ldap_disable_cache(ldap);
883 ldap_enable_cache(ldap, ldaptcl->timeout, ldaptcl->maxmem);
888 #if defined(UMICH_LDAP) || (defined(OPEN_LDAP) && !defined(LDAP_API_VERSION))
889 if (STREQU (subCommand, "cache")) {
894 return TclX_WrongArgs (interp,
896 "cache command [args...]");
898 cacheCommand = Tcl_GetStringFromObj (objv [2], NULL);
900 if (STREQU (cacheCommand, "uncache")) {
904 return TclX_WrongArgs (interp,
908 dn = Tcl_GetStringFromObj (objv [3], NULL);
909 ldap_uncache_entry (ldap, dn);
913 if (STREQU (cacheCommand, "enable")) {
914 long timeout = ldaptcl->timeout;
915 long maxmem = ldaptcl->maxmem;
918 return TclX_WrongArgs (interp,
920 "cache enable ?timeout? ?maxmem?");
923 if (Tcl_GetLongFromObj (interp, objv [3], &timeout) == TCL_ERROR)
927 Tcl_SetStringObj(resultObj,
928 objc > 3 ? "timeouts must be greater than 0" :
929 "no previous timeout to reference", -1);
934 if (Tcl_GetLongFromObj (interp, objv [4], &maxmem) == TCL_ERROR)
937 if (ldap_enable_cache (ldap, timeout, maxmem) == -1) {
938 Tcl_AppendStringsToObj (resultObj,
939 "LDAP cache enable error: ",
940 LDAP_ERR_STRING(ldap),
942 LDAP_SetErrorCode(ldaptcl, -1, interp);
945 ldaptcl->caching = 1;
946 ldaptcl->timeout = timeout;
947 ldaptcl->maxmem = maxmem;
951 if (objc != 3) goto badargs;
953 if (STREQU (cacheCommand, "disable")) {
954 ldap_disable_cache (ldap);
955 ldaptcl->caching = 0;
959 if (STREQU (cacheCommand, "destroy")) {
960 ldap_destroy_cache (ldap);
961 ldaptcl->caching = 0;
965 if (STREQU (cacheCommand, "flush")) {
966 ldap_flush_cache (ldap);
970 if (STREQU (cacheCommand, "no_errors")) {
971 ldap_set_cache_options (ldap, LDAP_CACHE_OPT_CACHENOERRS);
975 if (STREQU (cacheCommand, "all_errors")) {
976 ldap_set_cache_options (ldap, LDAP_CACHE_OPT_CACHEALLERRS);
980 if (STREQU (cacheCommand, "size_errors")) {
981 ldap_set_cache_options (ldap, 0);
984 Tcl_AppendStringsToObj (resultObj,
990 " must be one of \"enable\", ",
992 "\"destroy\", \"flush\", \"uncache\", ",
993 "\"no_errors\", \"size_errors\",",
994 " or \"all_errors\"",
1000 if (STREQU (subCommand, "debug")) {
1002 Tcl_AppendStringsToObj(resultObj, "Wrong # of arguments",
1006 return Tcl_GetIntFromObj(interp, objv[2], &ldap_debug);
1010 /* FIX: this needs to enumerate all the possibilities */
1011 Tcl_AppendStringsToObj (resultObj,
1014 "\" must be one of \"add\", ",
1015 "\"add_attributes\", ",
1016 "\"bind\", \"cache\", \"delete\", ",
1017 "\"delete_attributes\", \"modify\", ",
1018 "\"modify_rdn\", \"rename_rdn\", ",
1019 "\"replace_attributes\", ",
1020 "\"search\" or \"unbind\".",
1026 * Delete and LDAP command object
1030 NeoX_LdapObjDeleteCmd(clientData)
1031 ClientData clientData;
1033 LDAPTCL *ldaptcl = (LDAPTCL *)clientData;
1034 LDAP *ldap = ldaptcl->ldap;
1037 ckfree((char*) ldaptcl);
1040 /*-----------------------------------------------------------------------------
1041 * NeoX_LdapObjCmd --
1043 * Implements the `ldap' command:
1044 * ldap open newObjName host [port]
1045 * ldap init newObjName host [port]
1048 * A standard Tcl result.
1051 * See the user documentation.
1052 *-----------------------------------------------------------------------------
1055 NeoX_LdapObjCmd (clientData, interp, objc, objv)
1056 ClientData clientData;
1059 Tcl_Obj *CONST objv[];
1069 Tcl_Obj *resultObj = Tcl_GetObjResult (interp);
1071 if (objc < 3 || objc > 5)
1072 return TclX_WrongArgs (interp, objv [0],
1073 "(open|init) new_command host [port]|explode dn");
1075 subCommand = Tcl_GetStringFromObj (objv[1], NULL);
1077 if (STREQU(subCommand, "explode")) {
1081 char **exploded, **p;
1083 param = Tcl_GetStringFromObj (objv[2], NULL);
1084 if (param[0] == '-') {
1085 if (STREQU(param, "-nonames")) {
1087 } else if (STREQU(param, "-list")) {
1090 return TclX_WrongArgs (interp, objv [0], "explode ?-nonames|-list? dn");
1093 if (nonames || list)
1094 param = Tcl_GetStringFromObj (objv[3], NULL);
1095 exploded = ldap_explode_dn(param, nonames);
1096 for (p = exploded; *p; p++) {
1098 char *q = strchr(*p, '=');
1100 Tcl_SetObjLength(resultObj, 0);
1101 Tcl_AppendStringsToObj(resultObj, "rdn ", *p,
1102 " missing '='", NULL);
1103 ldap_value_free(exploded);
1107 if (Tcl_ListObjAppendElement(interp, resultObj,
1108 Tcl_NewStringObj(*p, -1)) != TCL_OK ||
1109 Tcl_ListObjAppendElement(interp, resultObj,
1110 Tcl_NewStringObj(q+1, -1)) != TCL_OK) {
1111 ldap_value_free(exploded);
1115 if (Tcl_ListObjAppendElement(interp, resultObj,
1116 Tcl_NewStringObj(*p, -1))) {
1117 ldap_value_free(exploded);
1122 ldap_value_free(exploded);
1127 if (STREQU(subCommand, "friendly")) {
1128 char *friendly = ldap_dn2ufn(Tcl_GetStringFromObj(objv[2], NULL));
1129 Tcl_SetStringObj(resultObj, friendly, -1);
1135 newCommand = Tcl_GetStringFromObj (objv[2], NULL);
1136 ldapHost = Tcl_GetStringFromObj (objv[3], NULL);
1139 if (Tcl_GetIntFromObj (interp, objv [4], &ldapPort) == TCL_ERROR) {
1140 Tcl_AppendStringsToObj (resultObj,
1141 "LDAP port number is non-numeric",
1147 if (STREQU (subCommand, "open")) {
1148 ldap = ldap_open (ldapHost, ldapPort);
1149 } else if (STREQU (subCommand, "init")) {
1150 ldap = ldap_init (ldapHost, ldapPort);
1152 Tcl_AppendStringsToObj (resultObj,
1153 "option was not \"open\" or \"init\"");
1157 if (ldap == (LDAP *)NULL) {
1158 Tcl_SetErrno(errno);
1159 Tcl_AppendStringsToObj (resultObj,
1160 Tcl_PosixError (interp),
1166 ldap->ld_deref = LDAP_DEREF_NEVER; /* Turn off alias dereferencing */
1169 ldaptcl = (LDAPTCL *) ckalloc(sizeof(LDAPTCL));
1170 ldaptcl->ldap = ldap;
1171 ldaptcl->caching = 0;
1172 ldaptcl->timeout = 0;
1173 ldaptcl->maxmem = 0;
1176 Tcl_CreateObjCommand (interp,
1178 NeoX_LdapTargetObjCmd,
1179 (ClientData) ldaptcl,
1180 NeoX_LdapObjDeleteCmd);
1184 /*-----------------------------------------------------------------------------
1186 * Initialize the LDAP interface.
1187 *-----------------------------------------------------------------------------
1190 Ldaptcl_Init (interp)
1193 Tcl_CreateObjCommand (interp,
1197 (Tcl_CmdDeleteProc*) NULL);
1198 Tcl_PkgProvide(interp, "Ldaptcl", VERSION);