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.4 1999/07/27 05:29:27 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 {
113 #define LDAPTCL_INTERRCODES 0x001
115 #include "ldaptclerr.h"
118 LDAP_SetErrorCode(LDAPTCL *ldaptcl, int code, Tcl_Interp *interp)
125 code = ldap_get_lderrno(ldaptcl->ldap);
126 if ((ldaptcl->flags & LDAPTCL_INTERRCODES) || code > LDAPTCL_MAXERR ||
127 ldaptclerrorcode[code] == NULL) {
128 sprintf(shortbuf, "0x%03x", code);
131 errp = ldaptclerrorcode[code];
133 Tcl_SetErrorCode(interp, errp, NULL);
136 /*-----------------------------------------------------------------------------
137 * LDAP_ProcessOneSearchResult --
139 * Process one result return from an LDAP search.
142 * o interp - Tcl interpreter; Errors are returned in result.
143 * o ldap - LDAP structure pointer.
144 * o entry - LDAP message pointer.
145 * o destArrayNameObj - Name of Tcl array in which to store attributes.
146 * o evalCodeObj - Tcl_Obj pointer to code to eval against this result.
148 * o TCL_OK if processing succeeded..
149 * o TCL_ERROR if an error occured, with error message in interp.
150 *-----------------------------------------------------------------------------
153 LDAP_ProcessOneSearchResult (interp, ldap, entry, destArrayNameObj, evalCodeObj)
157 Tcl_Obj *destArrayNameObj;
158 Tcl_Obj *evalCodeObj;
161 Tcl_Obj *attributeNameObj;
162 Tcl_Obj *attributeDataObj;
165 struct berval **bvals;
169 Tcl_UnsetVar (interp, Tcl_GetStringFromObj (destArrayNameObj, NULL), 0);
171 dn = ldap_get_dn(ldap, entry);
173 if (Tcl_SetVar2(interp, /* set dn */
174 Tcl_GetStringFromObj(destArrayNameObj, NULL),
177 TCL_LEAVE_ERR_MSG) == NULL)
181 for (attributeName = ldap_first_attribute (ldap, entry, &ber);
182 attributeName != NULL;
183 attributeName = ldap_next_attribute(ldap, entry, ber)) {
185 bvals = ldap_get_values_len(ldap, entry, attributeName);
188 /* Note here that the U.of.M. ldap will return a null bvals
189 when the last attribute value has been deleted, but still
190 retains the attributeName. Even though this is documented
191 as an error, we ignore it to present a consistent interface
192 with Netscape's server
194 attributeNameObj = Tcl_NewStringObj (attributeName, -1);
195 Tcl_IncrRefCount (attributeNameObj);
196 attributeDataObj = Tcl_NewObj();
197 for (i = 0; bvals[i] != NULL; i++) {
198 Tcl_Obj *singleAttributeValueObj;
200 singleAttributeValueObj = Tcl_NewStringObj (bvals[i]->bv_val, -1);
201 if (Tcl_ListObjAppendElement (interp,
203 singleAttributeValueObj)
209 ldap_value_free_len(bvals);
211 if (Tcl_ObjSetVar2 (interp,
215 TCL_LEAVE_ERR_MSG) == NULL) {
218 Tcl_DecrRefCount (attributeNameObj);
220 ldap_attributefree(attributeName);
222 return Tcl_EvalObj (interp, evalCodeObj);
225 /*-----------------------------------------------------------------------------
226 * LDAP_PerformSearch --
228 * Perform an LDAP search.
231 * o interp - Tcl interpreter; Errors are returned in result.
232 * o ldap - LDAP structure pointer.
233 * o base - Base DN from which to perform search.
234 * o scope - LDAP search scope, must be one of LDAP_SCOPE_BASE,
235 * LDAP_SCOPE_ONELEVEL, or LDAP_SCOPE_SUBTREE.
236 * o attrs - Pointer to array of char * pointers of desired
237 * attribute names, or NULL for all attributes.
238 * o filtpatt LDAP filter pattern.
239 * o value Value to get sprintf'ed into filter pattern.
240 * o destArrayNameObj - Name of Tcl array in which to store attributes.
241 * o evalCodeObj - Tcl_Obj pointer to code to eval against this result.
243 * o TCL_OK if processing succeeded..
244 * o TCL_ERROR if an error occured, with error message in interp.
245 *-----------------------------------------------------------------------------
248 LDAP_PerformSearch (interp, ldaptcl, base, scope, attrs, filtpatt, value, destArrayNameObj, evalCodeObj, timeout_p)
256 Tcl_Obj *destArrayNameObj;
257 Tcl_Obj *evalCodeObj;
258 struct timeval *timeout_p;
260 LDAP *ldap = ldaptcl->ldap;
265 int tclResult = TCL_OK;
267 LDAPMessage *resultMessage;
268 LDAPMessage *entryMessage;
273 resultObj = Tcl_GetObjResult (interp);
275 sprintf(filter, filtpatt, value);
277 if ((msgid = ldap_search (ldap, base, scope, filter, attrs, 0)) == -1) {
278 Tcl_AppendStringsToObj (resultObj,
279 "LDAP start search error: ",
280 LDAP_ERR_STRING(ldap),
282 LDAP_SetErrorCode(ldaptcl, -1, interp);
287 while ((resultCode = ldap_result (ldap,
291 &resultMessage)) == LDAP_RES_SEARCH_ENTRY) {
293 entryMessage = ldap_first_entry(ldap, resultMessage);
295 tclResult = LDAP_ProcessOneSearchResult (interp,
300 ldap_msgfree(resultMessage);
301 if (tclResult != TCL_OK) {
302 if (tclResult == TCL_CONTINUE) {
304 } else if (tclResult == TCL_BREAK) {
308 } else if (tclResult == TCL_ERROR) {
310 sprintf(msg, "\n (\"search\" body line %d)",
312 Tcl_AddObjErrorInfo(interp, msg, -1);
321 if (abandon || resultCode == 0) {
322 ldap_abandon(ldap, msgid);
323 if (resultCode == 0) {
324 Tcl_SetErrorCode (interp, "TIMEOUT", (char*) NULL);
325 Tcl_SetStringObj (resultObj, "LDAP timeout retrieving results", -1);
329 if (resultCode == LDAP_RES_SEARCH_RESULT) {
330 if ((errorCode = ldap_result2error (ldap, resultMessage, 0))
332 Tcl_AppendStringsToObj (resultObj,
333 "LDAP search error: ",
334 ldap_err2string(errorCode),
336 ldap_msgfree(resultMessage);
337 LDAP_SetErrorCode(ldaptcl, errorCode, interp);
343 if (resultCode == -1) {
344 Tcl_AppendStringsToObj (resultObj,
345 "LDAP result search error: ",
346 LDAP_ERR_STRING(ldap),
348 LDAP_SetErrorCode(ldaptcl, -1, interp);
351 ldap_msgfree(resultMessage);
357 /*-----------------------------------------------------------------------------
358 * NeoX_LdapTargetObjCmd --
360 * Implements the body of commands created by Neo_LdapObjCmd.
363 * A standard Tcl result.
366 * See the user documentation.
367 *-----------------------------------------------------------------------------
370 NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
371 ClientData clientData;
374 Tcl_Obj *CONST objv[];
378 LDAPTCL *ldaptcl = (LDAPTCL *)clientData;
379 LDAP *ldap = ldaptcl->ldap;
382 int is_add_or_modify = 0;
384 char *m, *s, *errmsg;
387 Tcl_Obj *resultObj = Tcl_GetObjResult (interp);
390 return TclX_WrongArgs (interp,
392 "subcommand [args...]");
394 command = Tcl_GetStringFromObj (objv[0], NULL);
395 subCommand = Tcl_GetStringFromObj (objv[1], NULL);
397 /* object bind authtype name password */
398 if (STREQU (subCommand, "bind")) {
402 char *ldap_authString;
406 return TclX_WrongArgs (interp, objv [0], "bind authtype dn passwd");
408 ldap_authString = Tcl_GetStringFromObj (objv[2], NULL);
410 if (STREQU (ldap_authString, "simple")) {
411 ldap_authInt = LDAP_AUTH_SIMPLE;
414 else if (STREQU (ldap_authString, "kerberos_ldap")) {
415 ldap_authInt = LDAP_AUTH_KRBV41;
416 } else if (STREQU (ldap_authString, "kerberos_dsa")) {
417 ldap_authInt = LDAP_AUTH_KRBV42;
418 } else if (STREQU (ldap_authString, "kerberos_both")) {
419 ldap_authInt = LDAP_AUTH_KRBV4;
423 Tcl_AppendStringsToObj (resultObj,
429 "\" authtype must be one of \"simple\", ",
430 "\"kerberos_ldap\", \"kerberos_dsa\" ",
431 "or \"kerberos_both\"",
433 "\" authtype must be \"simple\", ",
439 binddn = Tcl_GetStringFromObj (objv[3], &stringLength);
440 if (stringLength == 0)
443 passwd = Tcl_GetStringFromObj (objv[4], &stringLength);
444 if (stringLength == 0)
447 /* ldap_bind_s(ldap, dn, pw, method) */
450 #define LDAP_BIND(ldap, dn, pw, method) \
451 ldap_bind_s(ldap, dn, pw, method)
453 #define LDAP_BIND(ldap, dn, pw, method) \
454 ldap_simple_bind_s(ldap, dn, pw)
456 if ((errcode = LDAP_BIND (ldap,
459 ldap_authInt)) != LDAP_SUCCESS) {
461 Tcl_AppendStringsToObj (resultObj,
463 ldap_err2string(errcode),
465 LDAP_SetErrorCode(ldaptcl, errcode, interp);
471 if (STREQU (subCommand, "unbind")) {
473 return TclX_WrongArgs (interp, objv [0], "unbind");
475 return Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], NULL));
478 /* object delete dn */
479 if (STREQU (subCommand, "delete")) {
481 return TclX_WrongArgs (interp, objv [0], "delete dn");
483 dn = Tcl_GetStringFromObj (objv [2], NULL);
484 if ((errcode = ldap_delete_s(ldap, dn)) != LDAP_SUCCESS) {
485 Tcl_AppendStringsToObj (resultObj,
486 "LDAP delete error: ",
487 ldap_err2string(errcode),
489 LDAP_SetErrorCode(ldaptcl, errcode, interp);
495 /* object rename_rdn dn rdn */
496 /* object modify_rdn dn rdn */
497 if (STREQU (subCommand, "rename_rdn") || STREQU (subCommand, "modify_rdn")) {
502 return TclX_WrongArgs (interp,
504 "delete_rdn|modify_rdn dn rdn");
506 dn = Tcl_GetStringFromObj (objv [2], NULL);
507 rdn = Tcl_GetStringFromObj (objv [3], NULL);
509 deleteOldRdn = (*subCommand == 'r');
511 if ((errcode = ldap_modrdn2_s (ldap, dn, rdn, deleteOldRdn)) != LDAP_SUCCESS) {
512 Tcl_AppendStringsToObj (resultObj,
516 ldap_err2string(errcode),
518 LDAP_SetErrorCode(ldaptcl, errcode, interp);
524 /* object add dn attributePairList */
525 /* object add_attributes dn attributePairList */
526 /* object replace_attributes dn attributePairList */
527 /* object delete_attributes dn attributePairList */
529 if (STREQU (subCommand, "add")) {
531 is_add_or_modify = 1;
534 if (STREQU (subCommand, "add_attributes")) {
535 is_add_or_modify = 1;
536 mod_op = LDAP_MOD_ADD;
537 } else if (STREQU (subCommand, "replace_attributes")) {
538 is_add_or_modify = 1;
539 mod_op = LDAP_MOD_REPLACE;
540 } else if (STREQU (subCommand, "delete_attributes")) {
541 is_add_or_modify = 1;
542 mod_op = LDAP_MOD_DELETE;
546 if (is_add_or_modify) {
550 char **valPtrs = NULL;
552 Tcl_Obj **attribObjv;
554 Tcl_Obj **valuesObjv;
559 Tcl_Obj *resultObj = Tcl_GetObjResult (interp);
562 Tcl_AppendStringsToObj (resultObj,
564 Tcl_GetStringFromObj (objv [0], NULL),
567 " dn attributePairList",
572 dn = Tcl_GetStringFromObj (objv [2], NULL);
574 if (Tcl_ListObjGetElements (interp, objv [3], &attribObjc, &attribObjv)
579 if (attribObjc & 1) {
580 Tcl_AppendStringsToObj (resultObj,
581 "attribute list does not contain an ",
582 "even number of key-value elements",
587 nPairs = attribObjc / 2;
589 modArray = (LDAPMod **)ckalloc (sizeof(LDAPMod *) * (nPairs + 1));
590 modArray[nPairs] = (LDAPMod *) NULL;
592 for (i = 0; i < nPairs; i++) {
593 mod = modArray[i] = (LDAPMod *) ckalloc (sizeof(LDAPMod));
594 mod->mod_op = mod_op;
595 mod->mod_type = Tcl_GetStringFromObj (attribObjv [i * 2], NULL);
597 if (Tcl_ListObjGetElements (interp, attribObjv [i * 2 + 1], &valuesObjc, &valuesObjv) == TCL_ERROR) {
598 /* FIX: cleanup memory here */
602 valPtrs = mod->mod_vals.modv_strvals = \
603 (char **)ckalloc (sizeof (char *) * (valuesObjc + 1));
604 valPtrs[valuesObjc] = (char *)NULL;
606 for (j = 0; j < valuesObjc; j++) {
607 valPtrs [j] = Tcl_GetStringFromObj (valuesObjv[j], NULL);
609 /* If it's "delete" and value is an empty string, make
610 * value be NULL to indicate entire attribute is to be
612 if ((*valPtrs [j] == '\0')
613 && (mod->mod_op == LDAP_MOD_DELETE)) {
620 result = ldap_add_s (ldap, dn, modArray);
622 result = ldap_modify_s (ldap, dn, modArray);
625 /* free the modArray elements, then the modArray itself. */
626 for (i = 0; i < nPairs; i++) {
627 ckfree ((char *) modArray[i]->mod_vals.modv_strvals);
628 ckfree ((char *) modArray[i]);
630 ckfree ((char *) modArray);
632 /* FIX: memory cleanup required all over the place here */
633 if (result != LDAP_SUCCESS) {
634 Tcl_AppendStringsToObj (resultObj,
638 ldap_err2string(result),
640 LDAP_SetErrorCode(ldaptcl, result, interp);
646 /* object search controlArray dn pattern */
647 if (STREQU (subCommand, "search")) {
648 char *controlArrayName;
649 Tcl_Obj *controlArrayNameObj;
659 char **attributesArray;
660 char *attributesString;
663 char *filterPatternString;
667 struct timeval timeout, *timeout_p;
669 Tcl_Obj *destArrayNameObj;
670 Tcl_Obj *evalCodeObj;
673 return TclX_WrongArgs (interp,
675 "search controlArray destArray code");
677 controlArrayNameObj = objv [2];
678 controlArrayName = Tcl_GetStringFromObj (controlArrayNameObj, NULL);
680 destArrayNameObj = objv [3];
682 evalCodeObj = objv [4];
684 baseString = Tcl_GetVar2 (interp,
689 if (baseString == (char *)NULL) {
690 Tcl_AppendStringsToObj (resultObj,
691 "required element \"base\" ",
692 "is missing from ldap control array \"",
699 filterPatternString = Tcl_GetVar2 (interp,
703 if (filterPatternString == (char *)NULL) {
704 filterPatternString = "objectclass=*";
707 /* Fetch scope setting from control array.
708 * If it doesn't exist, default to subtree scoping.
710 scopeString = Tcl_GetVar2 (interp, controlArrayName, "scope", 0);
711 if (scopeString == NULL) {
712 scope = LDAP_SCOPE_SUBTREE;
714 if (STREQU(scopeString, "base"))
715 scope = LDAP_SCOPE_BASE;
716 else if (STRNEQU(scopeString, "one", 3))
717 scope = LDAP_SCOPE_ONELEVEL;
718 else if (STRNEQU(scopeString, "sub", 3))
719 scope = LDAP_SCOPE_SUBTREE;
721 Tcl_AppendStringsToObj (resultObj,
722 "\"scope\" element of \"",
724 "\" array is not one of ",
725 "\"base\", \"onelevel\", ",
732 /* Fetch dereference control setting from control array.
733 * If it doesn't exist, default to never dereference. */
734 derefString = Tcl_GetVar2 (interp,
739 if (derefString == (char *)NULL) {
740 deref = LDAP_DEREF_NEVER;
742 if (STREQU(derefString, "never"))
743 deref = LDAP_DEREF_NEVER;
744 else if (STREQU(derefString, "search"))
745 deref = LDAP_DEREF_SEARCHING;
746 else if (STREQU(derefString, "find") == 0)
747 deref = LDAP_DEREF_FINDING;
748 else if (STREQU(derefString, "always"))
749 deref = LDAP_DEREF_ALWAYS;
751 Tcl_AppendStringsToObj (resultObj,
752 "\"deref\" element of \"",
754 "\" array is not one of ",
755 "\"never\", \"search\", \"find\", ",
762 /* Fetch list of attribute names from control array.
763 * If entry doesn't exist, default to NULL (all).
765 attributesString = Tcl_GetVar2 (interp,
769 if (attributesString == (char *)NULL) {
770 attributesArray = NULL;
772 if ((Tcl_SplitList (interp,
775 &attributesArray)) != TCL_OK) {
780 /* Fetch timeout value if there is one
782 timeoutString = Tcl_GetVar2 (interp,
787 if (timeoutString == (char *)NULL) {
791 if (Tcl_GetDouble(interp, timeoutString, &timeoutTime) != TCL_OK)
793 timeout.tv_sec = floor(timeoutTime);
794 timeout.tv_usec = (timeoutTime-timeout.tv_sec) * 1000000;
795 timeout_p = &timeout;
799 ldap->ld_deref = deref;
800 ldap->ld_timelimit = 0;
801 ldap->ld_sizelimit = 0;
802 ldap->ld_options = 0;
805 return LDAP_PerformSearch (interp,
817 #if defined(UMICH_LDAP) || (defined(OPEN_LDAP) && !defined(LDAP_API_VERSION))
818 if (STREQU (subCommand, "cache")) {
823 return TclX_WrongArgs (interp,
825 "cache command [args...]");
827 cacheCommand = Tcl_GetStringFromObj (objv [2], NULL);
829 if (STREQU (cacheCommand, "uncache")) {
833 return TclX_WrongArgs (interp,
837 dn = Tcl_GetStringFromObj (objv [3], NULL);
838 ldap_uncache_entry (ldap, dn);
842 if (STREQU (cacheCommand, "enable")) {
847 return TclX_WrongArgs (interp,
849 "cache enable timeout maxmem");
851 if (Tcl_GetLongFromObj (interp, objv [3], &timeout) == TCL_ERROR)
854 if (Tcl_GetLongFromObj (interp, objv [4], &maxmem) == TCL_ERROR)
857 if (ldap_enable_cache (ldap, timeout, maxmem) == -1) {
858 Tcl_AppendStringsToObj (resultObj,
859 "LDAP cache enable error: ",
860 LDAP_ERR_STRING(ldap),
862 LDAP_SetErrorCode(ldaptcl, -1, interp);
868 if (objc != 3) goto badargs;
870 if (STREQU (cacheCommand, "disable")) {
871 ldap_disable_cache (ldap);
875 if (STREQU (cacheCommand, "destroy")) {
876 ldap_destroy_cache (ldap);
880 if (STREQU (cacheCommand, "flush")) {
881 ldap_flush_cache (ldap);
885 if (STREQU (cacheCommand, "no_errors")) {
886 ldap_set_cache_options (ldap, LDAP_CACHE_OPT_CACHENOERRS);
890 if (STREQU (cacheCommand, "all_errors")) {
891 ldap_set_cache_options (ldap, LDAP_CACHE_OPT_CACHEALLERRS);
895 if (STREQU (cacheCommand, "size_errors")) {
896 ldap_set_cache_options (ldap, 0);
899 Tcl_AppendStringsToObj (resultObj,
905 " must be one of \"enable\", ",
907 "\"destroy\", \"flush\", \"uncache\", ",
908 "\"no_errors\", \"size_errors\",",
909 " or \"all_errors\"",
915 if (STREQU (subCommand, "debug")) {
917 Tcl_AppendStringsToObj(resultObj, "Wrong # of arguments",
921 return Tcl_GetIntFromObj(interp, objv[2], &ldap_debug);
925 /* FIX: this needs to enumerate all the possibilities */
926 Tcl_AppendStringsToObj (resultObj,
929 "\" must be one of \"add\", ",
930 "\"add_attributes\", ",
931 "\"bind\", \"cache\", \"delete\", ",
932 "\"delete_attributes\", \"modify\", ",
933 "\"modify_rdn\", \"rename_rdn\", ",
934 "\"replace_attributes\", ",
935 "\"search\" or \"unbind\".",
941 * Delete and LDAP command object
945 NeoX_LdapObjDeleteCmd(clientData)
946 ClientData clientData;
948 LDAPTCL *ldaptcl = (LDAPTCL *)clientData;
949 LDAP *ldap = ldaptcl->ldap;
952 ckfree((char*) ldaptcl);
955 /*-----------------------------------------------------------------------------
958 * Implements the `ldap' command:
959 * ldap open newObjName host [port]
960 * ldap init newObjName host [port]
963 * A standard Tcl result.
966 * See the user documentation.
967 *-----------------------------------------------------------------------------
970 NeoX_LdapObjCmd (clientData, interp, objc, objv)
971 ClientData clientData;
974 Tcl_Obj *CONST objv[];
984 Tcl_Obj *resultObj = Tcl_GetObjResult (interp);
986 if (objc < 3 || objc > 5)
987 return TclX_WrongArgs (interp, objv [0],
988 "(open|init) new_command host [port]|explode dn");
990 subCommand = Tcl_GetStringFromObj (objv[1], NULL);
992 if (STREQU(subCommand, "explode")) {
996 char **exploded, **p;
998 param = Tcl_GetStringFromObj (objv[2], NULL);
999 if (param[0] == '-') {
1000 if (STREQU(param, "-nonames")) {
1002 } else if (STREQU(param, "-list")) {
1005 return TclX_WrongArgs (interp, objv [0], "explode ?-nonames|-list? dn");
1008 if (nonames || list)
1009 param = Tcl_GetStringFromObj (objv[3], NULL);
1010 exploded = ldap_explode_dn(param, nonames);
1011 for (p = exploded; *p; p++) {
1013 char *q = strchr(*p, '=');
1015 Tcl_SetObjLength(resultObj, 0);
1016 Tcl_AppendStringsToObj(resultObj, "rdn ", *p,
1017 " missing '='", NULL);
1018 ldap_value_free(exploded);
1022 if (Tcl_ListObjAppendElement(interp, resultObj,
1023 Tcl_NewStringObj(*p, -1)) != TCL_OK ||
1024 Tcl_ListObjAppendElement(interp, resultObj,
1025 Tcl_NewStringObj(q+1, -1)) != TCL_OK) {
1026 ldap_value_free(exploded);
1030 if (Tcl_ListObjAppendElement(interp, resultObj,
1031 Tcl_NewStringObj(*p, -1))) {
1032 ldap_value_free(exploded);
1037 ldap_value_free(exploded);
1042 if (STREQU(subCommand, "friendly")) {
1043 char *friendly = ldap_dn2ufn(Tcl_GetStringFromObj(objv[2], NULL));
1044 Tcl_SetStringObj(resultObj, friendly, -1);
1050 newCommand = Tcl_GetStringFromObj (objv[2], NULL);
1051 ldapHost = Tcl_GetStringFromObj (objv[3], NULL);
1054 if (Tcl_GetIntFromObj (interp, objv [4], &ldapPort) == TCL_ERROR) {
1055 Tcl_AppendStringsToObj (resultObj,
1056 "LDAP port number is non-numeric",
1062 if (STREQU (subCommand, "open")) {
1063 ldap = ldap_open (ldapHost, ldapPort);
1064 } else if (STREQU (subCommand, "init")) {
1065 ldap = ldap_init (ldapHost, ldapPort);
1067 Tcl_AppendStringsToObj (resultObj,
1068 "option was not \"open\" or \"init\"");
1072 if (ldap == (LDAP *)NULL) {
1073 Tcl_SetErrno(errno);
1074 Tcl_AppendStringsToObj (resultObj,
1075 Tcl_PosixError (interp),
1081 ldap->ld_deref = LDAP_DEREF_NEVER; /* Turn off alias dereferencing */
1084 ldaptcl = (LDAPTCL *) ckalloc(sizeof(LDAPTCL));
1085 ldaptcl->ldap = ldap;
1088 Tcl_CreateObjCommand (interp,
1090 NeoX_LdapTargetObjCmd,
1091 (ClientData) ldaptcl,
1092 NeoX_LdapObjDeleteCmd);
1096 /*-----------------------------------------------------------------------------
1098 * Initialize the LDAP interface.
1099 *-----------------------------------------------------------------------------
1102 Ldaptcl_Init (interp)
1105 Tcl_CreateObjCommand (interp,
1109 (Tcl_CmdDeleteProc*) NULL);
1110 Tcl_PkgProvide(interp, "Ldaptcl", VERSION);