Mercurial > hg > xemacs-beta

comparison src/eldap.c @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents 2f8bb876ab1d
children e804706bfb8c
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
24 24
25 /* This file provides lisp primitives for access to an LDAP library 25 /* This file provides lisp primitives for access to an LDAP library
26 conforming to the API defined in RFC 1823. 26 conforming to the API defined in RFC 1823.
27 It has been tested with: 27 It has been tested with:
28 - UMich LDAP 3.3 (http://www.umich.edu/~dirsvcs/ldap/) 28 - UMich LDAP 3.3 (http://www.umich.edu/~dirsvcs/ldap/)
29 - OpenLDAP 1.2 (http://www.openldap.org/) 29 - OpenLDAP 1.0.3 (http://www.openldap.org/)
30 - Netscape's LDAP SDK (http://developer.netscape.com/) */ 30 - Netscape's LDAP SDK 1.0 (http://developer.netscape.com/) */
31 31
32 32
33 #include <config.h> 33 #include <config.h>
34 #include "lisp.h" 34 #include "lisp.h"
35 #include "opaque.h" 35 #include "opaque.h"
38 38
39 #include <errno.h> 39 #include <errno.h>
40 40
41 #include "eldap.h" 41 #include "eldap.h"
42 42
43 #ifdef HAVE_NS_LDAP
44 # define HAVE_LDAP_SET_OPTION 1
45 # define HAVE_LDAP_GET_ERRNO 1
46 #else
47 # undef HAVE_LDAP_SET_OPTION
48 # undef HAVE_LDAP_GET_ERRNO
49 #endif
50
43 static int ldap_default_port; 51 static int ldap_default_port;
44 static Lisp_Object Vldap_default_base; 52 static Lisp_Object Vldap_default_base;
45 53
46 /* Needed by the lrecord definition */ 54 /* Needed by the lrecord definition */
47 Lisp_Object Qldapp; 55 Lisp_Object Qldapp;
48 56
49 /* ldap-open plist keywords */ 57 /* ldap-open plist keywords */
50 static Lisp_Object Qport, Qauth, Qbinddn, Qpasswd, Qderef, Qtimelimit, Qsizelimit; 58 extern Lisp_Object Qport, Qauth, Qbinddn, Qpasswd, Qderef, Qtimelimit,
59 Qsizelimit;
51 /* Search scope limits */ 60 /* Search scope limits */
52 static Lisp_Object Qbase, Qonelevel, Qsubtree; 61 extern Lisp_Object Qbase, Qonelevel, Qsubtree;
53 /* Authentication methods */ 62 /* Authentication methods */
54 static Lisp_Object Qkrbv41, Qkrbv42; 63 extern Lisp_Object Qkrbv41, Qkrbv42;
55 /* Deref policy */ 64 /* Deref policy */
56 static Lisp_Object Qnever, Qalways, Qfind; 65 extern Lisp_Object Qnever, Qalways, Qfind;
57 /* Modification types (Qdelete is defined in general.c) */
58 static Lisp_Object Qadd, Qreplace;
59
60 66
61 /************************************************************************/ 67 /************************************************************************/
62 /* Utility Functions */ 68 /* Utility Functions */
63 /************************************************************************/ 69 /************************************************************************/
64 70
65 static void 71 static void
66 signal_ldap_error (LDAP *ld, LDAPMessage *res, int ldap_err) 72 signal_ldap_error (LDAP *ld)
67 { 73 {
68 if (ldap_err <= 0) 74 #ifdef HAVE_LDAP_GET_ERRNO
69 { 75 signal_simple_error
70 #if defined HAVE_LDAP_PARSE_RESULT 76 ("LDAP error",
71 int err; 77 build_string (ldap_err2string (ldap_get_lderrno (ld, NULL, NULL))));
72 ldap_err = ldap_parse_result (ld, res,
73 &err,
74 NULL, NULL, NULL, NULL, 0);
75 if (ldap_err == LDAP_SUCCESS)
76 ldap_err = err;
77 #elif defined HAVE_LDAP_GET_LDERRNO
78 ldap_err = ldap_get_lderrno (ld, NULL, NULL);
79 #elif defined HAVE_LDAP_RESULT2ERROR
80 ldap_err = ldap_result2error (ld, res, 0);
81 #else 78 #else
82 ldap_err = ld->ld_errno; 79 signal_simple_error ("LDAP error",
80 build_string (ldap_err2string (ld->ld_errno)));
83 #endif 81 #endif
84 }
85 signal_simple_error ("LDAP error",
86 build_string (ldap_err2string (ldap_err)));
87 } 82 }
88 83
89 84
90 /************************************************************************/ 85 /************************************************************************/
91 /* ldap lrecord basic functions */ 86 /* ldap lrecord basic functions */
92 /************************************************************************/ 87 /************************************************************************/
93 88
94 static Lisp_Object 89 static Lisp_Object
95 make_ldap (Lisp_LDAP *ldap) 90 make_ldap (struct Lisp_LDAP *ldap)
96 { 91 {
97 Lisp_Object lisp_ldap; 92 Lisp_Object lisp_ldap;
98 XSETLDAP (lisp_ldap, ldap); 93 XSETLDAP (lisp_ldap, ldap);
99 return lisp_ldap; 94 return lisp_ldap;
100 } 95 }
101 96
102 static Lisp_Object 97 static Lisp_Object
103 mark_ldap (Lisp_Object obj) 98 mark_ldap (Lisp_Object obj, void (*markobj) (Lisp_Object))
104 { 99 {
105 return XLDAP (obj)->host; 100 return XLDAP (obj)->host;
106 } 101 }
107 102
108 static void 103 static void
109 print_ldap (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 104 print_ldap (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
110 { 105 {
111 char buf[32]; 106 char buf[32];
112 107
113 Lisp_LDAP *ldap = XLDAP (obj); 108 struct Lisp_LDAP *ldap = XLDAP (obj);
114 109
115 if (print_readably) 110 if (print_readably)
116 error ("printing unreadable object #<ldap %s>", 111 error ("printing unreadable object #<ldap %s>",
117 XSTRING_DATA (ldap->host)); 112 XSTRING_DATA (ldap->host));
118 113
119 write_c_string ("#<ldap ", printcharfun); 114 write_c_string ("#<ldap ", printcharfun);
120 print_internal (ldap->host, printcharfun, 1); 115 print_internal (ldap->host, printcharfun, 1);
121 if (!ldap->ld) 116 if (!ldap->livep)
122 write_c_string ("(dead) ",printcharfun); 117 write_c_string ("(dead) ",printcharfun);
123 sprintf (buf, " 0x%x>", (unsigned int)ldap); 118 sprintf (buf, " 0x%x>", (unsigned int)ldap);
124 write_c_string (buf, printcharfun); 119 write_c_string (buf, printcharfun);
125 } 120 }
126 121
127 static Lisp_LDAP * 122 static struct Lisp_LDAP *
128 allocate_ldap (void) 123 allocate_ldap (void)
129 { 124 {
130 Lisp_LDAP *ldap = alloc_lcrecord_type (Lisp_LDAP, &lrecord_ldap); 125 struct Lisp_LDAP *ldap =
126 alloc_lcrecord_type (struct Lisp_LDAP, &lrecord_ldap);
131 127
132 ldap->ld = NULL; 128 ldap->ld = NULL;
133 ldap->host = Qnil; 129 ldap->host = Qnil;
130 ldap->livep = 0;
134 return ldap; 131 return ldap;
135 } 132 }
136 133
137 static void 134 static void
138 finalize_ldap (void *header, int for_disksave) 135 finalize_ldap (void *header, int for_disksave)
139 { 136 {
140 Lisp_LDAP *ldap = (Lisp_LDAP *) header; 137 struct Lisp_LDAP *ldap = (struct Lisp_LDAP *) header;
141 138
142 if (for_disksave) 139 if (for_disksave)
143 signal_simple_error ("Can't dump an emacs containing LDAP objects", 140 signal_simple_error ("Can't dump an emacs containing LDAP objects",
144 make_ldap (ldap)); 141 make_ldap (ldap));
145 142
146 if (ldap->ld) 143 if (ldap->livep)
147 ldap_unbind (ldap->ld); 144 ldap_unbind (ldap->ld);
148 ldap->ld = NULL;
149 } 145 }
150 146
151 DEFINE_LRECORD_IMPLEMENTATION ("ldap", ldap, 147 DEFINE_LRECORD_IMPLEMENTATION ("ldap", ldap,
152 mark_ldap, print_ldap, finalize_ldap, 148 mark_ldap, print_ldap, finalize_ldap,
153 NULL, NULL, 0, Lisp_LDAP); 149 NULL, NULL, struct Lisp_LDAP);
154 150
155 151
156 152
157 153
158 /************************************************************************/ 154 /************************************************************************/
180 Return t if LDAP is an active LDAP connection. 176 Return t if LDAP is an active LDAP connection.
181 */ 177 */
182 (ldap)) 178 (ldap))
183 { 179 {
184 CHECK_LDAP (ldap); 180 CHECK_LDAP (ldap);
185 return (XLDAP (ldap))->ld ? Qt : Qnil; 181 return (XLDAP (ldap))->livep ? Qt : Qnil;
186 } 182 }
187 183
188 /************************************************************************/ 184 /************************************************************************/
189 /* Opening/Closing a LDAP connection */ 185 /* Opening/Closing a LDAP connection */
190 /************************************************************************/ 186 /************************************************************************/
205 `sizelimit' is the maximum number of matches to return. 201 `sizelimit' is the maximum number of matches to return.
206 */ 202 */
207 (host, plist)) 203 (host, plist))
208 { 204 {
209 /* This function can GC */ 205 /* This function can GC */
210 Lisp_LDAP *ldap; 206 struct Lisp_LDAP *ldap;
211 LDAP *ld; 207 LDAP *ld;
212 int ldap_port = 0; 208 int ldap_port = 0;
213 int ldap_auth = LDAP_AUTH_SIMPLE; 209 int ldap_auth = LDAP_AUTH_SIMPLE;
214 char *ldap_binddn = NULL; 210 char *ldap_binddn = NULL;
215 char *ldap_passwd = NULL; 211 char *ldap_passwd = NULL;
248 } 244 }
249 /* Bind DN */ 245 /* Bind DN */
250 else if (EQ (keyword, Qbinddn)) 246 else if (EQ (keyword, Qbinddn))
251 { 247 {
252 CHECK_STRING (value); 248 CHECK_STRING (value);
253 TO_EXTERNAL_FORMAT (LISP_STRING, value, 249 GET_C_STRING_OS_DATA_ALLOCA (value, ldap_binddn);
254 C_STRING_ALLOCA, ldap_binddn,
255 Qnative);
256 } 250 }
257 /* Password */ 251 /* Password */
258 else if (EQ (keyword, Qpasswd)) 252 else if (EQ (keyword, Qpasswd))
259 { 253 {
260 CHECK_STRING (value); 254 CHECK_STRING (value);
261 TO_EXTERNAL_FORMAT (LISP_STRING, value, 255 GET_C_STRING_OS_DATA_ALLOCA (value, ldap_passwd);
262 C_STRING_ALLOCA, ldap_passwd,
263 Qnative);
264 } 256 }
265 /* Deref */ 257 /* Deref */
266 else if (EQ (keyword, Qderef)) 258 else if (EQ (keyword, Qderef))
267 { 259 {
268 if (EQ (value, Qnever)) 260 if (EQ (value, Qnever))
305 host, 297 host,
306 lisp_strerror (errno)); 298 lisp_strerror (errno));
307 299
308 300
309 #ifdef HAVE_LDAP_SET_OPTION 301 #ifdef HAVE_LDAP_SET_OPTION
310 if ((err = ldap_set_option (ld, LDAP_OPT_DEREF, 302 if (ldap_set_option (ld, LDAP_OPT_DEREF, (void *)&ldap_deref) != LDAP_SUCCESS)
311 (void *)&ldap_deref)) != LDAP_SUCCESS) 303 signal_ldap_error (ld);
312 signal_ldap_error (ld, NULL, err); 304 if (ldap_set_option (ld, LDAP_OPT_TIMELIMIT,
313 if ((err = ldap_set_option (ld, LDAP_OPT_TIMELIMIT, 305 (void *)&ldap_timelimit) != LDAP_SUCCESS)
314 (void *)&ldap_timelimit)) != LDAP_SUCCESS) 306 signal_ldap_error (ld);
315 signal_ldap_error (ld, NULL, err); 307 if (ldap_set_option (ld, LDAP_OPT_SIZELIMIT,
316 if ((err = ldap_set_option (ld, LDAP_OPT_SIZELIMIT, 308 (void *)&ldap_sizelimit) != LDAP_SUCCESS)
317 (void *)&ldap_sizelimit)) != LDAP_SUCCESS) 309 signal_ldap_error (ld);
318 signal_ldap_error (ld, NULL, err); 310 if (ldap_set_option (ld, LDAP_OPT_REFERRALS, LDAP_OPT_ON) != LDAP_SUCCESS)
319 if ((err = ldap_set_option (ld, LDAP_OPT_REFERRALS, 311 signal_ldap_error (ld);
320 LDAP_OPT_ON)) != LDAP_SUCCESS)
321 signal_ldap_error (ld, NULL, err);
322 if ((err = ldap_set_option (ld, LDAP_OPT_RESTART,
323 LDAP_OPT_ON)) != LDAP_SUCCESS)
324 signal_ldap_error (ld, NULL, err);
325 #else /* not HAVE_LDAP_SET_OPTION */ 312 #else /* not HAVE_LDAP_SET_OPTION */
326 ld->ld_deref = ldap_deref; 313 ld->ld_deref = ldap_deref;
327 ld->ld_timelimit = ldap_timelimit; 314 ld->ld_timelimit = ldap_timelimit;
328 ld->ld_sizelimit = ldap_sizelimit; 315 ld->ld_sizelimit = ldap_sizelimit;
329 #ifdef LDAP_REFERRALS 316 #ifdef LDAP_REFERRALS
330 ld->ld_options = LDAP_OPT_REFERRALS; 317 ld->ld_options = LDAP_OPT_REFERRALS;
331 #else /* not LDAP_REFERRALS */ 318 #else /* not LDAP_REFERRALS */
332 ld->ld_options = 0; 319 ld->ld_options = 0;
333 #endif /* not LDAP_REFERRALS */ 320 #endif /* not LDAP_REFERRALS */
334 /* XEmacs uses interrupts (SIGIO,SIGALRM), LDAP calls need to ignore them */
335 ld->ld_options |= LDAP_OPT_RESTART;
336 #endif /* not HAVE_LDAP_SET_OPTION */ 321 #endif /* not HAVE_LDAP_SET_OPTION */
337 322
323 /* ldap_bind_s calls select and may be wedged by SIGIO. */
324 slow_down_interrupts ();
338 err = ldap_bind_s (ld, ldap_binddn, ldap_passwd, ldap_auth); 325 err = ldap_bind_s (ld, ldap_binddn, ldap_passwd, ldap_auth);
326 speed_up_interrupts ();
339 if (err != LDAP_SUCCESS) 327 if (err != LDAP_SUCCESS)
340 signal_simple_error ("Failed binding to the server", 328 signal_simple_error ("Failed binding to the server",
341 build_string (ldap_err2string (err))); 329 build_string (ldap_err2string (err)));
342 330
343 ldap = allocate_ldap (); 331 ldap = allocate_ldap ();
344 ldap->ld = ld; 332 ldap->ld = ld;
345 ldap->host = host; 333 ldap->host = host;
334 ldap->livep = 1;
346 335
347 return make_ldap (ldap); 336 return make_ldap (ldap);
348 } 337 }
349 338
350 339
352 DEFUN ("ldap-close", Fldap_close, 1, 1, 0, /* 341 DEFUN ("ldap-close", Fldap_close, 1, 1, 0, /*
353 Close an LDAP connection. 342 Close an LDAP connection.
354 */ 343 */
355 (ldap)) 344 (ldap))
356 { 345 {
357 Lisp_LDAP *lldap; 346 struct Lisp_LDAP *lldap;
358 CHECK_LIVE_LDAP (ldap); 347 CHECK_LIVE_LDAP (ldap);
359 lldap = XLDAP (ldap); 348 lldap = XLDAP (ldap);
360 ldap_unbind (lldap->ld); 349 ldap_unbind (lldap->ld);
361 lldap->ld = NULL; 350 lldap->livep = 0;
362 return Qnil; 351 return Qnil;
363 } 352 }
364 353
365 354
366 355
370 struct ldap_unwind_struct 359 struct ldap_unwind_struct
371 { 360 {
372 LDAPMessage *res; 361 LDAPMessage *res;
373 struct berval **vals; 362 struct berval **vals;
374 }; 363 };
364
375 365
376 static Lisp_Object 366 static Lisp_Object
377 ldap_search_unwind (Lisp_Object unwind_obj) 367 ldap_search_unwind (Lisp_Object unwind_obj)
378 { 368 {
379 struct ldap_unwind_struct *unwind = 369 struct ldap_unwind_struct *unwind =
383 if (unwind->vals) 373 if (unwind->vals)
384 ldap_value_free_len (unwind->vals); 374 ldap_value_free_len (unwind->vals);
385 return Qnil; 375 return Qnil;
386 } 376 }
387 377
388 /* The following function is called `ldap-search-basic' instead of */ 378 DEFUN ("ldap-search-internal", Fldap_search_internal, 2, 7, 0, /*
389 /* plain `ldap-search' to maintain compatibility with the XEmacs 21.1 */
390 /* API where `ldap-search' was the name of the high-level search */
391 /* function */
392
393 DEFUN ("ldap-search-basic", Fldap_search_basic, 2, 8, 0, /*
394 Perform a search on an open LDAP connection. 379 Perform a search on an open LDAP connection.
395 LDAP is an LDAP connection object created with `ldap-open'. 380 LDAP is an LDAP connection object created with `ldap-open'.
396 FILTER is a filter string for the search as described in RFC 1558. 381 FILTER is a filter string for the search as described in RFC 1558.
397 BASE is the distinguished name at which to start the search. 382 BASE is the distinguished name at which to start the search.
398 SCOPE is one of the symbols `base', `onelevel' or `subtree' indicating 383 SCOPE is one of the symbols `base', `onelevel' or `subtree' indicating
399 the scope of the search. 384 the scope of the search.
400 ATTRS is a list of strings indicating which attributes to retrieve 385 ATTRS is a list of strings indicating which attributes to retrieve
401 for each matching entry. If nil return all available attributes. 386 for each matching entry. If nil return all available attributes.
402 If ATTRSONLY is non-nil then only the attributes are retrieved, not 387 If ATTRSONLY is non-nil then only the attributes are retrieved, not
403 the associated values. 388 the associated values.
404 If WITHDN is non-nil each entry in the result will be prepended with 389 If WITHDN is non-nil each entry in the result will be prepennded with
405 its distinguished name DN. 390 its distinguished name DN.
406 If VERBOSE is non-nil progress messages will be echoed.
407 The function returns a list of matching entries. Each entry is itself 391 The function returns a list of matching entries. Each entry is itself
408 an alist of attribute/value pairs optionally preceded by the DN of the 392 an alist of attribute/value pairs optionally preceded by the DN of the
409 entry according to the value of WITHDN. 393 entry according to the value of WITHDN.
410 */ 394 */
411 (ldap, filter, base, scope, attrs, attrsonly, withdn, verbose)) 395 (ldap, filter, base, scope, attrs, attrsonly, withdn))
412 { 396 {
413 /* This function can GC */ 397 /* This function can GC */
414 398
415 /* Vars for query */ 399 /* Vars for query */
416 LDAP *ld; 400 LDAP *ld;
424 int ldap_scope = LDAP_SCOPE_SUBTREE; 408 int ldap_scope = LDAP_SCOPE_SUBTREE;
425 char **ldap_attributes = NULL; 409 char **ldap_attributes = NULL;
426 410
427 int speccount = specpdl_depth (); 411 int speccount = specpdl_depth ();
428 412
429 Lisp_Object list = Qnil; 413 Lisp_Object list, entry, result;
430 Lisp_Object entry = Qnil;
431 Lisp_Object result = Qnil;
432 struct gcpro gcpro1, gcpro2, gcpro3; 414 struct gcpro gcpro1, gcpro2, gcpro3;
433 415
416 list = entry = result = Qnil;
434 GCPRO3 (list, entry, result); 417 GCPRO3 (list, entry, result);
435 418
436 unwind.res = NULL; 419 unwind.res = NULL;
437 unwind.vals = NULL; 420 unwind.vals = NULL;
438 421
475 i = 0; 458 i = 0;
476 EXTERNAL_LIST_LOOP (attrs, attrs) 459 EXTERNAL_LIST_LOOP (attrs, attrs)
477 { 460 {
478 Lisp_Object current = XCAR (attrs); 461 Lisp_Object current = XCAR (attrs);
479 CHECK_STRING (current); 462 CHECK_STRING (current);
480 TO_EXTERNAL_FORMAT (LISP_STRING, current, 463 GET_C_STRING_OS_DATA_ALLOCA (current, ldap_attributes[i]);
481 C_STRING_ALLOCA, ldap_attributes[i],
482 Qnative);
483 ++i; 464 ++i;
484 } 465 }
485 ldap_attributes[i] = NULL; 466 ldap_attributes[i] = NULL;
486 } 467 }
487 468
488 /* Attributes only ? */ 469 /* Attributes only ? */
489 CHECK_SYMBOL (attrsonly); 470 CHECK_SYMBOL (attrsonly);
490 471
491 /* Perform the search */ 472 /* Perform the search */
492 if (ldap_search (ld, 473 if (ldap_search (ld,
493 NILP (base) ? (char *) "" : (char *) XSTRING_DATA (base), 474 NILP (base) ? "" : (char *) XSTRING_DATA (base),
494 ldap_scope, 475 ldap_scope,
495 NILP (filter) ? (char *) "" : (char *) XSTRING_DATA (filter), 476 NILP (filter) ? "" : (char *) XSTRING_DATA (filter),
496 ldap_attributes, 477 ldap_attributes,
497 NILP (attrsonly) ? 0 : 1) 478 NILP (attrsonly) ? 0 : 1)
498 == -1) 479 == -1)
499 { 480 {
500 signal_ldap_error (ld, NULL, 0); 481 signal_ldap_error (ld);
501 } 482 }
502 483
503 /* Ensure we don't exit without cleaning up */ 484 /* Ensure we don't exit without cleaning up */
504 record_unwind_protect (ldap_search_unwind, 485 record_unwind_protect (ldap_search_unwind,
505 make_opaque_ptr (&unwind)); 486 make_opaque_ptr (&unwind));
506 487
507 /* Build the results list */ 488 /* Build the results list */
508 matches = 0; 489 matches = 0;
509 490
491 /* ldap_result calls select() and can get wedged by EINTR signals */
492 slow_down_interrupts ();
510 rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &unwind.res); 493 rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &unwind.res);
511 494 speed_up_interrupts ();
512 while (rc == LDAP_RES_SEARCH_ENTRY) 495 while (rc == LDAP_RES_SEARCH_ENTRY)
513 { 496 {
514 QUIT; 497 QUIT;
515 matches ++; 498 matches ++;
516 e = ldap_first_entry (ld, unwind.res); 499 e = ldap_first_entry (ld, unwind.res);
517 /* #### This call to message() is pretty fascist, because it 500 /* #### This call to message() is pretty fascist, because it
518 destroys the current echo area contents, even when invoked 501 destroys the current echo area contents, even when invoked
519 from Lisp. It should use echo_area_message() instead, and 502 from Lisp. It should use echo_area_message() instead, and
520 restore the old echo area contents later. */ 503 restore the old echo area contents later. */
521 if (! NILP (verbose)) 504 message ("Parsing ldap results... %d", matches);
522 message ("Parsing ldap results... %d", matches);
523 entry = Qnil; 505 entry = Qnil;
524 /* Get the DN if required */ 506 /* Get the DN if required */
525 if (! NILP (withdn)) 507 if (! NILP (withdn))
526 { 508 {
527 dn = ldap_get_dn (ld, e); 509 dn = ldap_get_dn (ld, e);
528 if (dn == NULL) 510 if (dn == NULL)
529 signal_ldap_error (ld, e, 0); 511 {
530 entry = Fcons (build_ext_string (dn, Qnative), Qnil); 512 signal_ldap_error (ld);
513 }
514 entry = Fcons (build_ext_string (dn, FORMAT_OS), Qnil);
531 } 515 }
532 for (a= ldap_first_attribute (ld, e, &ptr); 516 for (a= ldap_first_attribute (ld, e, &ptr);
533 a != NULL; 517 a != NULL;
534 a = ldap_next_attribute (ld, e, ptr) ) 518 a = ldap_next_attribute (ld, e, ptr) )
535 { 519 {
536 list = Fcons (build_ext_string (a, Qnative), Qnil); 520 list = Fcons (build_ext_string (a, FORMAT_OS), Qnil);
537 unwind.vals = ldap_get_values_len (ld, e, a); 521 unwind.vals = ldap_get_values_len (ld, e, a);
538 if (unwind.vals != NULL) 522 if (unwind.vals != NULL)
539 { 523 {
540 for (i = 0; unwind.vals[i] != NULL; i++) 524 for (i = 0; unwind.vals[i] != NULL; i++)
541 { 525 {
542 list = Fcons (make_ext_string ((Extbyte *) unwind.vals[i]->bv_val, 526 list = Fcons (make_ext_string (unwind.vals[i]->bv_val,
543 unwind.vals[i]->bv_len, 527 unwind.vals[i]->bv_len,
544 Qnative), 528 FORMAT_OS),
545 list); 529 list);
546 } 530 }
547 } 531 }
548 entry = Fcons (Fnreverse (list), 532 entry = Fcons (Fnreverse (list),
549 entry); 533 entry);
553 result = Fcons (Fnreverse (entry), 537 result = Fcons (Fnreverse (entry),
554 result); 538 result);
555 ldap_msgfree (unwind.res); 539 ldap_msgfree (unwind.res);
556 unwind.res = NULL; 540 unwind.res = NULL;
557 541
542 slow_down_interrupts ();
558 rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &(unwind.res)); 543 rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &(unwind.res));
559 } 544 speed_up_interrupts ();
560 545 }
561 #if defined HAVE_LDAP_PARSE_RESULT
562 {
563 int rc2 = ldap_parse_result (ld, unwind.res,
564 &rc,
565 NULL, NULL, NULL, NULL, 0);
566 if (rc2 != LDAP_SUCCESS)
567 rc = rc2;
568 }
569 #else
570 if (rc == 0)
571 signal_ldap_error (ld, NULL, LDAP_TIMELIMIT_EXCEEDED);
572 546
573 if (rc == -1) 547 if (rc == -1)
574 signal_ldap_error (ld, unwind.res, (unwind.res==NULL) ? ld->ld_errno : 0); 548 {
575 549 signal_ldap_error (ld);
576 #if defined HAVE_LDAP_RESULT2ERROR 550 }
577 rc = ldap_result2error (ld, unwind.res, 0); 551 rc = ldap_result2error (ld, unwind.res, 0);
578 #endif 552 if ((rc != LDAP_SUCCESS) &&
579 #endif 553 (rc != LDAP_SIZELIMIT_EXCEEDED))
580 554 {
581 if (rc != LDAP_SUCCESS) 555 signal_ldap_error (ld);
582 signal_ldap_error (ld, NULL, rc); 556 }
583 557
584 ldap_msgfree (unwind.res); 558 ldap_msgfree (unwind.res);
585 unwind.res = (LDAPMessage *)NULL; 559 unwind.res = (LDAPMessage *)NULL;
586
587 /* #### See above for calling message(). */ 560 /* #### See above for calling message(). */
588 if (! NILP (verbose)) 561 message ("Parsing ldap results... done");
589 message ("Parsing ldap results... done");
590 562
591 unbind_to (speccount, Qnil); 563 unbind_to (speccount, Qnil);
592 UNGCPRO; 564 UNGCPRO;
593 return Fnreverse (result); 565 return Fnreverse (result);
594 } 566 }
595 567
596 DEFUN ("ldap-add", Fldap_add, 3, 3, 0, /*
597 Add an entry to an LDAP directory.
598 LDAP is an LDAP connection object created with `ldap-open'.
599 DN is the distinguished name of the entry to add.
600 ENTRY is an entry specification, i.e., a list of cons cells
601 containing attribute/value string pairs.
602 */
603 (ldap, dn, entry))
604 {
605 LDAP *ld;
606 LDAPMod *ldap_mods, **ldap_mods_ptrs;
607 struct berval *bervals;
608 int rc;
609 int i, j;
610 size_t len;
611
612 Lisp_Object current = Qnil;
613 Lisp_Object values = Qnil;
614 struct gcpro gcpro1, gcpro2;
615
616 GCPRO2 (current, values);
617
618 /* Do all the parameter checking */
619 CHECK_LIVE_LDAP (ldap);
620 ld = XLDAP (ldap)->ld;
621
622 /* Check the DN */
623 CHECK_STRING (dn);
624
625 /* Check the entry */
626 CHECK_CONS (entry);
627 if (NILP (entry))
628 signal_simple_error ("Cannot add void entry", entry);
629
630 /* Build the ldap_mods array */
631 len = XINT (Flength (entry));
632 ldap_mods = alloca_array (LDAPMod, len);
633 ldap_mods_ptrs = alloca_array (LDAPMod *, 1 + len);
634 i = 0;
635 EXTERNAL_LIST_LOOP (entry, entry)
636 {
637 current = XCAR (entry);
638 CHECK_CONS (current);
639 CHECK_STRING (XCAR (current));
640 ldap_mods_ptrs[i] = &(ldap_mods[i]);
641 TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (current),
642 C_STRING_ALLOCA, ldap_mods[i].mod_type,
643 Qnative);
644 ldap_mods[i].mod_op = LDAP_MOD_ADD | LDAP_MOD_BVALUES;
645 values = XCDR (current);
646 if (CONSP (values))
647 {
648 len = XINT (Flength (values));
649 bervals = alloca_array (struct berval, len);
650 ldap_mods[i].mod_vals.modv_bvals =
651 alloca_array (struct berval *, 1 + len);
652 j = 0;
653 EXTERNAL_LIST_LOOP (values, values)
654 {
655 current = XCAR (values);
656 CHECK_STRING (current);
657 ldap_mods[i].mod_vals.modv_bvals[j] = &(bervals[j]);
658 TO_EXTERNAL_FORMAT (LISP_STRING, current,
659 ALLOCA, (bervals[j].bv_val,
660 bervals[j].bv_len),
661 Qnative);
662 j++;
663 }
664 ldap_mods[i].mod_vals.modv_bvals[j] = NULL;
665 }
666 else
667 {
668 CHECK_STRING (values);
669 bervals = alloca_array (struct berval, 1);
670 ldap_mods[i].mod_vals.modv_bvals = alloca_array (struct berval *, 2);
671 ldap_mods[i].mod_vals.modv_bvals[0] = &(bervals[0]);
672 TO_EXTERNAL_FORMAT (LISP_STRING, values,
673 ALLOCA, (bervals[0].bv_val,
674 bervals[0].bv_len),
675 Qnative);
676 ldap_mods[i].mod_vals.modv_bvals[1] = NULL;
677 }
678 i++;
679 }
680 ldap_mods_ptrs[i] = NULL;
681 rc = ldap_add_s (ld, (char *) XSTRING_DATA (dn), ldap_mods_ptrs);
682 if (rc != LDAP_SUCCESS)
683 signal_ldap_error (ld, NULL, rc);
684
685 UNGCPRO;
686 return Qnil;
687 }
688
689 DEFUN ("ldap-modify", Fldap_modify, 3, 3, 0, /*
690 Add an entry to an LDAP directory.
691 LDAP is an LDAP connection object created with `ldap-open'.
692 DN is the distinguished name of the entry to modify.
693 MODS is a list of modifications to apply.
694 A modification is a list of the form (MOD-OP ATTR VALUE1 VALUE2 ...)
695 MOD-OP and ATTR are mandatory, VALUEs are optional depending on MOD-OP.
696 MOD-OP is the type of modification, one of the symbols `add', `delete'
697 or `replace'. ATTR is the LDAP attribute type to modify.
698 */
699 (ldap, dn, mods))
700 {
701 LDAP *ld;
702 LDAPMod *ldap_mods, **ldap_mods_ptrs;
703 struct berval *bervals;
704 int i, j, rc;
705 Lisp_Object mod_op;
706 size_t len;
707
708 Lisp_Object current = Qnil;
709 Lisp_Object values = Qnil;
710 struct gcpro gcpro1, gcpro2;
711
712 GCPRO2 (current, values);
713
714 /* Do all the parameter checking */
715 CHECK_LIVE_LDAP (ldap);
716 ld = XLDAP (ldap)->ld;
717
718 /* Check the DN */
719 CHECK_STRING (dn);
720
721 /* Check the entry */
722 CHECK_CONS (mods);
723 if (NILP (mods))
724 return Qnil;
725
726 /* Build the ldap_mods array */
727 len = XINT (Flength (mods));
728 ldap_mods = alloca_array (LDAPMod, len);
729 ldap_mods_ptrs = alloca_array (LDAPMod *, 1 + len);
730 i = 0;
731 EXTERNAL_LIST_LOOP (mods, mods)
732 {
733 current = XCAR (mods);
734 CHECK_CONS (current);
735 CHECK_SYMBOL (XCAR (current));
736 mod_op = XCAR (current);
737 ldap_mods_ptrs[i] = &(ldap_mods[i]);
738 ldap_mods[i].mod_op = LDAP_MOD_BVALUES;
739 if (EQ (mod_op, Qadd))
740 ldap_mods[i].mod_op |= LDAP_MOD_ADD;
741 else if (EQ (mod_op, Qdelete))
742 ldap_mods[i].mod_op |= LDAP_MOD_DELETE;
743 else if (EQ (mod_op, Qreplace))
744 ldap_mods[i].mod_op |= LDAP_MOD_REPLACE;
745 else
746 signal_simple_error ("Invalid LDAP modification type", mod_op);
747 current = XCDR (current);
748 CHECK_STRING (XCAR (current));
749 TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (current),
750 C_STRING_ALLOCA, ldap_mods[i].mod_type,
751 Qnative);
752 values = XCDR (current);
753 len = XINT (Flength (values));
754 bervals = alloca_array (struct berval, len);
755 ldap_mods[i].mod_vals.modv_bvals =
756 alloca_array (struct berval *, 1 + len);
757 j = 0;
758 EXTERNAL_LIST_LOOP (values, values)
759 {
760 current = XCAR (values);
761 CHECK_STRING (current);
762 ldap_mods[i].mod_vals.modv_bvals[j] = &(bervals[j]);
763 TO_EXTERNAL_FORMAT (LISP_STRING, current,
764 ALLOCA, (bervals[j].bv_val,
765 bervals[j].bv_len),
766 Qnative);
767 j++;
768 }
769 ldap_mods[i].mod_vals.modv_bvals[j] = NULL;
770 i++;
771 }
772 ldap_mods_ptrs[i] = NULL;
773 rc = ldap_modify_s (ld, (char *) XSTRING_DATA (dn), ldap_mods_ptrs);
774 if (rc != LDAP_SUCCESS)
775 signal_ldap_error (ld, NULL, rc);
776
777 UNGCPRO;
778 return Qnil;
779 }
780
781
782 DEFUN ("ldap-delete", Fldap_delete, 2, 2, 0, /*
783 Delete an entry to an LDAP directory.
784 LDAP is an LDAP connection object created with `ldap-open'.
785 DN is the distinguished name of the entry to delete.
786 */
787 (ldap, dn))
788 {
789 LDAP *ld;
790 int rc;
791
792 /* Check parameters */
793 CHECK_LIVE_LDAP (ldap);
794 ld = XLDAP (ldap)->ld;
795 CHECK_STRING (dn);
796
797 rc = ldap_delete_s (ld, (char *) XSTRING_DATA (dn));
798 if (rc != LDAP_SUCCESS)
799 signal_ldap_error (ld, NULL, rc);
800
801 return Qnil;
802 }
803 568
804 void 569 void
805 syms_of_eldap (void) 570 syms_of_eldap (void)
806 { 571 {
807 INIT_LRECORD_IMPLEMENTATION (ldap);
808
809 defsymbol (&Qldapp, "ldapp"); 572 defsymbol (&Qldapp, "ldapp");
810 defsymbol (&Qport, "port");
811 defsymbol (&Qauth, "auth");
812 defsymbol (&Qbinddn, "binddn");
813 defsymbol (&Qpasswd, "passwd");
814 defsymbol (&Qderef, "deref");
815 defsymbol (&Qtimelimit, "timelimit");
816 defsymbol (&Qsizelimit, "sizelimit");
817 defsymbol (&Qbase, "base");
818 defsymbol (&Qonelevel, "onelevel");
819 defsymbol (&Qsubtree, "subtree");
820 defsymbol (&Qkrbv41, "krbv41");
821 defsymbol (&Qkrbv42, "krbv42");
822 defsymbol (&Qnever, "never");
823 defsymbol (&Qalways, "always");
824 defsymbol (&Qfind, "find");
825 defsymbol (&Qadd, "add");
826 defsymbol (&Qreplace, "replace");
827
828 DEFSUBR (Fldapp); 573 DEFSUBR (Fldapp);
829 DEFSUBR (Fldap_host); 574 DEFSUBR (Fldap_host);
830 DEFSUBR (Fldap_status); 575 DEFSUBR (Fldap_status);
831 DEFSUBR (Fldap_open); 576 DEFSUBR (Fldap_open);
832 DEFSUBR (Fldap_close); 577 DEFSUBR (Fldap_close);
833 DEFSUBR (Fldap_search_basic); 578 DEFSUBR (Fldap_search_internal);
834 DEFSUBR (Fldap_add);
835 DEFSUBR (Fldap_modify);
836 DEFSUBR (Fldap_delete);
837 } 579 }
838 580
839 void 581 void
840 vars_of_eldap (void) 582 vars_of_eldap (void)
841 { 583 {