428
+ − 1 /* LDAP client interface for XEmacs.
+ − 2 Copyright (C) 1998 Free Software Foundation, Inc.
2367
+ − 3 Copyright (C) 2004 Ben Wing.
+ − 4
428
+ − 5
+ − 6 This file is part of XEmacs.
+ − 7
+ − 8 XEmacs is free software; you can redistribute it and/or modify it
+ − 9 under the terms of the GNU General Public License as published by the
+ − 10 Free Software Foundation; either version 2, or (at your option) any
+ − 11 later version.
+ − 12
+ − 13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
+ − 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ − 15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+ − 16 for more details.
+ − 17
+ − 18 You should have received a copy of the GNU General Public License
+ − 19 along with XEmacs; see the file COPYING. If not, write to
+ − 20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ − 21 Boston, MA 02111-1307, USA. */
+ − 22
+ − 23 /* Synched up with: Not in FSF. */
+ − 24
996
+ − 25 /* Author: Oscar Figueiredo with lots of support from Hrvoje Niksic */
428
+ − 26
+ − 27 /* This file provides lisp primitives for access to an LDAP library
+ − 28 conforming to the API defined in RFC 1823.
+ − 29 It has been tested with:
+ − 30 - UMich LDAP 3.3 (http://www.umich.edu/~dirsvcs/ldap/)
996
+ − 31 - OpenLDAP 1.2 (http://www.openldap.org/)
+ − 32 - Netscape's LDAP SDK (http://developer.netscape.com/) */
+ − 33
428
+ − 34
996
+ − 35 #include <config.h>
+ − 36 #include "lisp.h"
+ − 37 #include "opaque.h"
+ − 38 #include "sysdep.h"
+ − 39 #include "buffer.h"
+ − 40 #include "process.h" /* for report_process_error */
1632
+ − 41 #ifdef HAVE_SHLIB
+ − 42 # include "emodules.h"
+ − 43 #endif
428
+ − 44
996
+ − 45 #include <errno.h>
428
+ − 46
+ − 47 #include "eldap.h"
996
+ − 48
+ − 49 static Fixnum ldap_default_port;
+ − 50 static Lisp_Object Vldap_default_base;
+ − 51
+ − 52 static Lisp_Object Qeldap;
428
+ − 53
996
+ − 54 /* Needed by the lrecord definition */
+ − 55 Lisp_Object Qldapp;
428
+ − 56
996
+ − 57 /* ldap-open plist keywords */
+ − 58 static Lisp_Object Qport, Qauth, Qbinddn, Qpasswd, Qderef, Qtimelimit, Qsizelimit;
428
+ − 59 /* Search scope limits */
+ − 60 static Lisp_Object Qbase, Qonelevel, Qsubtree;
+ − 61 /* Authentication methods */
996
+ − 62 static Lisp_Object Qkrbv41, Qkrbv42;
428
+ − 63 /* Deref policy */
+ − 64 static Lisp_Object Qnever, Qalways, Qfind;
996
+ − 65 /* Modification types (Qdelete is defined in general.c) */
+ − 66 static Lisp_Object Qadd, Qreplace;
428
+ − 67
996
+ − 68
+ − 69 /************************************************************************/
+ − 70 /* Utility Functions */
+ − 71 /************************************************************************/
+ − 72
2268
+ − 73 static DECLARE_DOESNT_RETURN (signal_ldap_error (LDAP *, LDAPMessage *, int));
+ − 74
+ − 75 static DOESNT_RETURN
2286
+ − 76 signal_ldap_error (LDAP *ld,
+ − 77 #if defined HAVE_LDAP_PARSE_RESULT || defined HAVE_LDAP_RESULT2ERROR
+ − 78 LDAPMessage *res,
+ − 79 #else
+ − 80 LDAPMessage *UNUSED (res),
+ − 81 #endif
+ − 82 int ldap_err)
996
+ − 83 {
+ − 84 if (ldap_err <= 0)
+ − 85 {
+ − 86 #if defined HAVE_LDAP_PARSE_RESULT
+ − 87 int err;
+ − 88 ldap_err = ldap_parse_result (ld, res,
+ − 89 &err,
+ − 90 NULL, NULL, NULL, NULL, 0);
+ − 91 if (ldap_err == LDAP_SUCCESS)
+ − 92 ldap_err = err;
+ − 93 #elif defined HAVE_LDAP_GET_LDERRNO
+ − 94 ldap_err = ldap_get_lderrno (ld, NULL, NULL);
+ − 95 #elif defined HAVE_LDAP_RESULT2ERROR
+ − 96 ldap_err = ldap_result2error (ld, res, 0);
+ − 97 #else
+ − 98 ldap_err = ld->ld_errno;
+ − 99 #endif
+ − 100 }
+ − 101 invalid_operation ("LDAP error",
2367
+ − 102 build_ext_string (ldap_err2string (ldap_err), Qnative));
996
+ − 103 }
+ − 104
+ − 105
+ − 106 /************************************************************************/
+ − 107 /* ldap lrecord basic functions */
+ − 108 /************************************************************************/
+ − 109
+ − 110 static Lisp_Object
+ − 111 make_ldap (Lisp_LDAP *ldap)
+ − 112 {
+ − 113 return wrap_ldap (ldap);
+ − 114 }
+ − 115
1220
+ − 116 static const struct memory_description ldap_description [] = {
996
+ − 117 { XD_LISP_OBJECT, offsetof (struct Lisp_LDAP, host) },
+ − 118 { XD_END }
+ − 119 };
+ − 120
+ − 121 static Lisp_Object
+ − 122 mark_ldap (Lisp_Object obj)
+ − 123 {
+ − 124 return XLDAP (obj)->host;
+ − 125 }
+ − 126
+ − 127 static void
2286
+ − 128 print_ldap (Lisp_Object obj, Lisp_Object printcharfun, int UNUSED (escapeflag))
996
+ − 129 {
+ − 130 Lisp_LDAP *ldap = XLDAP (obj);
+ − 131
+ − 132 if (print_readably)
+ − 133 printing_unreadable_object ("#<ldap %s>", XSTRING_DATA (ldap->host));
+ − 134
+ − 135 write_fmt_string_lisp (printcharfun, "#<ldap %S", 1, ldap->host);
+ − 136 if (!ldap->ld)
+ − 137 write_c_string (printcharfun,"(dead) ");
+ − 138 write_fmt_string (printcharfun, " 0x%lx>", (long)ldap);
+ − 139 }
+ − 140
+ − 141 static Lisp_LDAP *
+ − 142 allocate_ldap (void)
+ − 143 {
+ − 144 Lisp_LDAP *ldap = alloc_lcrecord_type (Lisp_LDAP, &lrecord_ldap);
+ − 145
+ − 146 ldap->ld = NULL;
+ − 147 ldap->host = Qnil;
+ − 148 return ldap;
+ − 149 }
+ − 150
+ − 151 static void
+ − 152 finalize_ldap (void *header, int for_disksave)
+ − 153 {
+ − 154 Lisp_LDAP *ldap = (Lisp_LDAP *) header;
+ − 155
+ − 156 if (for_disksave)
+ − 157 invalid_operation ("Can't dump an emacs containing LDAP objects",
+ − 158 make_ldap (ldap));
+ − 159
+ − 160 if (ldap->ld)
+ − 161 ldap_unbind (ldap->ld);
+ − 162 ldap->ld = NULL;
+ − 163 }
+ − 164
1220
+ − 165 DEFINE_LRECORD_IMPLEMENTATION ("ldap", ldap, 0,
996
+ − 166 mark_ldap, print_ldap, finalize_ldap,
+ − 167 NULL, NULL, ldap_description, Lisp_LDAP);
+ − 168
+ − 169
+ − 170 /************************************************************************/
+ − 171 /* Basic ldap accessors */
+ − 172 /************************************************************************/
+ − 173
+ − 174 /* ###autoload */
+ − 175 DEFUN ("ldapp", Fldapp, 1, 1, 0, /*
+ − 176 Return t if OBJECT is a LDAP connection.
+ − 177 */
+ − 178 (object))
+ − 179 {
+ − 180 return LDAPP (object) ? Qt : Qnil;
+ − 181 }
+ − 182
+ − 183 DEFUN ("ldap-host", Fldap_host, 1, 1, 0, /*
+ − 184 Return the server host of the connection LDAP, as a string.
+ − 185 */
+ − 186 (ldap))
+ − 187 {
+ − 188 CHECK_LDAP (ldap);
+ − 189 return (XLDAP (ldap))->host;
+ − 190 }
+ − 191
+ − 192 DEFUN ("ldap-live-p", Fldap_live_p, 1, 1, 0, /*
+ − 193 Return t if LDAP is an active LDAP connection.
+ − 194 */
+ − 195 (ldap))
+ − 196 {
+ − 197 CHECK_LDAP (ldap);
+ − 198 return (XLDAP (ldap))->ld ? Qt : Qnil;
+ − 199 }
+ − 200
+ − 201 /************************************************************************/
+ − 202 /* Opening/Closing a LDAP connection */
+ − 203 /************************************************************************/
+ − 204
+ − 205
+ − 206 /* ###autoload */
+ − 207 DEFUN ("ldap-open", Fldap_open, 1, 2, 0, /*
+ − 208 Open a LDAP connection to HOST.
+ − 209 PLIST is a plist containing additional parameters for the connection.
428
+ − 210 Valid keys in that list are:
996
+ − 211 `port' the TCP port to use for the connection if different from
+ − 212 `ldap-default-port'.
428
+ − 213 `auth' is the authentication method to use, possible values depend on
+ − 214 the LDAP library XEmacs was compiled with: `simple', `krbv41' and `krbv42'.
+ − 215 `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax).
+ − 216 `passwd' is the password to use for simple authentication.
+ − 217 `deref' is one of the symbols `never', `always', `search' or `find'.
+ − 218 `timelimit' is the timeout limit for the connection in seconds.
+ − 219 `sizelimit' is the maximum number of matches to return.
+ − 220 */
996
+ − 221 (host, plist))
428
+ − 222 {
996
+ − 223 /* This function can GC */
+ − 224 Lisp_LDAP *ldap;
428
+ − 225 LDAP *ld;
996
+ − 226 int ldap_port = 0;
428
+ − 227 int ldap_auth = LDAP_AUTH_SIMPLE;
2367
+ − 228 Extbyte *ldap_binddn = NULL;
+ − 229 Extbyte *ldap_password = NULL;
428
+ − 230 int ldap_deref = LDAP_DEREF_NEVER;
+ − 231 int ldap_timelimit = 0;
+ − 232 int ldap_sizelimit = 0;
996
+ − 233 int err;
428
+ − 234
996
+ − 235 CHECK_STRING (host);
428
+ − 236
996
+ − 237 {
+ − 238 EXTERNAL_PROPERTY_LIST_LOOP_3 (keyword, value, plist)
+ − 239 {
+ − 240 /* TCP Port */
+ − 241 if (EQ (keyword, Qport))
+ − 242 {
+ − 243 CHECK_INT (value);
+ − 244 ldap_port = XINT (value);
+ − 245 }
+ − 246 /* Authentication method */
+ − 247 if (EQ (keyword, Qauth))
+ − 248 {
+ − 249 if (EQ (value, Qsimple))
+ − 250 ldap_auth = LDAP_AUTH_SIMPLE;
428
+ − 251 #ifdef LDAP_AUTH_KRBV41
996
+ − 252 else if (EQ (value, Qkrbv41))
+ − 253 ldap_auth = LDAP_AUTH_KRBV41;
428
+ − 254 #endif
+ − 255 #ifdef LDAP_AUTH_KRBV42
996
+ − 256 else if (EQ (value, Qkrbv42))
+ − 257 ldap_auth = LDAP_AUTH_KRBV42;
428
+ − 258 #endif
996
+ − 259 else
+ − 260 invalid_constant ("Invalid authentication method", value);
+ − 261 }
+ − 262 /* Bind DN */
+ − 263 else if (EQ (keyword, Qbinddn))
+ − 264 {
+ − 265 CHECK_STRING (value);
+ − 266 LISP_STRING_TO_EXTERNAL (value, ldap_binddn, Qnative);
+ − 267 }
+ − 268 /* Password */
+ − 269 else if (EQ (keyword, Qpasswd))
+ − 270 {
+ − 271 CHECK_STRING (value);
2272
+ − 272 LISP_STRING_TO_EXTERNAL (value, ldap_password, Qnative);
996
+ − 273 }
+ − 274 /* Deref */
+ − 275 else if (EQ (keyword, Qderef))
+ − 276 {
+ − 277 if (EQ (value, Qnever))
+ − 278 ldap_deref = LDAP_DEREF_NEVER;
+ − 279 else if (EQ (value, Qsearch))
+ − 280 ldap_deref = LDAP_DEREF_SEARCHING;
+ − 281 else if (EQ (value, Qfind))
+ − 282 ldap_deref = LDAP_DEREF_FINDING;
+ − 283 else if (EQ (value, Qalways))
+ − 284 ldap_deref = LDAP_DEREF_ALWAYS;
+ − 285 else
+ − 286 invalid_constant ("Invalid deref value", value);
+ − 287 }
+ − 288 /* Timelimit */
+ − 289 else if (EQ (keyword, Qtimelimit))
+ − 290 {
+ − 291 CHECK_INT (value);
+ − 292 ldap_timelimit = XINT (value);
+ − 293 }
+ − 294 /* Sizelimit */
+ − 295 else if (EQ (keyword, Qsizelimit))
+ − 296 {
+ − 297 CHECK_INT (value);
+ − 298 ldap_sizelimit = XINT (value);
+ − 299 }
+ − 300 }
+ − 301 }
+ − 302
+ − 303 if (ldap_port == 0)
+ − 304 {
+ − 305 ldap_port = ldap_default_port;
428
+ − 306 }
+ − 307
996
+ − 308 /* Connect to the server and bind */
+ − 309 slow_down_interrupts ();
2367
+ − 310 ld = ldap_open (NEW_LISP_STRING_TO_EXTERNAL (host, Qnative), ldap_port);
996
+ − 311 speed_up_interrupts ();
428
+ − 312
996
+ − 313 if (ld == NULL )
+ − 314 report_process_error ("Failed connecting to host", host);
428
+ − 315
996
+ − 316 #ifdef HAVE_LDAP_SET_OPTION
+ − 317 if ((err = ldap_set_option (ld, LDAP_OPT_DEREF,
+ − 318 (void *)&ldap_deref)) != LDAP_SUCCESS)
+ − 319 signal_ldap_error (ld, NULL, err);
+ − 320 if ((err = ldap_set_option (ld, LDAP_OPT_TIMELIMIT,
+ − 321 (void *)&ldap_timelimit)) != LDAP_SUCCESS)
+ − 322 signal_ldap_error (ld, NULL, err);
+ − 323 if ((err = ldap_set_option (ld, LDAP_OPT_SIZELIMIT,
+ − 324 (void *)&ldap_sizelimit)) != LDAP_SUCCESS)
+ − 325 signal_ldap_error (ld, NULL, err);
+ − 326 if ((err = ldap_set_option (ld, LDAP_OPT_REFERRALS,
+ − 327 LDAP_OPT_ON)) != LDAP_SUCCESS)
+ − 328 signal_ldap_error (ld, NULL, err);
+ − 329 if ((err = ldap_set_option (ld, LDAP_OPT_RESTART,
+ − 330 LDAP_OPT_ON)) != LDAP_SUCCESS)
+ − 331 signal_ldap_error (ld, NULL, err);
+ − 332 #else /* not HAVE_LDAP_SET_OPTION */
428
+ − 333 ld->ld_deref = ldap_deref;
+ − 334 ld->ld_timelimit = ldap_timelimit;
+ − 335 ld->ld_sizelimit = ldap_sizelimit;
+ − 336 #ifdef LDAP_REFERRALS
+ − 337 ld->ld_options = LDAP_OPT_REFERRALS;
996
+ − 338 #else /* not LDAP_REFERRALS */
428
+ − 339 ld->ld_options = 0;
996
+ − 340 #endif /* not LDAP_REFERRALS */
+ − 341 /* XEmacs uses interrupts (SIGIO,SIGALRM), LDAP calls need to ignore them */
+ − 342 ld->ld_options |= LDAP_OPT_RESTART;
+ − 343 #endif /* not HAVE_LDAP_SET_OPTION */
+ − 344
2272
+ − 345 err = ldap_bind_s (ld, ldap_binddn, ldap_password, ldap_auth);
996
+ − 346 if (err != LDAP_SUCCESS)
+ − 347 {
+ − 348 signal_error (Qprocess_error, "Failed binding to the server",
2367
+ − 349 build_ext_string (ldap_err2string (err), Qnative));
996
+ − 350 }
+ − 351
+ − 352 ldap = allocate_ldap ();
+ − 353 ldap->ld = ld;
+ − 354 ldap->host = host;
+ − 355
+ − 356 return make_ldap (ldap);
+ − 357 }
+ − 358
+ − 359
+ − 360
+ − 361 DEFUN ("ldap-close", Fldap_close, 1, 1, 0, /*
+ − 362 Close an LDAP connection.
+ − 363 */
+ − 364 (ldap))
+ − 365 {
+ − 366 Lisp_LDAP *lldap;
+ − 367 CHECK_LIVE_LDAP (ldap);
+ − 368 lldap = XLDAP (ldap);
+ − 369 ldap_unbind (lldap->ld);
+ − 370 lldap->ld = NULL;
+ − 371 return Qnil;
+ − 372 }
+ − 373
+ − 374
+ − 375
+ − 376 /************************************************************************/
+ − 377 /* Working on a LDAP connection */
+ − 378 /************************************************************************/
+ − 379 struct ldap_unwind_struct
+ − 380 {
+ − 381 LDAPMessage *res;
+ − 382 struct berval **vals;
+ − 383 };
+ − 384
+ − 385 static Lisp_Object
+ − 386 ldap_search_unwind (Lisp_Object unwind_obj)
+ − 387 {
+ − 388 struct ldap_unwind_struct *unwind =
+ − 389 (struct ldap_unwind_struct *) get_opaque_ptr (unwind_obj);
+ − 390 if (unwind->res)
+ − 391 ldap_msgfree (unwind->res);
+ − 392 if (unwind->vals)
+ − 393 ldap_value_free_len (unwind->vals);
+ − 394 return Qnil;
+ − 395 }
+ − 396
+ − 397 /* The following function is called `ldap-search-basic' instead of */
+ − 398 /* plain `ldap-search' to maintain compatibility with the XEmacs 21.1 */
+ − 399 /* API where `ldap-search' was the name of the high-level search */
+ − 400 /* function */
428
+ − 401
996
+ − 402 DEFUN ("ldap-search-basic", Fldap_search_basic, 2, 8, 0, /*
+ − 403 Perform a search on an open LDAP connection.
+ − 404 LDAP is an LDAP connection object created with `ldap-open'.
+ − 405 FILTER is a filter string for the search as described in RFC 1558.
+ − 406 BASE is the distinguished name at which to start the search.
+ − 407 SCOPE is one of the symbols `base', `onelevel' or `subtree' indicating
+ − 408 the scope of the search.
+ − 409 ATTRS is a list of strings indicating which attributes to retrieve
+ − 410 for each matching entry. If nil return all available attributes.
+ − 411 If ATTRSONLY is non-nil then only the attributes are retrieved, not
+ − 412 the associated values.
+ − 413 If WITHDN is non-nil each entry in the result will be prepended with
+ − 414 its distinguished name DN.
+ − 415 If VERBOSE is non-nil progress messages will be echoed.
+ − 416 The function returns a list of matching entries. Each entry is itself
+ − 417 an alist of attribute/value pairs optionally preceded by the DN of the
+ − 418 entry according to the value of WITHDN.
+ − 419 */
+ − 420 (ldap, filter, base, scope, attrs, attrsonly, withdn, verbose))
+ − 421 {
+ − 422 /* This function can GC */
+ − 423
+ − 424 /* Vars for query */
+ − 425 LDAP *ld;
+ − 426 LDAPMessage *e;
+ − 427 BerElement *ptr;
2367
+ − 428 Extbyte *a, *dn;
996
+ − 429 int i, rc;
+ − 430 int matches;
+ − 431 struct ldap_unwind_struct unwind;
+ − 432
+ − 433 int ldap_scope = LDAP_SCOPE_SUBTREE;
2367
+ − 434 Extbyte **ldap_attributes = NULL;
996
+ − 435
+ − 436 int speccount = specpdl_depth ();
+ − 437
+ − 438 Lisp_Object list = Qnil;
+ − 439 Lisp_Object entry = Qnil;
+ − 440 Lisp_Object result = Qnil;
+ − 441 struct gcpro gcpro1, gcpro2, gcpro3;
+ − 442
+ − 443 GCPRO3 (list, entry, result);
+ − 444
+ − 445 unwind.res = NULL;
+ − 446 unwind.vals = NULL;
+ − 447
+ − 448 /* Do all the parameter checking */
+ − 449 CHECK_LIVE_LDAP (ldap);
+ − 450 ld = XLDAP (ldap)->ld;
+ − 451
+ − 452 /* Filter */
+ − 453 CHECK_STRING (filter);
+ − 454
+ − 455 /* Search base */
+ − 456 if (NILP (base))
+ − 457 {
+ − 458 base = Vldap_default_base;
+ − 459 }
+ − 460 if (!NILP (base))
+ − 461 {
+ − 462 CHECK_STRING (base);
+ − 463 }
+ − 464
+ − 465 /* Search scope */
+ − 466 if (!NILP (scope))
+ − 467 {
+ − 468 if (EQ (scope, Qbase))
+ − 469 ldap_scope = LDAP_SCOPE_BASE;
+ − 470 else if (EQ (scope, Qonelevel))
+ − 471 ldap_scope = LDAP_SCOPE_ONELEVEL;
+ − 472 else if (EQ (scope, Qsubtree))
+ − 473 ldap_scope = LDAP_SCOPE_SUBTREE;
+ − 474 else
+ − 475 invalid_constant ("Invalid scope", scope);
+ − 476 }
+ − 477
+ − 478 /* Attributes to search */
+ − 479 if (!NILP (attrs))
+ − 480 {
+ − 481 CHECK_CONS (attrs);
+ − 482 ldap_attributes = alloca_array (char *, 1 + XINT (Flength (attrs)));
+ − 483
+ − 484 i = 0;
2367
+ − 485 {
+ − 486 EXTERNAL_LIST_LOOP_2 (current, attrs)
+ − 487 {
+ − 488 CHECK_STRING (current);
+ − 489 LISP_STRING_TO_EXTERNAL (current, ldap_attributes[i], Qnative);
+ − 490 ++i;
+ − 491 }
+ − 492 }
996
+ − 493 ldap_attributes[i] = NULL;
+ − 494 }
+ − 495
+ − 496 /* Attributes only ? */
+ − 497 CHECK_SYMBOL (attrsonly);
428
+ − 498
+ − 499 /* Perform the search */
996
+ − 500 if (ldap_search (ld,
2367
+ − 501 NILP (base) ? "" :
+ − 502 NEW_LISP_STRING_TO_EXTERNAL (base, Qnative),
996
+ − 503 ldap_scope,
2367
+ − 504 NILP (filter) ? "" :
+ − 505 NEW_LISP_STRING_TO_EXTERNAL (filter, Qnative),
996
+ − 506 ldap_attributes,
+ − 507 NILP (attrsonly) ? 0 : 1)
+ − 508 == -1)
428
+ − 509 {
996
+ − 510 signal_ldap_error (ld, NULL, 0);
428
+ − 511 }
+ − 512
996
+ − 513 /* Ensure we don't exit without cleaning up */
+ − 514 record_unwind_protect (ldap_search_unwind,
+ − 515 make_opaque_ptr (&unwind));
+ − 516
428
+ − 517 /* Build the results list */
+ − 518 matches = 0;
+ − 519
996
+ − 520 rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &unwind.res);
+ − 521
+ − 522 while (rc == LDAP_RES_SEARCH_ENTRY)
428
+ − 523 {
996
+ − 524 QUIT;
428
+ − 525 matches ++;
996
+ − 526 e = ldap_first_entry (ld, unwind.res);
+ − 527 /* #### This call to message() is pretty fascist, because it
+ − 528 destroys the current echo area contents, even when invoked
+ − 529 from Lisp. It should use echo_area_message() instead, and
+ − 530 restore the old echo area contents later. */
+ − 531 if (! NILP (verbose))
+ − 532 message ("Parsing ldap results... %d", matches);
428
+ − 533 entry = Qnil;
996
+ − 534 /* Get the DN if required */
+ − 535 if (! NILP (withdn))
+ − 536 {
+ − 537 dn = ldap_get_dn (ld, e);
+ − 538 if (dn == NULL)
+ − 539 signal_ldap_error (ld, e, 0);
+ − 540 entry = Fcons (build_ext_string (dn, Qnative), Qnil);
+ − 541 }
2367
+ − 542 for (a = ldap_first_attribute (ld, e, &ptr);
428
+ − 543 a != NULL;
2367
+ − 544 a = ldap_next_attribute (ld, e, ptr))
428
+ − 545 {
996
+ − 546 list = Fcons (build_ext_string (a, Qnative), Qnil);
+ − 547 unwind.vals = ldap_get_values_len (ld, e, a);
+ − 548 if (unwind.vals != NULL)
428
+ − 549 {
996
+ − 550 for (i = 0; unwind.vals[i] != NULL; i++)
428
+ − 551 {
996
+ − 552 list = Fcons (make_ext_string ((Extbyte *) unwind.vals[i]->bv_val,
+ − 553 unwind.vals[i]->bv_len,
+ − 554 Qnative),
428
+ − 555 list);
+ − 556 }
+ − 557 }
+ − 558 entry = Fcons (Fnreverse (list),
+ − 559 entry);
996
+ − 560 ldap_value_free_len (unwind.vals);
+ − 561 unwind.vals = NULL;
428
+ − 562 }
+ − 563 result = Fcons (Fnreverse (entry),
+ − 564 result);
996
+ − 565 ldap_msgfree (unwind.res);
+ − 566 unwind.res = NULL;
428
+ − 567
996
+ − 568 rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &(unwind.res));
428
+ − 569 }
+ − 570
996
+ − 571 #if defined HAVE_LDAP_PARSE_RESULT
+ − 572 {
+ − 573 int rc2 = ldap_parse_result (ld, unwind.res,
+ − 574 &rc,
+ − 575 NULL, NULL, NULL, NULL, 0);
+ − 576 if (rc2 != LDAP_SUCCESS)
+ − 577 rc = rc2;
+ − 578 }
428
+ − 579 #else
996
+ − 580 if (rc == 0)
+ − 581 signal_ldap_error (ld, NULL, LDAP_TIMELIMIT_EXCEEDED);
+ − 582
+ − 583 if (rc == -1)
+ − 584 signal_ldap_error (ld, unwind.res, (unwind.res==NULL) ? ld->ld_errno : 0);
+ − 585
+ − 586 #if defined HAVE_LDAP_RESULT2ERROR
+ − 587 rc = ldap_result2error (ld, unwind.res, 0);
+ − 588 #endif
428
+ − 589 #endif
996
+ − 590
+ − 591 if (rc != LDAP_SUCCESS)
+ − 592 signal_ldap_error (ld, NULL, rc);
+ − 593
+ − 594 ldap_msgfree (unwind.res);
+ − 595 unwind.res = (LDAPMessage *)NULL;
+ − 596
+ − 597 /* #### See above for calling message(). */
+ − 598 if (! NILP (verbose))
+ − 599 message ("Parsing ldap results... done");
+ − 600
+ − 601 unbind_to (speccount);
+ − 602 UNGCPRO;
+ − 603 return Fnreverse (result);
+ − 604 }
+ − 605
+ − 606 DEFUN ("ldap-add", Fldap_add, 3, 3, 0, /*
+ − 607 Add an entry to an LDAP directory.
+ − 608 LDAP is an LDAP connection object created with `ldap-open'.
+ − 609 DN is the distinguished name of the entry to add.
+ − 610 ENTRY is an entry specification, i.e., a list of cons cells
+ − 611 containing attribute/value string pairs.
+ − 612 */
+ − 613 (ldap, dn, entry))
+ − 614 {
+ − 615 LDAP *ld;
+ − 616 LDAPMod *ldap_mods, **ldap_mods_ptrs;
+ − 617 struct berval *bervals;
+ − 618 int rc;
+ − 619 int i, j;
+ − 620 Elemcount len;
+ − 621
+ − 622 Lisp_Object current = Qnil;
+ − 623 Lisp_Object values = Qnil;
2367
+ − 624 struct gcpro gcpro1;
996
+ − 625
2367
+ − 626 GCPRO1 (values);
996
+ − 627
+ − 628 /* Do all the parameter checking */
+ − 629 CHECK_LIVE_LDAP (ldap);
+ − 630 ld = XLDAP (ldap)->ld;
+ − 631
+ − 632 /* Check the DN */
+ − 633 CHECK_STRING (dn);
+ − 634
+ − 635 /* Check the entry */
+ − 636 CHECK_CONS (entry);
+ − 637 if (NILP (entry))
+ − 638 invalid_operation ("Cannot add void entry", entry);
428
+ − 639
996
+ − 640 /* Build the ldap_mods array */
+ − 641 len = (Elemcount) XINT (Flength (entry));
+ − 642 ldap_mods = alloca_array (LDAPMod, len);
+ − 643 ldap_mods_ptrs = alloca_array (LDAPMod *, 1 + len);
+ − 644 i = 0;
2367
+ − 645
+ − 646 {
+ − 647 EXTERNAL_LIST_LOOP_2 (current, entry)
+ − 648 {
+ − 649 CHECK_CONS (current);
+ − 650 CHECK_STRING (XCAR (current));
+ − 651 ldap_mods_ptrs[i] = &(ldap_mods[i]);
+ − 652 LISP_STRING_TO_EXTERNAL (XCAR (current), ldap_mods[i].mod_type,
+ − 653 Qnative);
+ − 654 ldap_mods[i].mod_op = LDAP_MOD_ADD | LDAP_MOD_BVALUES;
+ − 655 values = XCDR (current);
+ − 656 if (CONSP (values))
+ − 657 {
+ − 658 len = (Elemcount) XINT (Flength (values));
+ − 659 bervals = alloca_array (struct berval, len);
+ − 660 ldap_mods[i].mod_vals.modv_bvals =
+ − 661 alloca_array (struct berval *, 1 + len);
+ − 662 j = 0;
+ − 663 {
+ − 664 EXTERNAL_LIST_LOOP_2 (cur2, values)
+ − 665 {
+ − 666 CHECK_STRING (cur2);
+ − 667 ldap_mods[i].mod_vals.modv_bvals[j] = &(bervals[j]);
+ − 668 TO_EXTERNAL_FORMAT (LISP_STRING, cur2,
+ − 669 ALLOCA, (bervals[j].bv_val,
+ − 670 bervals[j].bv_len),
+ − 671 Qnative);
+ − 672 j++;
+ − 673 }
+ − 674 }
+ − 675 ldap_mods[i].mod_vals.modv_bvals[j] = NULL;
+ − 676 }
+ − 677 else
+ − 678 {
+ − 679 CHECK_STRING (values);
+ − 680 bervals = alloca_array (struct berval, 1);
+ − 681 ldap_mods[i].mod_vals.modv_bvals = alloca_array (struct berval *,
+ − 682 2);
+ − 683 ldap_mods[i].mod_vals.modv_bvals[0] = &(bervals[0]);
+ − 684 TO_EXTERNAL_FORMAT (LISP_STRING, values,
+ − 685 ALLOCA, (bervals[0].bv_val,
+ − 686 bervals[0].bv_len),
+ − 687 Qnative);
+ − 688 ldap_mods[i].mod_vals.modv_bvals[1] = NULL;
+ − 689 }
+ − 690 i++;
+ − 691 }
+ − 692 }
996
+ − 693 ldap_mods_ptrs[i] = NULL;
2367
+ − 694 rc = ldap_add_s (ld, NEW_LISP_STRING_TO_EXTERNAL (dn, Qnative),
+ − 695 ldap_mods_ptrs);
996
+ − 696 if (rc != LDAP_SUCCESS)
+ − 697 signal_ldap_error (ld, NULL, rc);
428
+ − 698
+ − 699 UNGCPRO;
996
+ − 700 return Qnil;
+ − 701 }
+ − 702
+ − 703 DEFUN ("ldap-modify", Fldap_modify, 3, 3, 0, /*
+ − 704 Add an entry to an LDAP directory.
+ − 705 LDAP is an LDAP connection object created with `ldap-open'.
+ − 706 DN is the distinguished name of the entry to modify.
+ − 707 MODS is a list of modifications to apply.
+ − 708 A modification is a list of the form (MOD-OP ATTR VALUE1 VALUE2 ...)
+ − 709 MOD-OP and ATTR are mandatory, VALUEs are optional depending on MOD-OP.
+ − 710 MOD-OP is the type of modification, one of the symbols `add', `delete'
+ − 711 or `replace'. ATTR is the LDAP attribute type to modify.
+ − 712 */
+ − 713 (ldap, dn, mods))
+ − 714 {
+ − 715 LDAP *ld;
+ − 716 LDAPMod *ldap_mods, **ldap_mods_ptrs;
+ − 717 struct berval *bervals;
+ − 718 int i, j, rc;
+ − 719 Lisp_Object mod_op;
+ − 720 Elemcount len;
+ − 721
+ − 722 Lisp_Object values = Qnil;
+ − 723 struct gcpro gcpro1, gcpro2;
+ − 724
+ − 725 /* Do all the parameter checking */
+ − 726 CHECK_LIVE_LDAP (ldap);
+ − 727 ld = XLDAP (ldap)->ld;
+ − 728
+ − 729 /* Check the DN */
+ − 730 CHECK_STRING (dn);
+ − 731
+ − 732 /* Check the entry */
+ − 733 CHECK_CONS (mods);
+ − 734 if (NILP (mods))
+ − 735 return Qnil;
+ − 736
+ − 737 /* Build the ldap_mods array */
+ − 738 len = (Elemcount) XINT (Flength (mods));
+ − 739 ldap_mods = alloca_array (LDAPMod, len);
+ − 740 ldap_mods_ptrs = alloca_array (LDAPMod *, 1 + len);
+ − 741 i = 0;
+ − 742
2367
+ − 743 GCPRO1 (values);
+ − 744 {
+ − 745 EXTERNAL_LIST_LOOP_2 (current, mods)
+ − 746 {
+ − 747 CHECK_CONS (current);
+ − 748 CHECK_SYMBOL (XCAR (current));
+ − 749 mod_op = XCAR (current);
+ − 750 ldap_mods_ptrs[i] = &(ldap_mods[i]);
+ − 751 ldap_mods[i].mod_op = LDAP_MOD_BVALUES;
+ − 752 if (EQ (mod_op, Qadd))
+ − 753 ldap_mods[i].mod_op |= LDAP_MOD_ADD;
+ − 754 else if (EQ (mod_op, Qdelete))
+ − 755 ldap_mods[i].mod_op |= LDAP_MOD_DELETE;
+ − 756 else if (EQ (mod_op, Qreplace))
+ − 757 ldap_mods[i].mod_op |= LDAP_MOD_REPLACE;
+ − 758 else
+ − 759 invalid_constant ("Invalid LDAP modification type", mod_op);
+ − 760 current = XCDR (current);
+ − 761 CHECK_STRING (XCAR (current));
+ − 762 LISP_STRING_TO_EXTERNAL (XCAR (current), ldap_mods[i].mod_type,
+ − 763 Qnative);
+ − 764 values = XCDR (current);
+ − 765 len = (Elemcount) XINT (Flength (values));
+ − 766 bervals = alloca_array (struct berval, len);
+ − 767 ldap_mods[i].mod_vals.modv_bvals =
+ − 768 alloca_array (struct berval *, 1 + len);
+ − 769 j = 0;
2387
+ − 770 {
+ − 771 EXTERNAL_LIST_LOOP_2 (cur2, values)
+ − 772 {
+ − 773 CHECK_STRING (cur2);
+ − 774 ldap_mods[i].mod_vals.modv_bvals[j] = &(bervals[j]);
+ − 775 TO_EXTERNAL_FORMAT (LISP_STRING, cur2,
+ − 776 ALLOCA, (bervals[j].bv_val,
+ − 777 bervals[j].bv_len),
+ − 778 Qnative);
+ − 779 j++;
+ − 780 }
+ − 781 ldap_mods[i].mod_vals.modv_bvals[j] = NULL;
+ − 782 i++;
+ − 783 }
2367
+ − 784 }
+ − 785 }
996
+ − 786 ldap_mods_ptrs[i] = NULL;
2367
+ − 787 rc = ldap_modify_s (ld, NEW_LISP_STRING_TO_EXTERNAL (dn, Qnative),
+ − 788 ldap_mods_ptrs);
996
+ − 789 if (rc != LDAP_SUCCESS)
+ − 790 signal_ldap_error (ld, NULL, rc);
+ − 791
+ − 792 UNGCPRO;
+ − 793 return Qnil;
+ − 794 }
+ − 795
+ − 796
+ − 797 DEFUN ("ldap-delete", Fldap_delete, 2, 2, 0, /*
+ − 798 Delete an entry to an LDAP directory.
+ − 799 LDAP is an LDAP connection object created with `ldap-open'.
+ − 800 DN is the distinguished name of the entry to delete.
+ − 801 */
+ − 802 (ldap, dn))
+ − 803 {
+ − 804 LDAP *ld;
+ − 805 int rc;
+ − 806
+ − 807 /* Check parameters */
+ − 808 CHECK_LIVE_LDAP (ldap);
+ − 809 ld = XLDAP (ldap)->ld;
+ − 810 CHECK_STRING (dn);
+ − 811
2367
+ − 812 rc = ldap_delete_s (ld, NEW_LISP_STRING_TO_EXTERNAL (dn, Qnative));
996
+ − 813 if (rc != LDAP_SUCCESS)
+ − 814 signal_ldap_error (ld, NULL, rc);
+ − 815
+ − 816 return Qnil;
428
+ − 817 }
+ − 818
+ − 819 void
996
+ − 820 syms_of_eldap (void)
428
+ − 821 {
996
+ − 822 INIT_LRECORD_IMPLEMENTATION (ldap);
428
+ − 823
996
+ − 824 DEFSYMBOL (Qeldap);
+ − 825 DEFSYMBOL (Qldapp);
+ − 826 DEFSYMBOL (Qport);
+ − 827 DEFSYMBOL (Qauth);
+ − 828 DEFSYMBOL (Qbinddn);
+ − 829 DEFSYMBOL (Qpasswd);
+ − 830 DEFSYMBOL (Qderef);
+ − 831 DEFSYMBOL (Qtimelimit);
+ − 832 DEFSYMBOL (Qsizelimit);
+ − 833 DEFSYMBOL (Qbase);
+ − 834 DEFSYMBOL (Qonelevel);
+ − 835 DEFSYMBOL (Qsubtree);
+ − 836 DEFSYMBOL (Qkrbv41);
+ − 837 DEFSYMBOL (Qkrbv42);
+ − 838 DEFSYMBOL (Qnever);
+ − 839 DEFSYMBOL (Qalways);
+ − 840 DEFSYMBOL (Qfind);
+ − 841 DEFSYMBOL (Qadd);
+ − 842 DEFSYMBOL (Qreplace);
+ − 843
+ − 844 DEFSUBR (Fldapp);
+ − 845 DEFSUBR (Fldap_host);
+ − 846 DEFSUBR (Fldap_live_p);
+ − 847 DEFSUBR (Fldap_open);
+ − 848 DEFSUBR (Fldap_close);
+ − 849 DEFSUBR (Fldap_search_basic);
+ − 850 DEFSUBR (Fldap_add);
+ − 851 DEFSUBR (Fldap_modify);
+ − 852 DEFSUBR (Fldap_delete);
428
+ − 853 }
+ − 854
+ − 855 void
996
+ − 856 vars_of_eldap (void)
428
+ − 857 {
996
+ − 858
+ − 859 Fprovide (Qeldap);
428
+ − 860
996
+ − 861 ldap_default_port = LDAP_PORT;
+ − 862 Vldap_default_base = Qnil;
+ − 863
+ − 864 DEFVAR_INT ("ldap-default-port", &ldap_default_port /*
+ − 865 Default TCP port for LDAP connections.
+ − 866 Initialized from the LDAP library. Default value is 389.
428
+ − 867 */ );
+ − 868
+ − 869 DEFVAR_LISP ("ldap-default-base", &Vldap_default_base /*
+ − 870 Default base for LDAP searches.
+ − 871 This is a string using the syntax of RFC 1779.
+ − 872 For instance, "o=ACME, c=US" limits the search to the
+ − 873 Acme organization in the United States.
+ − 874 */ );
+ − 875
+ − 876 }
+ − 877
996
+ − 878 #ifdef HAVE_SHLIB
1706
+ − 879 EXTERN_C void unload_eldap (void);
996
+ − 880 void
+ − 881 unload_eldap (void)
+ − 882 {
+ − 883 /* Remove defined types */
+ − 884 UNDEF_LRECORD_IMPLEMENTATION (ldap);
+ − 885
+ − 886 /* Remove staticpro'ing of symbols */
+ − 887 unstaticpro_nodump (&Qeldap);
+ − 888 unstaticpro_nodump (&Qldapp);
+ − 889 unstaticpro_nodump (&Qport);
+ − 890 unstaticpro_nodump (&Qauth);
+ − 891 unstaticpro_nodump (&Qbinddn);
+ − 892 unstaticpro_nodump (&Qpasswd);
+ − 893 unstaticpro_nodump (&Qderef);
+ − 894 unstaticpro_nodump (&Qtimelimit);
+ − 895 unstaticpro_nodump (&Qsizelimit);
+ − 896 unstaticpro_nodump (&Qbase);
+ − 897 unstaticpro_nodump (&Qonelevel);
+ − 898 unstaticpro_nodump (&Qsubtree);
+ − 899 unstaticpro_nodump (&Qkrbv41);
+ − 900 unstaticpro_nodump (&Qkrbv42);
+ − 901 unstaticpro_nodump (&Qnever);
+ − 902 unstaticpro_nodump (&Qalways);
+ − 903 unstaticpro_nodump (&Qfind);
+ − 904 unstaticpro_nodump (&Qadd);
+ − 905 unstaticpro_nodump (&Qreplace);
+ − 906 }
+ − 907 #endif /* HAVE_SHLIB */