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 (at) 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 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 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 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 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 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 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 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 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
Indexes created Tue Jun 16 00:25:01 UTC 2026