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.2 (http://www.openldap.org/)
30 - Netscape's LDAP SDK (http://developer.netscape.com/) */
43 static int ldap_default_port;
44 static Lisp_Object Vldap_default_base;
46 /* Needed by the lrecord definition */
49 /* ldap-open plist keywords */
50 extern Lisp_Object Qport, Qauth, Qbinddn, Qpasswd, Qderef, Qtimelimit,
52 /* Search scope limits */
53 extern Lisp_Object Qbase, Qonelevel, Qsubtree;
54 /* Authentication methods */
55 extern Lisp_Object Qkrbv41, Qkrbv42;
57 extern Lisp_Object Qnever, Qalways, Qfind;
59 /************************************************************************/
60 /* Utility Functions */
61 /************************************************************************/
64 signal_ldap_error (LDAP *ld, LDAPMessage *res, int ldap_err)
68 #if defined HAVE_LDAP_PARSE_RESULT
70 ldap_err = ldap_parse_result (ld, res,
72 NULL, NULL, NULL, NULL, 0);
73 if (ldap_err == LDAP_SUCCESS)
75 #elif defined HAVE_LDAP_GET_LDERRNO
76 ldap_err = ldap_get_lderrno (ld, NULL, NULL);
77 #elif defined HAVE_LDAP_RESULT2ERROR
78 ldap_err = ldap_result2error (ld, res, 0);
80 ldap_err = ld->ld_errno;
83 signal_simple_error ("LDAP error",
84 build_string (ldap_err2string (ldap_err)));
88 /************************************************************************/
89 /* ldap lrecord basic functions */
90 /************************************************************************/
93 make_ldap (struct Lisp_LDAP *ldap)
95 Lisp_Object lisp_ldap;
96 XSETLDAP (lisp_ldap, ldap);
101 mark_ldap (Lisp_Object obj, void (*markobj) (Lisp_Object))
103 return XLDAP (obj)->host;
107 print_ldap (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
111 struct Lisp_LDAP *ldap = XLDAP (obj);
114 error ("printing unreadable object #<ldap %s>",
115 XSTRING_DATA (ldap->host));
117 write_c_string ("#<ldap ", printcharfun);
118 print_internal (ldap->host, printcharfun, 1);
120 write_c_string ("(dead) ",printcharfun);
121 sprintf (buf, " 0x%x>", (unsigned int)ldap);
122 write_c_string (buf, printcharfun);
125 static struct Lisp_LDAP *
128 struct Lisp_LDAP *ldap =
129 alloc_lcrecord_type (struct Lisp_LDAP, &lrecord_ldap);
137 finalize_ldap (void *header, int for_disksave)
139 struct Lisp_LDAP *ldap = (struct Lisp_LDAP *) header;
142 signal_simple_error ("Can't dump an emacs containing LDAP objects",
146 ldap_unbind (ldap->ld);
150 DEFINE_LRECORD_IMPLEMENTATION ("ldap", ldap,
151 mark_ldap, print_ldap, finalize_ldap,
152 NULL, NULL, 0, struct Lisp_LDAP);
157 /************************************************************************/
158 /* Basic ldap accessors */
159 /************************************************************************/
161 DEFUN ("ldapp", Fldapp, 1, 1, 0, /*
162 Return t if OBJECT is a LDAP connection.
166 return LDAPP (object) ? Qt : Qnil;
169 DEFUN ("ldap-host", Fldap_host, 1, 1, 0, /*
170 Return the server host of the connection LDAP, as a string.
175 return (XLDAP (ldap))->host;
178 DEFUN ("ldap-live-p", Fldap_status, 1, 1, 0, /*
179 Return t if LDAP is an active LDAP connection.
184 return (XLDAP (ldap))->ld ? Qt : Qnil;
187 /************************************************************************/
188 /* Opening/Closing a LDAP connection */
189 /************************************************************************/
192 DEFUN ("ldap-open", Fldap_open, 1, 2, 0, /*
193 Open a LDAP connection to HOST.
194 PLIST is a plist containing additional parameters for the connection.
195 Valid keys in that list are:
196 `port' the TCP port to use for the connection if different from
198 `auth' is the authentication method to use, possible values depend on
199 the LDAP library XEmacs was compiled with: `simple', `krbv41' and `krbv42'.
200 `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax).
201 `passwd' is the password to use for simple authentication.
202 `deref' is one of the symbols `never', `always', `search' or `find'.
203 `timelimit' is the timeout limit for the connection in seconds.
204 `sizelimit' is the maximum number of matches to return.
208 /* This function can GC */
209 struct Lisp_LDAP *ldap;
212 int ldap_auth = LDAP_AUTH_SIMPLE;
213 char *ldap_binddn = NULL;
214 char *ldap_passwd = NULL;
215 int ldap_deref = LDAP_DEREF_NEVER;
216 int ldap_timelimit = 0;
217 int ldap_sizelimit = 0;
220 Lisp_Object list, keyword, value;
224 EXTERNAL_PROPERTY_LIST_LOOP (list, keyword, value, plist)
227 if (EQ (keyword, Qport))
230 ldap_port = XINT (value);
232 /* Authentication method */
233 if (EQ (keyword, Qauth))
235 if (EQ (value, Qsimple))
236 ldap_auth = LDAP_AUTH_SIMPLE;
237 #ifdef LDAP_AUTH_KRBV41
238 else if (EQ (value, Qkrbv41))
239 ldap_auth = LDAP_AUTH_KRBV41;
241 #ifdef LDAP_AUTH_KRBV42
242 else if (EQ (value, Qkrbv42))
243 ldap_auth = LDAP_AUTH_KRBV42;
246 signal_simple_error ("Invalid authentication method", value);
249 else if (EQ (keyword, Qbinddn))
251 CHECK_STRING (value);
252 GET_C_STRING_OS_DATA_ALLOCA (value, ldap_binddn);
255 else if (EQ (keyword, Qpasswd))
257 CHECK_STRING (value);
258 GET_C_STRING_OS_DATA_ALLOCA (value, ldap_passwd);
261 else if (EQ (keyword, Qderef))
263 if (EQ (value, Qnever))
264 ldap_deref = LDAP_DEREF_NEVER;
265 else if (EQ (value, Qsearch))
266 ldap_deref = LDAP_DEREF_SEARCHING;
267 else if (EQ (value, Qfind))
268 ldap_deref = LDAP_DEREF_FINDING;
269 else if (EQ (value, Qalways))
270 ldap_deref = LDAP_DEREF_ALWAYS;
272 signal_simple_error ("Invalid deref value", value);
275 else if (EQ (keyword, Qtimelimit))
278 ldap_timelimit = XINT (value);
281 else if (EQ (keyword, Qsizelimit))
284 ldap_sizelimit = XINT (value);
290 ldap_port = ldap_default_port;
293 /* Connect to the server and bind */
294 slow_down_interrupts ();
295 ld = ldap_open ((char *)XSTRING_DATA (host), ldap_port);
296 speed_up_interrupts ();
299 signal_simple_error_2 ("Failed connecting to host",
301 lisp_strerror (errno));
304 #ifdef HAVE_LDAP_SET_OPTION
305 if ((err = ldap_set_option (ld, LDAP_OPT_DEREF,
306 (void *)&ldap_deref)) != LDAP_SUCCESS)
307 signal_ldap_error (ld, NULL, err);
308 if ((err = ldap_set_option (ld, LDAP_OPT_TIMELIMIT,
309 (void *)&ldap_timelimit)) != LDAP_SUCCESS)
310 signal_ldap_error (ld, NULL, err);
311 if ((err = ldap_set_option (ld, LDAP_OPT_SIZELIMIT,
312 (void *)&ldap_sizelimit)) != LDAP_SUCCESS)
313 signal_ldap_error (ld, NULL, err);
314 if ((err = ldap_set_option (ld, LDAP_OPT_REFERRALS,
315 LDAP_OPT_ON)) != LDAP_SUCCESS)
316 signal_ldap_error (ld, NULL, err);
317 #else /* not HAVE_LDAP_SET_OPTION */
318 ld->ld_deref = ldap_deref;
319 ld->ld_timelimit = ldap_timelimit;
320 ld->ld_sizelimit = ldap_sizelimit;
321 #ifdef LDAP_REFERRALS
322 ld->ld_options = LDAP_OPT_REFERRALS;
323 #else /* not LDAP_REFERRALS */
325 #endif /* not LDAP_REFERRALS */
326 #endif /* not HAVE_LDAP_SET_OPTION */
328 /* ldap_bind_s calls select and may be wedged by SIGIO. */
329 slow_down_interrupts ();
330 err = ldap_bind_s (ld, ldap_binddn, ldap_passwd, ldap_auth);
331 speed_up_interrupts ();
332 if (err != LDAP_SUCCESS)
333 signal_simple_error ("Failed binding to the server",
334 build_string (ldap_err2string (err)));
336 ldap = allocate_ldap ();
340 return make_ldap (ldap);
345 DEFUN ("ldap-close", Fldap_close, 1, 1, 0, /*
346 Close an LDAP connection.
350 struct Lisp_LDAP *lldap;
351 CHECK_LIVE_LDAP (ldap);
352 lldap = XLDAP (ldap);
353 ldap_unbind (lldap->ld);
360 /************************************************************************/
361 /* Working on a LDAP connection */
362 /************************************************************************/
363 struct ldap_unwind_struct
366 struct berval **vals;
371 ldap_search_unwind (Lisp_Object unwind_obj)
373 struct ldap_unwind_struct *unwind =
374 (struct ldap_unwind_struct *) get_opaque_ptr (unwind_obj);
376 ldap_msgfree (unwind->res);
378 ldap_value_free_len (unwind->vals);
382 DEFUN ("ldap-search-internal", Fldap_search_internal, 2, 7, 0, /*
383 Perform a search on an open LDAP connection.
384 LDAP is an LDAP connection object created with `ldap-open'.
385 FILTER is a filter string for the search as described in RFC 1558.
386 BASE is the distinguished name at which to start the search.
387 SCOPE is one of the symbols `base', `onelevel' or `subtree' indicating
388 the scope of the search.
389 ATTRS is a list of strings indicating which attributes to retrieve
390 for each matching entry. If nil return all available attributes.
391 If ATTRSONLY is non-nil then only the attributes are retrieved, not
392 the associated values.
393 If WITHDN is non-nil each entry in the result will be prepennded with
394 its distinguished name DN.
395 The function returns a list of matching entries. Each entry is itself
396 an alist of attribute/value pairs optionally preceded by the DN of the
397 entry according to the value of WITHDN.
399 (ldap, filter, base, scope, attrs, attrsonly, withdn))
401 /* This function can GC */
410 struct ldap_unwind_struct unwind;
412 int ldap_scope = LDAP_SCOPE_SUBTREE;
413 char **ldap_attributes = NULL;
415 int speccount = specpdl_depth ();
417 Lisp_Object list, entry, result;
418 struct gcpro gcpro1, gcpro2, gcpro3;
420 list = entry = result = Qnil;
421 GCPRO3 (list, entry, result);
426 /* Do all the parameter checking */
427 CHECK_LIVE_LDAP (ldap);
428 ld = XLDAP (ldap)->ld;
431 CHECK_STRING (filter);
436 base = Vldap_default_base;
446 if (EQ (scope, Qbase))
447 ldap_scope = LDAP_SCOPE_BASE;
448 else if (EQ (scope, Qonelevel))
449 ldap_scope = LDAP_SCOPE_ONELEVEL;
450 else if (EQ (scope, Qsubtree))
451 ldap_scope = LDAP_SCOPE_SUBTREE;
453 signal_simple_error ("Invalid scope", scope);
456 /* Attributes to search */
460 ldap_attributes = alloca_array (char *, 1 + XINT (Flength (attrs)));
463 EXTERNAL_LIST_LOOP (attrs, attrs)
465 Lisp_Object current = XCAR (attrs);
466 CHECK_STRING (current);
467 GET_C_STRING_OS_DATA_ALLOCA (current, ldap_attributes[i]);
470 ldap_attributes[i] = NULL;
473 /* Attributes only ? */
474 CHECK_SYMBOL (attrsonly);
476 /* Perform the search */
478 NILP (base) ? "" : (char *) XSTRING_DATA (base),
480 NILP (filter) ? "" : (char *) XSTRING_DATA (filter),
482 NILP (attrsonly) ? 0 : 1)
485 signal_ldap_error (ld, NULL, 0);
488 /* Ensure we don't exit without cleaning up */
489 record_unwind_protect (ldap_search_unwind,
490 make_opaque_ptr (&unwind));
492 /* Build the results list */
495 /* ldap_result calls select() and can get wedged by EINTR signals */
496 slow_down_interrupts ();
497 rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &unwind.res);
498 speed_up_interrupts ();
499 while (rc == LDAP_RES_SEARCH_ENTRY)
503 e = ldap_first_entry (ld, unwind.res);
504 /* #### This call to message() is pretty fascist, because it
505 destroys the current echo area contents, even when invoked
506 from Lisp. It should use echo_area_message() instead, and
507 restore the old echo area contents later. */
508 message ("Parsing ldap results... %d", matches);
510 /* Get the DN if required */
513 dn = ldap_get_dn (ld, e);
515 signal_ldap_error (ld, e, 0);
516 entry = Fcons (build_ext_string (dn, FORMAT_OS), Qnil);
518 for (a= ldap_first_attribute (ld, e, &ptr);
520 a = ldap_next_attribute (ld, e, ptr) )
522 list = Fcons (build_ext_string (a, FORMAT_OS), Qnil);
523 unwind.vals = ldap_get_values_len (ld, e, a);
524 if (unwind.vals != NULL)
526 for (i = 0; unwind.vals[i] != NULL; i++)
528 list = Fcons (make_ext_string (unwind.vals[i]->bv_val,
529 unwind.vals[i]->bv_len,
534 entry = Fcons (Fnreverse (list),
536 ldap_value_free_len (unwind.vals);
539 result = Fcons (Fnreverse (entry),
541 ldap_msgfree (unwind.res);
544 slow_down_interrupts ();
545 rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &(unwind.res));
546 speed_up_interrupts ();
550 signal_ldap_error (ld, unwind.res, 0);
553 signal_ldap_error (ld, NULL, LDAP_TIMELIMIT_EXCEEDED);
555 #if defined HAVE_LDAP_PARSE_RESULT
556 rc2 = ldap_parse_result (ld, unwind.res,
558 NULL, NULL, NULL, NULL, 0);
559 if (rc2 != LDAP_SUCCESS)
561 #elif defined HAVE_LDAP_RESULT2ERROR
562 rc = ldap_result2error (ld, unwind.res, 0);
564 if ((rc != LDAP_SUCCESS) && (rc != LDAP_SIZELIMIT_EXCEEDED))
565 signal_ldap_error (ld, NULL, rc);
567 ldap_msgfree (unwind.res);
568 unwind.res = (LDAPMessage *)NULL;
569 /* #### See above for calling message(). */
570 message ("Parsing ldap results... done");
572 unbind_to (speccount, Qnil);
574 return Fnreverse (result);
581 defsymbol (&Qldapp, "ldapp");
583 DEFSUBR (Fldap_host);
584 DEFSUBR (Fldap_status);
585 DEFSUBR (Fldap_open);
586 DEFSUBR (Fldap_close);
587 DEFSUBR (Fldap_search_internal);
594 ldap_default_port = LDAP_PORT;
595 Vldap_default_base = Qnil;
597 DEFVAR_INT ("ldap-default-port", &ldap_default_port /*
598 Default TCP port for LDAP connections.
599 Initialized from the LDAP library. Default value is 389.
602 DEFVAR_LISP ("ldap-default-base", &Vldap_default_base /*
603 Default base for LDAP searches.
604 This is a string using the syntax of RFC 1779.
605 For instance, "o=ACME, c=US" limits the search to the
606 Acme organization in the United States.