1 /* LDAP client interface for XEmacs.
2 Copyright (C) 1998 Free Software Foundation, Inc.
4 This file is part of XEmacs.
6 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the
8 Free Software Foundation; either version 2, or (at your option) any
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Synched up with: Not in FSF. */
23 /* Author: Oscar Figueiredo with lots of support from Hrvoje Niksic */
25 /* This file provides lisp primitives for access to an LDAP library
26 conforming to the API defined in RFC 1823.
27 It has been tested with:
28 - UMich LDAP 3.3 (http://www.umich.edu/~dirsvcs/ldap/)
29 - OpenLDAP 1.0.3 (http://www.openldap.org/)
30 - Netscape's LDAP SDK 1.0 (http://developer.netscape.com) */
44 # define HAVE_LDAP_SET_OPTION 1
45 # define HAVE_LDAP_GET_ERRNO 1
47 # undef HAVE_LDAP_SET_OPTION
48 # undef HAVE_LDAP_GET_ERRNO
51 static int ldap_default_port;
52 static Lisp_Object Vldap_default_base;
54 /* Needed by the lrecord definition */
57 /* ldap-open plist keywords */
58 extern Lisp_Object Qport, Qauth, Qbinddn, Qpasswd, Qderef, Qtimelimit,
60 /* Search scope limits */
61 extern Lisp_Object Qbase, Qonelevel, Qsubtree;
62 /* Authentication methods */
63 extern Lisp_Object Qkrbv41, Qkrbv42;
65 extern Lisp_Object Qnever, Qalways, Qfind;
67 /************************************************************************/
68 /* Utility Functions */
69 /************************************************************************/
72 signal_ldap_error (LDAP *ld)
74 #ifdef HAVE_LDAP_GET_ERRNO
77 build_string (ldap_err2string (ldap_get_lderrno (ld, NULL, NULL))));
79 signal_simple_error ("LDAP error",
80 build_string (ldap_err2string (ld->ld_errno)));
85 /************************************************************************/
86 /* ldap lrecord basic functions */
87 /************************************************************************/
90 make_ldap (struct Lisp_LDAP *ldap)
92 Lisp_Object lisp_ldap;
93 XSETLDAP (lisp_ldap, ldap);
98 mark_ldap (Lisp_Object obj, void (*markobj) (Lisp_Object))
100 return XLDAP (obj)->host;
104 print_ldap (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
108 struct Lisp_LDAP *ldap = XLDAP (obj);
111 error ("printing unreadable object #<ldap %s>",
112 XSTRING_DATA (ldap->host));
114 write_c_string ("#<ldap ", printcharfun);
115 print_internal (ldap->host, printcharfun, 1);
117 write_c_string ("(dead) ",printcharfun);
118 sprintf (buf, " 0x%x>", (unsigned int)ldap);
119 write_c_string (buf, printcharfun);
122 static struct Lisp_LDAP *
125 struct Lisp_LDAP *ldap =
126 alloc_lcrecord_type (struct Lisp_LDAP, lrecord_ldap);
135 finalize_ldap (void *header, int for_disksave)
137 struct Lisp_LDAP *ldap = (struct Lisp_LDAP *) header;
140 signal_simple_error ("Can't dump an emacs containing LDAP objects",
144 ldap_unbind (ldap->ld);
147 DEFINE_LRECORD_IMPLEMENTATION ("ldap", ldap,
148 mark_ldap, print_ldap, finalize_ldap,
149 NULL, NULL, struct Lisp_LDAP);
154 /************************************************************************/
155 /* Basic ldap accessors */
156 /************************************************************************/
158 DEFUN ("ldapp", Fldapp, 1, 1, 0, /*
159 Return t if OBJECT is a LDAP connection.
163 return LDAPP (object) ? Qt : Qnil;
166 DEFUN ("ldap-host", Fldap_host, 1, 1, 0, /*
167 Return the server host of the connection LDAP, as a string.
172 return (XLDAP (ldap))->host;
175 DEFUN ("ldap-live-p", Fldap_status, 1, 1, 0, /*
176 Return t if LDAP is an active LDAP connection.
181 return (XLDAP (ldap))->livep ? Qt : Qnil;
184 /************************************************************************/
185 /* Opening/Closing a LDAP connection */
186 /************************************************************************/
189 DEFUN ("ldap-open", Fldap_open, 1, 2, 0, /*
190 Open a LDAP connection to HOST.
191 PLIST is a plist containing additional parameters for the connection.
192 Valid keys in that list are:
193 `port' the TCP port to use for the connection if different from
195 `auth' is the authentication method to use, possible values depend on
196 the LDAP library XEmacs was compiled with: `simple', `krbv41' and `krbv42'.
197 `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax).
198 `passwd' is the password to use for simple authentication.
199 `deref' is one of the symbols `never', `always', `search' or `find'.
200 `timelimit' is the timeout limit for the connection in seconds.
201 `sizelimit' is the maximum number of matches to return.
205 /* This function can GC */
206 struct Lisp_LDAP *ldap;
209 int ldap_auth = LDAP_AUTH_SIMPLE;
210 char *ldap_binddn = NULL;
211 char *ldap_passwd = NULL;
212 int ldap_deref = LDAP_DEREF_NEVER;
213 int ldap_timelimit = 0;
214 int ldap_sizelimit = 0;
217 Lisp_Object list, keyword, value;
221 EXTERNAL_PROPERTY_LIST_LOOP (list, keyword, value, plist)
224 if (EQ (keyword, Qport))
227 ldap_port = XINT (value);
229 /* Authentication method */
230 if (EQ (keyword, Qauth))
232 if (EQ (value, Qsimple))
233 ldap_auth = LDAP_AUTH_SIMPLE;
234 #ifdef LDAP_AUTH_KRBV41
235 else if (EQ (value, Qkrbv41))
236 ldap_auth = LDAP_AUTH_KRBV41;
238 #ifdef LDAP_AUTH_KRBV42
239 else if (EQ (value, Qkrbv42))
240 ldap_auth = LDAP_AUTH_KRBV42;
243 signal_simple_error ("Invalid authentication method", value);
246 else if (EQ (keyword, Qbinddn))
248 CHECK_STRING (value);
249 GET_C_STRING_OS_DATA_ALLOCA (value, ldap_binddn);
252 else if (EQ (keyword, Qpasswd))
254 CHECK_STRING (value);
255 GET_C_STRING_OS_DATA_ALLOCA (value, ldap_passwd);
258 else if (EQ (keyword, Qderef))
260 if (EQ (value, Qnever))
261 ldap_deref = LDAP_DEREF_NEVER;
262 else if (EQ (value, Qsearch))
263 ldap_deref = LDAP_DEREF_SEARCHING;
264 else if (EQ (value, Qfind))
265 ldap_deref = LDAP_DEREF_FINDING;
266 else if (EQ (value, Qalways))
267 ldap_deref = LDAP_DEREF_ALWAYS;
269 signal_simple_error ("Invalid deref value", value);
272 else if (EQ (keyword, Qtimelimit))
275 ldap_timelimit = XINT (value);
278 else if (EQ (keyword, Qsizelimit))
281 ldap_sizelimit = XINT (value);
287 ldap_port = ldap_default_port;
290 /* Connect to the server and bind */
291 ld = ldap_open ((char *)XSTRING_DATA (host), ldap_port);
293 signal_simple_error_2 ("Failed connecting to host",
295 lisp_strerror (errno));
298 #ifdef HAVE_LDAP_SET_OPTION
299 if (ldap_set_option (ld, LDAP_OPT_DEREF, (void *)&ldap_deref) != LDAP_SUCCESS)
300 signal_ldap_error (ld);
301 if (ldap_set_option (ld, LDAP_OPT_TIMELIMIT,
302 (void *)&ldap_timelimit) != LDAP_SUCCESS)
303 signal_ldap_error (ld);
304 if (ldap_set_option (ld, LDAP_OPT_SIZELIMIT,
305 (void *)&ldap_sizelimit) != LDAP_SUCCESS)
306 signal_ldap_error (ld);
307 if (ldap_set_option (ld, LDAP_OPT_REFERRALS, LDAP_OPT_ON) != LDAP_SUCCESS)
308 signal_ldap_error (ld);
309 #else /* not HAVE_LDAP_SET_OPTION */
310 ld->ld_deref = ldap_deref;
311 ld->ld_timelimit = ldap_timelimit;
312 ld->ld_sizelimit = ldap_sizelimit;
313 #ifdef LDAP_REFERRALS
314 ld->ld_options = LDAP_OPT_REFERRALS;
315 #else /* not LDAP_REFERRALS */
317 #endif /* not LDAP_REFERRALS */
318 #endif /* not HAVE_LDAP_SET_OPTION */
320 /* ldap_bind_s calls select and may be wedged by SIGIO. */
321 slow_down_interrupts ();
322 err = ldap_bind_s (ld, ldap_binddn, ldap_passwd, ldap_auth);
323 speed_up_interrupts ();
324 if (err != LDAP_SUCCESS)
325 signal_simple_error ("Failed binding to the server",
326 build_string (ldap_err2string (err)));
328 ldap = allocate_ldap ();
333 return make_ldap (ldap);
338 DEFUN ("ldap-close", Fldap_close, 1, 1, 0, /*
339 Close an LDAP connection.
343 struct Lisp_LDAP *lldap;
344 CHECK_LIVE_LDAP (ldap);
345 lldap = XLDAP (ldap);
346 ldap_unbind (lldap->ld);
353 /************************************************************************/
354 /* Working on a LDAP connection */
355 /************************************************************************/
356 struct ldap_unwind_struct
364 ldap_search_unwind (Lisp_Object unwind_obj)
366 struct ldap_unwind_struct *unwind =
367 (struct ldap_unwind_struct *) get_opaque_ptr (unwind_obj);
369 ldap_msgfree (unwind->res);
371 ldap_value_free (unwind->vals);
375 DEFUN ("ldap-search-internal", Fldap_search_internal, 2, 6, 0, /*
376 Perform a search on an open LDAP connection.
377 LDAP is an LDAP connection object created with `ldap-open'.
378 FILTER is a filter string for the search as described in RFC 1558.
379 BASE is the distinguished name at which to start the search.
380 SCOPE is one of the symbols `base', `onelevel' or `subtree' indicating
381 the scope of the search.
382 ATTRS is a list of strings indicating which attributes to retrieve
383 for each matching entry. If nil return all available attributes.
384 If ATTRSONLY is non-nil then only the attributes are retrieved, not
385 the associated values.
386 The function returns a list of matching entries. Each entry is itself
387 an alist of attribute/values.
389 (ldap, filter, base, scope, attrs, attrsonly))
391 /* This function can GC */
400 struct ldap_unwind_struct unwind;
402 int ldap_scope = LDAP_SCOPE_SUBTREE;
403 char **ldap_attributes = NULL;
405 int speccount = specpdl_depth ();
407 Lisp_Object list, entry, result;
408 struct gcpro gcpro1, gcpro2, gcpro3;
410 list = entry = result = Qnil;
411 GCPRO3 (list, entry, result);
416 /* Do all the parameter checking */
417 CHECK_LIVE_LDAP (ldap);
418 ld = XLDAP (ldap)->ld;
421 CHECK_STRING (filter);
426 base = Vldap_default_base;
436 if (EQ (scope, Qbase))
437 ldap_scope = LDAP_SCOPE_BASE;
438 else if (EQ (scope, Qonelevel))
439 ldap_scope = LDAP_SCOPE_ONELEVEL;
440 else if (EQ (scope, Qsubtree))
441 ldap_scope = LDAP_SCOPE_SUBTREE;
443 signal_simple_error ("Invalid scope", scope);
446 /* Attributes to search */
450 ldap_attributes = alloca_array (char *, 1 + XINT (Flength (attrs)));
453 EXTERNAL_LIST_LOOP (attrs, attrs)
455 Lisp_Object current = XCAR (attrs);
456 CHECK_STRING (current);
457 GET_C_STRING_OS_DATA_ALLOCA (current, ldap_attributes[i]);
460 ldap_attributes[i] = NULL;
463 /* Attributes only ? */
464 CHECK_SYMBOL (attrsonly);
466 /* Perform the search */
468 NILP (base) ? "" : (char *) XSTRING_DATA (base),
470 NILP (filter) ? "" : (char *) XSTRING_DATA (filter),
472 NILP (attrsonly) ? 0 : 1)
475 signal_ldap_error (ld);
478 /* Ensure we don't exit without cleaning up */
479 record_unwind_protect (ldap_search_unwind,
480 make_opaque_ptr (&unwind));
482 /* Build the results list */
485 /* ldap_result calls select() and can get wedged by EINTR signals */
486 slow_down_interrupts ();
487 rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &unwind.res);
488 speed_up_interrupts ();
489 while (rc == LDAP_RES_SEARCH_ENTRY)
493 e = ldap_first_entry (ld, unwind.res);
494 /* #### This call to message() is pretty fascist, because it
495 destroys the current echo area contents, even when invoked
496 from Lisp. It should use echo_area_message() instead, and
497 restore the old echo area contents later. */
498 message ("Parsing ldap results... %d", matches);
500 for (a= ldap_first_attribute (ld, e, &ptr);
502 a= ldap_next_attribute (ld, e, ptr) )
504 list = Fcons (build_ext_string (a, FORMAT_OS), Qnil);
505 unwind.vals = ldap_get_values (ld, e, a);
506 if (unwind.vals != NULL)
508 for (i = 0; unwind.vals[i] != NULL; i++)
510 list = Fcons (build_ext_string (unwind.vals[i], FORMAT_OS),
514 entry = Fcons (Fnreverse (list),
516 ldap_value_free (unwind.vals);
519 result = Fcons (Fnreverse (entry),
521 ldap_msgfree (unwind.res);
524 slow_down_interrupts ();
525 rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &(unwind.res));
526 speed_up_interrupts ();
531 signal_ldap_error (ld);
533 rc = ldap_result2error (ld, unwind.res, 0);
534 if ((rc != LDAP_SUCCESS) &&
535 (rc != LDAP_SIZELIMIT_EXCEEDED))
537 signal_ldap_error (ld);
540 ldap_msgfree (unwind.res);
541 unwind.res = (LDAPMessage *)NULL;
542 /* #### See above for calling message(). */
543 message ("Parsing ldap results... done");
545 unbind_to (speccount, Qnil);
547 return Fnreverse (result);
554 defsymbol (&Qldapp, "ldapp");
556 DEFSUBR (Fldap_host);
557 DEFSUBR (Fldap_status);
558 DEFSUBR (Fldap_open);
559 DEFSUBR (Fldap_close);
560 DEFSUBR (Fldap_search_internal);
566 Fprovide (intern ("ldap"));
568 ldap_default_port = LDAP_PORT;
569 Vldap_default_base = Qnil;
571 DEFVAR_INT ("ldap-default-port", &ldap_default_port /*
572 Default TCP port for LDAP connections.
573 Initialized from the LDAP library. Default value is 389.
576 DEFVAR_LISP ("ldap-default-base", &Vldap_default_base /*
577 Default base for LDAP searches.
578 This is a string using the syntax of RFC 1779.
579 For instance, "o=ACME, c=US" limits the search to the
580 Acme organization in the United States.