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