1 /* $NetBSD: neoXldap.c,v 1.2 2021/08/14 16:14:50 christos Exp $ */
2
3 /*
4 * NeoSoft Tcl client extensions to Lightweight Directory Access Protocol.
5 *
6 * Copyright (c) 1998-1999 NeoSoft, Inc.
7 * All Rights Reserved.
8 *
9 * This software may be used, modified, copied, distributed, and sold,
10 * in both source and binary form provided that these copyrights are
11 * retained and their terms are followed.
12 *
13 * Under no circumstances are the authors or NeoSoft Inc. responsible
14 * for the proper functioning of this software, nor do the authors
15 * assume any liability for damages incurred with its use.
16 *
17 * Redistribution and use in source and binary forms are permitted
18 * provided that this notice is preserved and that due credit is given
19 * to NeoSoft, Inc.
20 *
21 * NeoSoft, Inc. may not be used to endorse or promote products derived
22 * from this software without specific prior written permission. This
23 * software is provided ``as is'' without express or implied warranty.
24 *
25 * Requests for permission may be sent to NeoSoft Inc, 1770 St. James Place,
26 * Suite 500, Houston, TX, 77056.
27 *
28 * $OpenLDAP$
29 *
30 */
31
32 /*
33 * This code was originally developed by Karl Lehenbauer to work with
34 * Umich-3.3 LDAP. It was debugged against the Netscape LDAP server
35 * and their much more reliable SDK, and again backported to the
36 * Umich-3.3 client code. The UMICH_LDAP define is used to include
37 * code that will work with the Umich-3.3 LDAP, but not with Netscape's
38 * SDK. OpenLDAP may support some of these, but they have not been tested.
39 * Currently supported by Randy Kunkee (kunkee@OpenLDAP.org).
40 */
41
42 /*
43 * Add timeout to controlArray to set timeout for ldap_result.
44 * 4/14/99 - Randy
45 */
46
47 #include "tclExtend.h"
48
49 #include <lber.h>
50 #include <ldap.h>
51 #include <string.h>
52 #include <sys/time.h>
53 #include <math.h>
54
55 /*
56 * Macros to do string compares. They pre-check the first character before
57 * checking of the strings are equal.
58 */
59
60 #define STREQU(str1, str2) \
61 (((str1) [0] == (str2) [0]) && (strcmp (str1, str2) == 0))
62 #define STRNEQU(str1, str2, n) \
63 (((str1) [0] == (str2) [0]) && (strncmp (str1, str2, n) == 0))
64
65 /*
66 * The following section defines some common macros used by the rest
67 * of the code. It's ugly, and can use some work. This code was
68 * originally developed to work with Umich-3.3 LDAP. It was debugged
69 * against the Netscape LDAP server and the much more reliable SDK,
70 * and then again backported to the Umich-3.3 client code.
71 */
72 #define OPEN_LDAP 1
73 #if defined(OPEN_LDAP)
74 /* LDAP_API_VERSION must be defined per the current draft spec
75 ** it's value will be assigned RFC number. However, as
76 ** no RFC is defined, it's value is currently implementation
77 ** specific (though I would hope it's value is greater than 1823).
78 ** In OpenLDAP 2.x-devel, its 2000 + the draft number, ie 2002.
79 ** This section is for OPENLDAP.
80 */
81 #ifndef LDAP_API_FEATURE_X_OPENLDAP
82 #define ldap_memfree(p) free(p)
83 #endif
84 #ifdef LDAP_OPT_ERROR_NUMBER
85 #define ldap_get_lderrno(ld) (ldap_get_option(ld, LDAP_OPT_ERROR_NUMBER, &lderrno), lderrno)
86 #else
87 #define ldap_get_lderrno(ld) (ld->ld_errno)
88 #endif
89 #define LDAP_ERR_STRING(ld) \
90 ldap_err2string(ldap_get_lderrno(ld))
91 #elif defined( LDAP_OPT_SIZELIMIT )
92 /*
93 ** Netscape SDK w/ ldap_set_option, ldap_get_option
94 */
95 #define LDAP_ERR_STRING(ld) \
96 ldap_err2string(ldap_get_lderrno(ldap))
97 #else
98 /* U-Mich/OpenLDAP 1.x API */
99 /* RFC-1823 w/ changes */
100 #define UMICH_LDAP 1
101 #define ldap_memfree(p) free(p)
102 #define ldap_ber_free(p, n) ber_free(p, n)
103 #define ldap_value_free_len(bvals) ber_bvecfree(bvals)
104 #define ldap_get_lderrno(ld) (ld->ld_errno)
105 #define LDAP_ERR_STRING(ld) \
106 ldap_err2string(ld->ld_errno)
107 #endif
108
109 typedef struct ldaptclobj {
110 LDAP *ldap;
111 int caching; /* flag 1/0 if caching is enabled */
112 long timeout; /* timeout from last cache enable */
113 long maxmem; /* maxmem from last cache enable */
114 Tcl_Obj *trapCmdObj; /* error handler */
115 int *traplist; /* list of errorCodes to trap */
116 int flags;
117 } LDAPTCL;
118
119
120 #define LDAPTCL_INTERRCODES 0x001
121
122 #include "ldaptclerr.h"
123
124 static
LDAP_SetErrorCode(LDAPTCL * ldaptcl,int code,Tcl_Interp * interp)125 LDAP_SetErrorCode(LDAPTCL *ldaptcl, int code, Tcl_Interp *interp)
126 {
127 char shortbuf[16];
128 char *errp;
129 int lderrno;
130
131 if (code == -1)
132 code = ldap_get_lderrno(ldaptcl->ldap);
133 if ((ldaptcl->flags & LDAPTCL_INTERRCODES) || code > LDAPTCL_MAXERR ||
134 ldaptclerrorcode[code] == NULL) {
135 sprintf(shortbuf, "0x%03x", code);
136 errp = shortbuf;
137 } else
138 errp = ldaptclerrorcode[code];
139
140 Tcl_SetErrorCode(interp, errp, NULL);
141 if (ldaptcl->trapCmdObj) {
142 int *i;
143 Tcl_Obj *cmdObj;
144 if (ldaptcl->traplist != NULL) {
145 for (i = ldaptcl->traplist; *i && *i != code; i++)
146 ;
147 if (*i == 0) return;
148 }
149 (void) Tcl_EvalObj(interp, ldaptcl->trapCmdObj);
150 }
151 }
152
153 static
LDAP_ErrorStringToCode(Tcl_Interp * interp,char * s)154 LDAP_ErrorStringToCode(Tcl_Interp *interp, char *s)
155 {
156 int offset;
157 int code;
158
159 offset = (strncasecmp(s, "LDAP_", 5) == 0) ? 0 : 5;
160 for (code = 0; code < LDAPTCL_MAXERR; code++) {
161 if (!ldaptclerrorcode[code]) continue;
162 if (strcasecmp(s, ldaptclerrorcode[code]+offset) == 0)
163 return code;
164 }
165 Tcl_ResetResult(interp);
166 Tcl_AppendResult(interp, s, " is an invalid code", (char *) NULL);
167 return -1;
168 }
169
170 /*-----------------------------------------------------------------------------
171 * LDAP_ProcessOneSearchResult --
172 *
173 * Process one result return from an LDAP search.
174 *
175 * Parameters:
176 * o interp - Tcl interpreter; Errors are returned in result.
177 * o ldap - LDAP structure pointer.
178 * o entry - LDAP message pointer.
179 * o destArrayNameObj - Name of Tcl array in which to store attributes.
180 * o evalCodeObj - Tcl_Obj pointer to code to eval against this result.
181 * Returns:
182 * o TCL_OK if processing succeeded..
183 * o TCL_ERROR if an error occurred, with error message in interp.
184 *-----------------------------------------------------------------------------
185 */
186 int
LDAP_ProcessOneSearchResult(interp,ldap,entry,destArrayNameObj,evalCodeObj)187 LDAP_ProcessOneSearchResult (interp, ldap, entry, destArrayNameObj, evalCodeObj)
188 Tcl_Interp *interp;
189 LDAP *ldap;
190 LDAPMessage *entry;
191 Tcl_Obj *destArrayNameObj;
192 Tcl_Obj *evalCodeObj;
193 {
194 char *attributeName;
195 Tcl_Obj *attributeNameObj;
196 Tcl_Obj *attributeDataObj;
197 int i;
198 BerElement *ber;
199 struct berval **bvals;
200 char *dn;
201 int lderrno;
202
203 Tcl_UnsetVar (interp, Tcl_GetStringFromObj (destArrayNameObj, NULL), 0);
204
205 dn = ldap_get_dn(ldap, entry);
206 if (dn != NULL) {
207 if (Tcl_SetVar2(interp, /* set dn */
208 Tcl_GetStringFromObj(destArrayNameObj, NULL),
209 "dn",
210 dn,
211 TCL_LEAVE_ERR_MSG) == NULL)
212 return TCL_ERROR;
213 ldap_memfree(dn);
214 }
215 attributeNameObj = Tcl_NewObj();
216 Tcl_IncrRefCount (attributeNameObj);
217
218 /* Note that attributeName below is allocated for OL2+ libldap, so it
219 must be freed with ldap_memfree(). Test below is admittedly a hack.
220 */
221
222 for (attributeName = ldap_first_attribute (ldap, entry, &ber);
223 attributeName != NULL;
224 attributeName = ldap_next_attribute(ldap, entry, ber)) {
225
226 bvals = ldap_get_values_len(ldap, entry, attributeName);
227
228 if (bvals != NULL) {
229 /* Note here that the U.of.M. ldap will return a null bvals
230 when the last attribute value has been deleted, but still
231 retains the attributeName. Even though this is documented
232 as an error, we ignore it to present a consistent interface
233 with Netscape's server
234 */
235 attributeDataObj = Tcl_NewObj();
236 Tcl_SetStringObj(attributeNameObj, attributeName, -1);
237 #if LDAP_API_VERSION >= 2004
238 ldap_memfree(attributeName); /* free if newer API */
239 #endif
240 for (i = 0; bvals[i] != NULL; i++) {
241 Tcl_Obj *singleAttributeValueObj;
242
243 singleAttributeValueObj = Tcl_NewStringObj(bvals[i]->bv_val, bvals[i]->bv_len);
244 if (Tcl_ListObjAppendElement (interp,
245 attributeDataObj,
246 singleAttributeValueObj)
247 == TCL_ERROR) {
248 ber_free(ber, 0);
249 return TCL_ERROR;
250 }
251 }
252
253 ldap_value_free_len(bvals);
254
255 if (Tcl_ObjSetVar2 (interp,
256 destArrayNameObj,
257 attributeNameObj,
258 attributeDataObj,
259 TCL_LEAVE_ERR_MSG) == NULL) {
260 return TCL_ERROR;
261 }
262 }
263 }
264 Tcl_DecrRefCount (attributeNameObj);
265 return Tcl_EvalObj (interp, evalCodeObj);
266 }
267
268 /*-----------------------------------------------------------------------------
269 * LDAP_PerformSearch --
270 *
271 * Perform an LDAP search.
272 *
273 * Parameters:
274 * o interp - Tcl interpreter; Errors are returned in result.
275 * o ldap - LDAP structure pointer.
276 * o base - Base DN from which to perform search.
277 * o scope - LDAP search scope, must be one of LDAP_SCOPE_BASE,
278 * LDAP_SCOPE_ONELEVEL, or LDAP_SCOPE_SUBTREE.
279 * o attrs - Pointer to array of char * pointers of desired
280 * attribute names, or NULL for all attributes.
281 * o filtpatt LDAP filter pattern.
282 * o value Value to get sprintf'ed into filter pattern.
283 * o destArrayNameObj - Name of Tcl array in which to store attributes.
284 * o evalCodeObj - Tcl_Obj pointer to code to eval against this result.
285 * Returns:
286 * o TCL_OK if processing succeeded..
287 * o TCL_ERROR if an error occurred, with error message in interp.
288 *-----------------------------------------------------------------------------
289 */
290 int
LDAP_PerformSearch(interp,ldaptcl,base,scope,attrs,filtpatt,value,destArrayNameObj,evalCodeObj,timeout_p,all,sortattr)291 LDAP_PerformSearch (interp, ldaptcl, base, scope, attrs, filtpatt, value,
292 destArrayNameObj, evalCodeObj, timeout_p, all, sortattr)
293 Tcl_Interp *interp;
294 LDAPTCL *ldaptcl;
295 char *base;
296 int scope;
297 char **attrs;
298 char *filtpatt;
299 char *value;
300 Tcl_Obj *destArrayNameObj;
301 Tcl_Obj *evalCodeObj;
302 struct timeval *timeout_p;
303 int all;
304 char *sortattr;
305 {
306 LDAP *ldap = ldaptcl->ldap;
307 char filter[BUFSIZ];
308 int resultCode;
309 int errorCode;
310 int abandon;
311 int tclResult = TCL_OK;
312 int msgid;
313 LDAPMessage *resultMessage = 0;
314 LDAPMessage *entryMessage = 0;
315 char *sortKey;
316
317 int lderrno;
318
319 sprintf(filter, filtpatt, value);
320
321 fflush(stderr);
322 if ((msgid = ldap_search (ldap, base, scope, filter, attrs, 0)) == -1) {
323 Tcl_AppendResult (interp,
324 "LDAP start search error: ",
325 LDAP_ERR_STRING(ldap),
326 (char *)NULL);
327 LDAP_SetErrorCode(ldaptcl, -1, interp);
328 return TCL_ERROR;
329 }
330
331 abandon = 0;
332 if (sortattr)
333 all = 1;
334 tclResult = TCL_OK;
335 while (!abandon) {
336 resultCode = ldap_result (ldap, msgid, all, timeout_p, &resultMessage);
337 if (resultCode != LDAP_RES_SEARCH_RESULT &&
338 resultCode != LDAP_RES_SEARCH_ENTRY)
339 break;
340
341 if (sortattr) {
342 sortKey = (strcasecmp(sortattr, "dn") == 0) ? NULL : sortattr;
343 ldap_sort_entries(ldap, &resultMessage, sortKey, strcasecmp);
344 }
345 entryMessage = ldap_first_entry(ldap, resultMessage);
346
347 while (entryMessage) {
348 tclResult = LDAP_ProcessOneSearchResult (interp,
349 ldap,
350 entryMessage,
351 destArrayNameObj,
352 evalCodeObj);
353 if (tclResult != TCL_OK) {
354 if (tclResult == TCL_CONTINUE) {
355 tclResult = TCL_OK;
356 } else if (tclResult == TCL_BREAK) {
357 tclResult = TCL_OK;
358 abandon = 1;
359 break;
360 } else if (tclResult == TCL_ERROR) {
361 char msg[100];
362 sprintf(msg, "\n (\"search\" body line %d)",
363 interp->errorLine);
364 Tcl_AddObjErrorInfo(interp, msg, -1);
365 abandon = 1;
366 break;
367 } else {
368 abandon = 1;
369 break;
370 }
371 }
372 entryMessage = ldap_next_entry(ldap, entryMessage);
373 }
374 if (resultCode == LDAP_RES_SEARCH_RESULT || all)
375 break;
376 if (resultMessage)
377 ldap_msgfree(resultMessage);
378 resultMessage = NULL;
379 }
380 if (abandon) {
381 if (resultMessage)
382 ldap_msgfree(resultMessage);
383 if (resultCode == LDAP_RES_SEARCH_ENTRY)
384 ldap_abandon(ldap, msgid);
385 return tclResult;
386 }
387 if (resultCode == -1) {
388 Tcl_ResetResult (interp);
389 Tcl_AppendResult (interp,
390 "LDAP result search error: ",
391 LDAP_ERR_STRING(ldap),
392 (char *)NULL);
393 LDAP_SetErrorCode(ldaptcl, -1, interp);
394 return TCL_ERROR;
395 }
396
397 if ((errorCode = ldap_result2error (ldap, resultMessage, 0))
398 != LDAP_SUCCESS) {
399 Tcl_ResetResult (interp);
400 Tcl_AppendResult (interp,
401 "LDAP search error: ",
402 ldap_err2string(errorCode),
403 (char *)NULL);
404 if (resultMessage)
405 ldap_msgfree(resultMessage);
406 LDAP_SetErrorCode(ldaptcl, errorCode, interp);
407 return TCL_ERROR;
408 }
409 if (resultMessage)
410 ldap_msgfree(resultMessage);
411 return tclResult;
412 }
413
414 /*-----------------------------------------------------------------------------
415 * NeoX_LdapTargetObjCmd --
416 *
417 * Implements the body of commands created by Neo_LdapObjCmd.
418 *
419 * Results:
420 * A standard Tcl result.
421 *
422 * Side effects:
423 * See the user documentation.
424 *-----------------------------------------------------------------------------
425 */
426 int
NeoX_LdapTargetObjCmd(clientData,interp,objc,objv)427 NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
428 ClientData clientData;
429 Tcl_Interp *interp;
430 int objc;
431 Tcl_Obj *CONST objv[];
432 {
433 char *command;
434 char *subCommand;
435 LDAPTCL *ldaptcl = (LDAPTCL *)clientData;
436 LDAP *ldap = ldaptcl->ldap;
437 char *dn;
438 int is_add = 0;
439 int is_add_or_modify = 0;
440 int mod_op = 0;
441 char *m, *s, *errmsg;
442 int errcode;
443 int tclResult;
444 int lderrno; /* might be used by LDAP_ERR_STRING macro */
445
446 Tcl_Obj *resultObj = Tcl_GetObjResult (interp);
447
448 if (objc < 2) {
449 Tcl_WrongNumArgs (interp, 1, objv, "subcommand [args...]");
450 return TCL_ERROR;
451 }
452
453 command = Tcl_GetStringFromObj (objv[0], NULL);
454 subCommand = Tcl_GetStringFromObj (objv[1], NULL);
455
456 /* object bind authtype name password */
457 if (STREQU (subCommand, "bind")) {
458 char *binddn;
459 char *passwd;
460 int stringLength;
461 char *ldap_authString;
462 int ldap_authInt;
463
464 if (objc != 5) {
465 Tcl_WrongNumArgs (interp, 2, objv, "authtype dn passwd");
466 return TCL_ERROR;
467 }
468
469 ldap_authString = Tcl_GetStringFromObj (objv[2], NULL);
470
471 if (STREQU (ldap_authString, "simple")) {
472 ldap_authInt = LDAP_AUTH_SIMPLE;
473 }
474 #ifdef UMICH_LDAP
475 else if (STREQU (ldap_authString, "kerberos_ldap")) {
476 ldap_authInt = LDAP_AUTH_KRBV41;
477 } else if (STREQU (ldap_authString, "kerberos_dsa")) {
478 ldap_authInt = LDAP_AUTH_KRBV42;
479 } else if (STREQU (ldap_authString, "kerberos_both")) {
480 ldap_authInt = LDAP_AUTH_KRBV4;
481 }
482 #endif
483 else {
484 Tcl_AppendStringsToObj (resultObj,
485 "\"",
486 command,
487 " ",
488 subCommand,
489 #ifdef UMICH_LDAP
490 "\" authtype must be one of \"simple\", ",
491 "\"kerberos_ldap\", \"kerberos_dsa\" ",
492 "or \"kerberos_both\"",
493 #else
494 "\" authtype must be \"simple\", ",
495 #endif
496 (char *)NULL);
497 return TCL_ERROR;
498 }
499
500 binddn = Tcl_GetStringFromObj (objv[3], &stringLength);
501 if (stringLength == 0)
502 binddn = NULL;
503
504 passwd = Tcl_GetStringFromObj (objv[4], &stringLength);
505 if (stringLength == 0)
506 passwd = NULL;
507
508 /* ldap_bind_s(ldap, dn, pw, method) */
509
510 #ifdef UMICH_LDAP
511 #define LDAP_BIND(ldap, dn, pw, method) \
512 ldap_bind_s(ldap, dn, pw, method)
513 #else
514 #define LDAP_BIND(ldap, dn, pw, method) \
515 ldap_simple_bind_s(ldap, dn, pw)
516 #endif
517 if ((errcode = LDAP_BIND (ldap,
518 binddn,
519 passwd,
520 ldap_authInt)) != LDAP_SUCCESS) {
521
522 Tcl_AppendStringsToObj (resultObj,
523 "LDAP bind error: ",
524 ldap_err2string(errcode),
525 (char *)NULL);
526 LDAP_SetErrorCode(ldaptcl, errcode, interp);
527 return TCL_ERROR;
528 }
529 return TCL_OK;
530 }
531
532 if (STREQU (subCommand, "unbind")) {
533 if (objc != 2) {
534 Tcl_WrongNumArgs (interp, 2, objv, "");
535 return TCL_ERROR;
536 }
537
538 return Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], NULL));
539 }
540
541 /* object delete dn */
542 if (STREQU (subCommand, "delete")) {
543 if (objc != 3) {
544 Tcl_WrongNumArgs (interp, 2, objv, "dn");
545 return TCL_ERROR;
546 }
547
548 dn = Tcl_GetStringFromObj (objv [2], NULL);
549 if ((errcode = ldap_delete_s(ldap, dn)) != LDAP_SUCCESS) {
550 Tcl_AppendStringsToObj (resultObj,
551 "LDAP delete error: ",
552 ldap_err2string(errcode),
553 (char *)NULL);
554 LDAP_SetErrorCode(ldaptcl, errcode, interp);
555 return TCL_ERROR;
556 }
557 return TCL_OK;
558 }
559
560 /* object rename_rdn dn rdn */
561 /* object modify_rdn dn rdn */
562 if (STREQU (subCommand, "rename_rdn") || STREQU (subCommand, "modify_rdn")) {
563 char *rdn;
564 int deleteOldRdn;
565
566 if (objc != 4) {
567 Tcl_WrongNumArgs (interp, 2, objv, "dn rdn");
568 return TCL_ERROR;
569 }
570
571 dn = Tcl_GetStringFromObj (objv [2], NULL);
572 rdn = Tcl_GetStringFromObj (objv [3], NULL);
573
574 deleteOldRdn = (*subCommand == 'r');
575
576 if ((errcode = ldap_modrdn2_s (ldap, dn, rdn, deleteOldRdn)) != LDAP_SUCCESS) {
577 Tcl_AppendStringsToObj (resultObj,
578 "LDAP ",
579 subCommand,
580 " error: ",
581 ldap_err2string(errcode),
582 (char *)NULL);
583 LDAP_SetErrorCode(ldaptcl, errcode, interp);
584 return TCL_ERROR;
585 }
586 return TCL_OK;
587 }
588
589 /* object add dn attributePairList */
590 /* object add_attributes dn attributePairList */
591 /* object replace_attributes dn attributePairList */
592 /* object delete_attributes dn attributePairList */
593
594 if (STREQU (subCommand, "add")) {
595 is_add = 1;
596 is_add_or_modify = 1;
597 } else {
598 is_add = 0;
599 if (STREQU (subCommand, "add_attributes")) {
600 is_add_or_modify = 1;
601 mod_op = LDAP_MOD_ADD;
602 } else if (STREQU (subCommand, "replace_attributes")) {
603 is_add_or_modify = 1;
604 mod_op = LDAP_MOD_REPLACE;
605 } else if (STREQU (subCommand, "delete_attributes")) {
606 is_add_or_modify = 1;
607 mod_op = LDAP_MOD_DELETE;
608 }
609 }
610
611 if (is_add_or_modify) {
612 int result;
613 LDAPMod **modArray;
614 LDAPMod *mod;
615 char **valPtrs = NULL;
616 int attribObjc;
617 Tcl_Obj **attribObjv;
618 int valuesObjc;
619 Tcl_Obj **valuesObjv;
620 int nPairs, allPairs;
621 int i;
622 int j;
623 int pairIndex;
624 int modIndex;
625
626 Tcl_Obj *resultObj = Tcl_GetObjResult (interp);
627
628 if (objc < 4 || objc > 4 && is_add || is_add == 0 && objc&1) {
629 Tcl_AppendStringsToObj (resultObj,
630 "wrong # args: ",
631 Tcl_GetStringFromObj (objv [0], NULL),
632 " ",
633 subCommand,
634 " dn attributePairList",
635 (char *)NULL);
636 if (!is_add)
637 Tcl_AppendStringsToObj (resultObj,
638 " ?[add|delete|replace] attributePairList ...?", (char *)NULL);
639 return TCL_ERROR;
640 }
641
642 dn = Tcl_GetStringFromObj (objv [2], NULL);
643
644 allPairs = 0;
645 for (i = 3; i < objc; i += 2) {
646 if (Tcl_ListObjLength (interp, objv[i], &j) == TCL_ERROR)
647 return TCL_ERROR;
648 if (j & 1) {
649 Tcl_AppendStringsToObj (resultObj,
650 "attribute list does not contain an ",
651 "even number of key-value elements",
652 (char *)NULL);
653 return TCL_ERROR;
654 }
655 allPairs += j / 2;
656 }
657
658 modArray = (LDAPMod **)malloc (sizeof(LDAPMod *) * (allPairs + 1));
659
660 pairIndex = 3;
661 modIndex = 0;
662
663 do {
664
665 if (Tcl_ListObjGetElements (interp, objv [pairIndex], &attribObjc, &attribObjv)
666 == TCL_ERROR) {
667 mod_op = -1;
668 goto badop;
669 }
670
671 nPairs = attribObjc / 2;
672
673 for (i = 0; i < nPairs; i++) {
674 mod = modArray[modIndex++] = (LDAPMod *) malloc (sizeof(LDAPMod));
675 mod->mod_op = mod_op;
676 mod->mod_type = Tcl_GetStringFromObj (attribObjv [i * 2], NULL);
677
678 if (Tcl_ListObjGetElements (interp, attribObjv [i * 2 + 1], &valuesObjc, &valuesObjv) == TCL_ERROR) {
679 /* FIX: cleanup memory here */
680 mod_op = -1;
681 goto badop;
682 }
683
684 valPtrs = mod->mod_vals.modv_strvals = \
685 (char **)malloc (sizeof (char *) * (valuesObjc + 1));
686 valPtrs[valuesObjc] = (char *)NULL;
687
688 for (j = 0; j < valuesObjc; j++) {
689 valPtrs [j] = Tcl_GetStringFromObj (valuesObjv[j], NULL);
690
691 /* If it's "delete" and value is an empty string, make
692 * value be NULL to indicate entire attribute is to be
693 * deleted */
694 if ((*valPtrs [j] == '\0')
695 && (mod->mod_op == LDAP_MOD_DELETE || mod->mod_op == LDAP_MOD_REPLACE)) {
696 valPtrs [j] = NULL;
697 }
698 }
699 }
700
701 pairIndex += 2;
702 if (mod_op != -1 && pairIndex < objc) {
703 subCommand = Tcl_GetStringFromObj (objv[pairIndex - 1], NULL);
704 mod_op = -1;
705 if (STREQU (subCommand, "add")) {
706 mod_op = LDAP_MOD_ADD;
707 } else if (STREQU (subCommand, "replace")) {
708 mod_op = LDAP_MOD_REPLACE;
709 } else if (STREQU (subCommand, "delete")) {
710 mod_op = LDAP_MOD_DELETE;
711 }
712 if (mod_op == -1) {
713 Tcl_SetStringObj (resultObj,
714 "Additional operators must be one of"
715 " add, replace, or delete", -1);
716 mod_op = -1;
717 goto badop;
718 }
719 }
720
721 } while (mod_op != -1 && pairIndex < objc);
722 modArray[modIndex] = (LDAPMod *) NULL;
723
724 if (is_add) {
725 result = ldap_add_s (ldap, dn, modArray);
726 } else {
727 result = ldap_modify_s (ldap, dn, modArray);
728 if (ldaptcl->caching)
729 ldap_uncache_entry (ldap, dn);
730 }
731
732 /* free the modArray elements, then the modArray itself. */
733 badop:
734 for (i = 0; i < modIndex; i++) {
735 free ((char *) modArray[i]->mod_vals.modv_strvals);
736 free ((char *) modArray[i]);
737 }
738 free ((char *) modArray);
739
740 /* after modArray is allocated, mod_op = -1 upon error for cleanup */
741 if (mod_op == -1)
742 return TCL_ERROR;
743
744 /* FIX: memory cleanup required all over the place here */
745 if (result != LDAP_SUCCESS) {
746 Tcl_AppendStringsToObj (resultObj,
747 "LDAP ",
748 subCommand,
749 " error: ",
750 ldap_err2string(result),
751 (char *)NULL);
752 LDAP_SetErrorCode(ldaptcl, result, interp);
753 return TCL_ERROR;
754 }
755 return TCL_OK;
756 }
757
758 /* object search controlArray dn pattern */
759 if (STREQU (subCommand, "search")) {
760 char *controlArrayName;
761 Tcl_Obj *controlArrayNameObj;
762
763 char *scopeString;
764 int scope;
765
766 char *derefString;
767 int deref;
768
769 char *baseString;
770
771 char **attributesArray;
772 char *attributesString;
773 int attributesArgc;
774
775 char *filterPatternString;
776
777 char *timeoutString;
778 double timeoutTime;
779 struct timeval timeout, *timeout_p;
780
781 char *paramString;
782 int cacheThis = -1;
783 int all = 0;
784
785 char *sortattr;
786
787 Tcl_Obj *destArrayNameObj;
788 Tcl_Obj *evalCodeObj;
789
790 if (objc != 5) {
791 Tcl_WrongNumArgs (interp, 2, objv,
792 "controlArray destArray code");
793 return TCL_ERROR;
794 }
795
796 controlArrayNameObj = objv [2];
797 controlArrayName = Tcl_GetStringFromObj (controlArrayNameObj, NULL);
798
799 destArrayNameObj = objv [3];
800
801 evalCodeObj = objv [4];
802
803 baseString = Tcl_GetVar2 (interp,
804 controlArrayName,
805 "base",
806 0);
807
808 if (baseString == (char *)NULL) {
809 Tcl_AppendStringsToObj (resultObj,
810 "required element \"base\" ",
811 "is missing from ldap control array \"",
812 controlArrayName,
813 "\"",
814 (char *)NULL);
815 return TCL_ERROR;
816 }
817
818 filterPatternString = Tcl_GetVar2 (interp,
819 controlArrayName,
820 "filter",
821 0);
822 if (filterPatternString == (char *)NULL) {
823 filterPatternString = "(objectclass=*)";
824 }
825
826 /* Fetch scope setting from control array.
827 * If it doesn't exist, default to subtree scoping.
828 */
829 scopeString = Tcl_GetVar2 (interp, controlArrayName, "scope", 0);
830 if (scopeString == NULL) {
831 scope = LDAP_SCOPE_SUBTREE;
832 } else {
833 if (STREQU(scopeString, "base"))
834 scope = LDAP_SCOPE_BASE;
835 else if (STRNEQU(scopeString, "one", 3))
836 scope = LDAP_SCOPE_ONELEVEL;
837 else if (STRNEQU(scopeString, "sub", 3))
838 scope = LDAP_SCOPE_SUBTREE;
839 else {
840 Tcl_AppendStringsToObj (resultObj,
841 "\"scope\" element of \"",
842 controlArrayName,
843 "\" array is not one of ",
844 "\"base\", \"onelevel\", ",
845 "or \"subtree\"",
846 (char *) NULL);
847 return TCL_ERROR;
848 }
849 }
850
851 #ifdef LDAP_OPT_DEREF
852 /* Fetch dereference control setting from control array.
853 * If it doesn't exist, default to never dereference. */
854 derefString = Tcl_GetVar2 (interp,
855 controlArrayName,
856 "deref",
857 0);
858 if (derefString == (char *)NULL) {
859 deref = LDAP_DEREF_NEVER;
860 } else {
861 if (STREQU(derefString, "never"))
862 deref = LDAP_DEREF_NEVER;
863 else if (STREQU(derefString, "search"))
864 deref = LDAP_DEREF_SEARCHING;
865 else if (STREQU(derefString, "find"))
866 deref = LDAP_DEREF_FINDING;
867 else if (STREQU(derefString, "always"))
868 deref = LDAP_DEREF_ALWAYS;
869 else {
870 Tcl_AppendStringsToObj (resultObj,
871 "\"deref\" element of \"",
872 controlArrayName,
873 "\" array is not one of ",
874 "\"never\", \"search\", \"find\", ",
875 "or \"always\"",
876 (char *) NULL);
877 return TCL_ERROR;
878 }
879 }
880 #endif
881
882 /* Fetch list of attribute names from control array.
883 * If entry doesn't exist, default to NULL (all).
884 */
885 attributesString = Tcl_GetVar2 (interp,
886 controlArrayName,
887 "attributes",
888 0);
889 if (attributesString == (char *)NULL) {
890 attributesArray = NULL;
891 } else {
892 if ((Tcl_SplitList (interp,
893 attributesString,
894 &attributesArgc,
895 &attributesArray)) != TCL_OK) {
896 return TCL_ERROR;
897 }
898 }
899
900 /* Fetch timeout value if there is one
901 */
902 timeoutString = Tcl_GetVar2 (interp,
903 controlArrayName,
904 "timeout",
905 0);
906 timeout.tv_usec = 0;
907 if (timeoutString == (char *)NULL) {
908 timeout_p = NULL;
909 timeout.tv_sec = 0;
910 } else {
911 if (Tcl_GetDouble(interp, timeoutString, &timeoutTime) != TCL_OK)
912 return TCL_ERROR;
913 timeout.tv_sec = floor(timeoutTime);
914 timeout.tv_usec = (timeoutTime-timeout.tv_sec) * 1000000;
915 timeout_p = &timeout;
916 }
917
918 paramString = Tcl_GetVar2 (interp, controlArrayName, "cache", 0);
919 if (paramString) {
920 if (Tcl_GetInt(interp, paramString, &cacheThis) == TCL_ERROR)
921 return TCL_ERROR;
922 }
923
924 paramString = Tcl_GetVar2 (interp, controlArrayName, "all", 0);
925 if (paramString) {
926 if (Tcl_GetInt(interp, paramString, &all) == TCL_ERROR)
927 return TCL_ERROR;
928 }
929
930 sortattr = Tcl_GetVar2 (interp, controlArrayName, "sort", 0);
931
932 #ifdef UMICH_LDAP
933 ldap->ld_deref = deref;
934 ldap->ld_timelimit = 0;
935 ldap->ld_sizelimit = 0;
936 ldap->ld_options = 0;
937 #endif
938
939 /* Caching control within the search: if the "cache" control array */
940 /* value is set, disable/enable caching accordingly */
941
942 #if 0
943 if (cacheThis >= 0 && ldaptcl->caching != cacheThis) {
944 if (cacheThis) {
945 if (ldaptcl->timeout == 0) {
946 Tcl_SetStringObj(resultObj, "Caching never before enabled, I have no timeout value to use", -1);
947 return TCL_ERROR;
948 }
949 ldap_enable_cache(ldap, ldaptcl->timeout, ldaptcl->maxmem);
950 }
951 else
952 ldap_disable_cache(ldap);
953 }
954 #endif
955
956 #ifdef LDAP_OPT_DEREF
957 ldap_set_option(ldap, LDAP_OPT_DEREF, &deref);
958 #endif
959
960 tclResult = LDAP_PerformSearch (interp,
961 ldaptcl,
962 baseString,
963 scope,
964 attributesArray,
965 filterPatternString,
966 "",
967 destArrayNameObj,
968 evalCodeObj,
969 timeout_p,
970 all,
971 sortattr);
972 /* Following the search, if we changed the caching behavior, change */
973 /* it back. */
974 #if 0
975 if (cacheThis >= 0 && ldaptcl->caching != cacheThis) {
976 if (cacheThis)
977 ldap_disable_cache(ldap);
978 else
979 ldap_enable_cache(ldap, ldaptcl->timeout, ldaptcl->maxmem);
980 }
981 #ifdef LDAP_OPT_DEREF
982 deref = LDAP_DEREF_NEVER;
983 ldap_set_option(ldap, LDAP_OPT_DEREF, &deref);
984 #endif
985 #endif
986 return tclResult;
987 }
988
989 /* object compare dn attr value */
990 if (STREQU (subCommand, "compare")) {
991 char *dn;
992 char *attr;
993 char *value;
994 int result;
995 int lderrno;
996
997 if (objc != 5) {
998 Tcl_WrongNumArgs (interp,
999 2, objv,
1000 "dn attribute value");
1001 return TCL_ERROR;
1002 }
1003
1004 dn = Tcl_GetStringFromObj (objv[2], NULL);
1005 attr = Tcl_GetStringFromObj (objv[3], NULL);
1006 value = Tcl_GetStringFromObj (objv[4], NULL);
1007
1008 result = ldap_compare_s (ldap, dn, attr, value);
1009 if (result == LDAP_COMPARE_TRUE || result == LDAP_COMPARE_FALSE) {
1010 Tcl_SetBooleanObj(resultObj, result == LDAP_COMPARE_TRUE);
1011 return TCL_OK;
1012 }
1013 LDAP_SetErrorCode(ldaptcl, result, interp);
1014 Tcl_AppendStringsToObj (resultObj,
1015 "LDAP compare error: ",
1016 LDAP_ERR_STRING(ldap),
1017 (char *)NULL);
1018 return TCL_ERROR;
1019 }
1020
1021 if (STREQU (subCommand, "cache")) {
1022 #if defined(UMICH_LDAP) || (defined(OPEN_LDAP) && !defined(LDAP_API_VERSION))
1023 char *cacheCommand;
1024
1025 if (objc < 3) {
1026 badargs:
1027 Tcl_WrongNumArgs (interp, 2, objv [0], "command [args...]");
1028 return TCL_ERROR;
1029 }
1030
1031 cacheCommand = Tcl_GetStringFromObj (objv [2], NULL);
1032
1033 if (STREQU (cacheCommand, "uncache")) {
1034 char *dn;
1035
1036 if (objc != 4) {
1037 Tcl_WrongNumArgs (interp,
1038 3, objv,
1039 "dn");
1040 return TCL_ERROR;
1041 }
1042
1043 dn = Tcl_GetStringFromObj (objv [3], NULL);
1044 ldap_uncache_entry (ldap, dn);
1045 return TCL_OK;
1046 }
1047
1048 if (STREQU (cacheCommand, "enable")) {
1049 long timeout = ldaptcl->timeout;
1050 long maxmem = ldaptcl->maxmem;
1051
1052 if (objc > 5) {
1053 Tcl_WrongNumArgs (interp, 3, objv, "?timeout? ?maxmem?");
1054 return TCL_ERROR;
1055 }
1056
1057 if (objc > 3) {
1058 if (Tcl_GetLongFromObj (interp, objv [3], &timeout) == TCL_ERROR)
1059 return TCL_ERROR;
1060 }
1061 if (timeout == 0) {
1062 Tcl_SetStringObj(resultObj,
1063 objc > 3 ? "timeouts must be greater than 0" :
1064 "no previous timeout to reference", -1);
1065 return TCL_ERROR;
1066 }
1067
1068 if (objc > 4)
1069 if (Tcl_GetLongFromObj (interp, objv [4], &maxmem) == TCL_ERROR)
1070 return TCL_ERROR;
1071
1072 if (ldap_enable_cache (ldap, timeout, maxmem) == -1) {
1073 Tcl_AppendStringsToObj (resultObj,
1074 "LDAP cache enable error: ",
1075 LDAP_ERR_STRING(ldap),
1076 (char *)NULL);
1077 LDAP_SetErrorCode(ldaptcl, -1, interp);
1078 return TCL_ERROR;
1079 }
1080 ldaptcl->caching = 1;
1081 ldaptcl->timeout = timeout;
1082 ldaptcl->maxmem = maxmem;
1083 return TCL_OK;
1084 }
1085
1086 if (objc != 3) goto badargs;
1087
1088 if (STREQU (cacheCommand, "disable")) {
1089 ldap_disable_cache (ldap);
1090 ldaptcl->caching = 0;
1091 return TCL_OK;
1092 }
1093
1094 if (STREQU (cacheCommand, "destroy")) {
1095 ldap_destroy_cache (ldap);
1096 ldaptcl->caching = 0;
1097 return TCL_OK;
1098 }
1099
1100 if (STREQU (cacheCommand, "flush")) {
1101 ldap_flush_cache (ldap);
1102 return TCL_OK;
1103 }
1104
1105 if (STREQU (cacheCommand, "no_errors")) {
1106 ldap_set_cache_options (ldap, LDAP_CACHE_OPT_CACHENOERRS);
1107 return TCL_OK;
1108 }
1109
1110 if (STREQU (cacheCommand, "all_errors")) {
1111 ldap_set_cache_options (ldap, LDAP_CACHE_OPT_CACHEALLERRS);
1112 return TCL_OK;
1113 }
1114
1115 if (STREQU (cacheCommand, "size_errors")) {
1116 ldap_set_cache_options (ldap, 0);
1117 return TCL_OK;
1118 }
1119 Tcl_AppendStringsToObj (resultObj,
1120 "\"",
1121 command,
1122 " ",
1123 subCommand,
1124 "\" subcommand",
1125 " must be one of \"enable\", ",
1126 "\"disable\", ",
1127 "\"destroy\", \"flush\", \"uncache\", ",
1128 "\"no_errors\", \"size_errors\",",
1129 " or \"all_errors\"",
1130 (char *)NULL);
1131 return TCL_ERROR;
1132 #else
1133 return TCL_OK;
1134 #endif
1135 }
1136 if (STREQU (subCommand, "trap")) {
1137 Tcl_Obj *listObj, *resultObj;
1138 int *p, l, i, code;
1139
1140 if (objc > 4) {
1141 Tcl_WrongNumArgs (interp, 2, objv,
1142 "command ?errorCode-list?");
1143 return TCL_ERROR;
1144 }
1145 if (objc == 2) {
1146 if (!ldaptcl->trapCmdObj)
1147 return TCL_OK;
1148 resultObj = Tcl_NewListObj(0, NULL);
1149 Tcl_ListObjAppendElement(interp, resultObj, ldaptcl->trapCmdObj);
1150 if (ldaptcl->traplist) {
1151 listObj = Tcl_NewObj();
1152 for (p = ldaptcl->traplist; *p; p++) {
1153 Tcl_ListObjAppendElement(interp, listObj,
1154 Tcl_NewStringObj(ldaptclerrorcode[*p], -1));
1155 }
1156 Tcl_ListObjAppendElement(interp, resultObj, listObj);
1157 }
1158 Tcl_SetObjResult(interp, resultObj);
1159 return TCL_OK;
1160 }
1161 if (ldaptcl->trapCmdObj) {
1162 Tcl_DecrRefCount (ldaptcl->trapCmdObj);
1163 ldaptcl->trapCmdObj = NULL;
1164 }
1165 if (ldaptcl->traplist) {
1166 free(ldaptcl->traplist);
1167 ldaptcl->traplist = NULL;
1168 }
1169 Tcl_GetStringFromObj(objv[2], &l);
1170 if (l == 0)
1171 return TCL_OK; /* just turn off trap */
1172 ldaptcl->trapCmdObj = objv[2];
1173 Tcl_IncrRefCount (ldaptcl->trapCmdObj);
1174 if (objc < 4)
1175 return TCL_OK; /* no code list */
1176 if (Tcl_ListObjLength(interp, objv[3], &l) != TCL_OK)
1177 return TCL_ERROR;
1178 if (l == 0)
1179 return TCL_OK; /* empty code list */
1180 ldaptcl->traplist = (int*)malloc(sizeof(int) * (l + 1));
1181 ldaptcl->traplist[l] = 0;
1182 for (i = 0; i < l; i++) {
1183 Tcl_ListObjIndex(interp, objv[3], i, &resultObj);
1184 code = LDAP_ErrorStringToCode(interp, Tcl_GetStringFromObj(resultObj, NULL));
1185 if (code == -1) {
1186 free(ldaptcl->traplist);
1187 ldaptcl->traplist = NULL;
1188 return TCL_ERROR;
1189 }
1190 ldaptcl->traplist[i] = code;
1191 }
1192 return TCL_OK;
1193 }
1194 if (STREQU (subCommand, "trapcodes")) {
1195 int code;
1196 Tcl_Obj *resultObj;
1197 Tcl_Obj *stringObj;
1198 resultObj = Tcl_GetObjResult(interp);
1199
1200 for (code = 0; code < LDAPTCL_MAXERR; code++) {
1201 if (!ldaptclerrorcode[code]) continue;
1202 Tcl_ListObjAppendElement(interp, resultObj,
1203 Tcl_NewStringObj(ldaptclerrorcode[code], -1));
1204 }
1205 return TCL_OK;
1206 }
1207 #ifdef LDAP_DEBUG
1208 if (STREQU (subCommand, "debug")) {
1209 if (objc != 3) {
1210 Tcl_AppendStringsToObj(resultObj, "Wrong # of arguments",
1211 (char*)NULL);
1212 return TCL_ERROR;
1213 }
1214 return Tcl_GetIntFromObj(interp, objv[2], &ldap_debug);
1215 }
1216 #endif
1217
1218 /* FIX: this needs to enumerate all the possibilities */
1219 Tcl_AppendStringsToObj (resultObj,
1220 "subcommand \"",
1221 subCommand,
1222 "\" must be one of \"add\", ",
1223 "\"add_attributes\", ",
1224 "\"bind\", \"cache\", \"delete\", ",
1225 "\"delete_attributes\", \"modify\", ",
1226 "\"modify_rdn\", \"rename_rdn\", ",
1227 "\"replace_attributes\", ",
1228 "\"search\" or \"unbind\".",
1229 (char *)NULL);
1230 return TCL_ERROR;
1231 }
1232
1233 /*
1234 * Delete and LDAP command object
1235 *
1236 */
1237 static void
NeoX_LdapObjDeleteCmd(clientData)1238 NeoX_LdapObjDeleteCmd(clientData)
1239 ClientData clientData;
1240 {
1241 LDAPTCL *ldaptcl = (LDAPTCL *)clientData;
1242 LDAP *ldap = ldaptcl->ldap;
1243
1244 if (ldaptcl->trapCmdObj)
1245 Tcl_DecrRefCount (ldaptcl->trapCmdObj);
1246 if (ldaptcl->traplist)
1247 free(ldaptcl->traplist);
1248 ldap_unbind(ldap);
1249 free((char*) ldaptcl);
1250 }
1251
1252 /*-----------------------------------------------------------------------------
1253 * NeoX_LdapObjCmd --
1254 *
1255 * Implements the `ldap' command:
1256 * ldap open newObjName host [port]
1257 * ldap init newObjName host [port]
1258 *
1259 * Results:
1260 * A standard Tcl result.
1261 *
1262 * Side effects:
1263 * See the user documentation.
1264 *-----------------------------------------------------------------------------
1265 */
1266 static int
NeoX_LdapObjCmd(clientData,interp,objc,objv)1267 NeoX_LdapObjCmd (clientData, interp, objc, objv)
1268 ClientData clientData;
1269 Tcl_Interp *interp;
1270 int objc;
1271 Tcl_Obj *CONST objv[];
1272 {
1273 extern int errno;
1274 char *subCommand;
1275 char *newCommand;
1276 char *ldapHost;
1277 int ldapPort = LDAP_PORT;
1278 LDAP *ldap;
1279 LDAPTCL *ldaptcl;
1280
1281 Tcl_Obj *resultObj = Tcl_GetObjResult (interp);
1282
1283 if (objc < 3) {
1284 Tcl_WrongNumArgs (interp, 1, objv,
1285 "(open|init) new_command host [port]|explode dn");
1286 return TCL_ERROR;
1287 }
1288
1289 subCommand = Tcl_GetStringFromObj (objv[1], NULL);
1290
1291 if (STREQU(subCommand, "explode")) {
1292 char *param;
1293 int nonames = 0;
1294 int list = 0;
1295 char **exploded, **p;
1296
1297 param = Tcl_GetStringFromObj (objv[2], NULL);
1298 if (param[0] == '-') {
1299 if (STREQU(param, "-nonames")) {
1300 nonames = 1;
1301 } else if (STREQU(param, "-list")) {
1302 list = 1;
1303 } else {
1304 Tcl_WrongNumArgs (interp, 1, objv, "explode ?-nonames|-list? dn");
1305 return TCL_ERROR;
1306 }
1307 }
1308 if (nonames || list)
1309 param = Tcl_GetStringFromObj (objv[3], NULL);
1310 exploded = ldap_explode_dn(param, nonames);
1311 for (p = exploded; *p; p++) {
1312 if (list) {
1313 char *q = strchr(*p, '=');
1314 if (!q) {
1315 Tcl_SetObjLength(resultObj, 0);
1316 Tcl_AppendStringsToObj(resultObj, "rdn ", *p,
1317 " missing '='", NULL);
1318 ldap_value_free(exploded);
1319 return TCL_ERROR;
1320 }
1321 *q = '\0';
1322 if (Tcl_ListObjAppendElement(interp, resultObj,
1323 Tcl_NewStringObj(*p, -1)) != TCL_OK ||
1324 Tcl_ListObjAppendElement(interp, resultObj,
1325 Tcl_NewStringObj(q+1, -1)) != TCL_OK) {
1326 ldap_value_free(exploded);
1327 return TCL_ERROR;
1328 }
1329 } else {
1330 if (Tcl_ListObjAppendElement(interp, resultObj,
1331 Tcl_NewStringObj(*p, -1))) {
1332 ldap_value_free(exploded);
1333 return TCL_ERROR;
1334 }
1335 }
1336 }
1337 ldap_value_free(exploded);
1338 return TCL_OK;
1339 }
1340
1341 #ifdef UMICH_LDAP
1342 if (STREQU(subCommand, "friendly")) {
1343 char *friendly = ldap_dn2ufn(Tcl_GetStringFromObj(objv[2], NULL));
1344 Tcl_SetStringObj(resultObj, friendly, -1);
1345 free(friendly);
1346 return TCL_OK;
1347 }
1348 #endif
1349
1350 newCommand = Tcl_GetStringFromObj (objv[2], NULL);
1351 ldapHost = Tcl_GetStringFromObj (objv[3], NULL);
1352
1353 if (objc == 5) {
1354 if (Tcl_GetIntFromObj (interp, objv [4], &ldapPort) == TCL_ERROR) {
1355 Tcl_AppendStringsToObj (resultObj,
1356 "LDAP port number is non-numeric",
1357 (char *)NULL);
1358 return TCL_ERROR;
1359 }
1360 }
1361
1362 if (STREQU (subCommand, "open")) {
1363 ldap = ldap_open (ldapHost, ldapPort);
1364 } else if (STREQU (subCommand, "init")) {
1365 int version = -1;
1366 int i;
1367 int value;
1368 char *subOption;
1369 char *subValue;
1370
1371 #if LDAPTCL_PROTOCOL_VERSION_DEFAULT
1372 version = LDAPTCL_PROTOCOL_VERSION_DEFAULT;
1373 #endif
1374
1375 for (i = 6; i < objc; i += 2) {
1376 subOption = Tcl_GetStringFromObj(objv[i-1], NULL);
1377 if (STREQU (subOption, "protocol_version")) {
1378 #ifdef LDAP_OPT_PROTOCOL_VERSION
1379 subValue = Tcl_GetStringFromObj(objv[i], NULL);
1380 if (STREQU (subValue, "2")) {
1381 version = LDAP_VERSION2;
1382 }
1383 else if (STREQU (subValue, "3")) {
1384 #ifdef LDAP_VERSION3
1385 version = LDAP_VERSION3;
1386 #else
1387 Tcl_SetStringObj (resultObj, "protocol_version 3 not supported", -1);
1388 return TCL_ERROR;
1389 #endif
1390 }
1391 else {
1392 Tcl_SetStringObj (resultObj, "protocol_version must be '2' or '3'", -1);
1393 return TCL_ERROR;
1394 }
1395 #else
1396 Tcl_SetStringObj (resultObj, "protocol_version not supported", -1);
1397 return TCL_ERROR;
1398 #endif
1399 } else if (STREQU (subOption, "port")) {
1400 if (Tcl_GetIntFromObj (interp, objv [i], &ldapPort) == TCL_ERROR) {
1401 Tcl_AppendStringsToObj (resultObj,
1402 "LDAP port number is non-numeric",
1403 (char *)NULL);
1404 return TCL_ERROR;
1405 }
1406 } else {
1407 Tcl_SetStringObj (resultObj, "valid options: protocol_version, port", -1);
1408 return TCL_ERROR;
1409 }
1410 }
1411 ldap = ldap_init (ldapHost, ldapPort);
1412
1413 #ifdef LDAP_OPT_PROTOCOL_VERSION
1414 if (version != -1)
1415 ldap_set_option(ldap, LDAP_OPT_PROTOCOL_VERSION, &version);
1416 #endif
1417 } else {
1418 Tcl_AppendStringsToObj (resultObj,
1419 "option was not \"open\" or \"init\"");
1420 return TCL_ERROR;
1421 }
1422
1423 if (ldap == (LDAP *)NULL) {
1424 Tcl_SetErrno(errno);
1425 Tcl_AppendStringsToObj (resultObj,
1426 Tcl_PosixError (interp),
1427 (char *)NULL);
1428 return TCL_ERROR;
1429 }
1430
1431 #ifdef UMICH_LDAP
1432 ldap->ld_deref = LDAP_DEREF_NEVER; /* Turn off alias dereferencing */
1433 #endif
1434
1435 ldaptcl = (LDAPTCL *) malloc(sizeof(LDAPTCL));
1436 ldaptcl->ldap = ldap;
1437 ldaptcl->caching = 0;
1438 ldaptcl->timeout = 0;
1439 ldaptcl->maxmem = 0;
1440 ldaptcl->trapCmdObj = NULL;
1441 ldaptcl->traplist = NULL;
1442 ldaptcl->flags = 0;
1443
1444 Tcl_CreateObjCommand (interp,
1445 newCommand,
1446 NeoX_LdapTargetObjCmd,
1447 (ClientData) ldaptcl,
1448 NeoX_LdapObjDeleteCmd);
1449 return TCL_OK;
1450 }
1451
1452 /*-----------------------------------------------------------------------------
1453 * Neo_initLDAP --
1454 * Initialize the LDAP interface.
1455 *-----------------------------------------------------------------------------
1456 */
1457 int
Ldaptcl_Init(interp)1458 Ldaptcl_Init (interp)
1459 Tcl_Interp *interp;
1460 {
1461 Tcl_CreateObjCommand (interp,
1462 "ldap",
1463 NeoX_LdapObjCmd,
1464 (ClientData) NULL,
1465 (Tcl_CmdDeleteProc*) NULL);
1466 /*
1467 if (Neo_initLDAPX(interp) != TCL_OK)
1468 return TCL_ERROR;
1469 */
1470 Tcl_PkgProvide(interp, "Ldaptcl", VERSION);
1471 return TCL_OK;
1472 }
1473