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 - Netscape's LDAP SDK 1.0 (http://developer.netscape.com) */
42 # define HAVE_LDAP_SET_OPTION 1
43 # define HAVE_LDAP_GET_ERRNO 1
45 # undef HAVE_LDAP_SET_OPTION
46 # undef HAVE_LDAP_GET_ERRNO
49 static int ldap_default_port;
50 static Lisp_Object Vldap_default_base;
52 /* Needed by the lrecord definition */
55 /* ldap-open plist keywords */
56 extern Lisp_Object Qport, Qauth, Qbinddn, Qpasswd, Qderef, Qtimelimit,
58 /* Search scope limits */
59 extern Lisp_Object Qbase, Qonelevel, Qsubtree;
60 /* Authentication methods */
61 extern Lisp_Object Qkrbv41, Qkrbv42;
63 extern Lisp_Object Qnever, Qalways, Qfind;
65 /************************************************************************/
66 /* Utility Functions */
67 /************************************************************************/
70 signal_ldap_error (LDAP *ld)
72 #ifdef HAVE_LDAP_GET_ERRNO
75 build_string (ldap_err2string (ldap_get_lderrno (ld, NULL, NULL))));
77 signal_simple_error ("LDAP error",
78 build_string (ldap_err2string (ld->ld_errno)));
83 /************************************************************************/
84 /* ldap lrecord basic functions */
85 /************************************************************************/
88 make_ldap (struct Lisp_LDAP *ldap)
90 Lisp_Object lisp_ldap;
91 XSETLDAP (lisp_ldap, ldap);
96 mark_ldap (Lisp_Object obj, void (*markobj) (Lisp_Object))
98 return XLDAP (obj)->host;
102 print_ldap (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
106 struct Lisp_LDAP *ldap = XLDAP (obj);
109 error ("printing unreadable object #<ldap %s>",
110 XSTRING_DATA (ldap->host));
112 write_c_string ("#<ldap ", printcharfun);
113 print_internal (ldap->host, printcharfun, 1);
115 write_c_string ("(dead) ",printcharfun);
116 sprintf (buf, " 0x%x>", (unsigned int)ldap);
117 write_c_string (buf, printcharfun);
120 static struct Lisp_LDAP *
123 struct Lisp_LDAP *ldap =
124 alloc_lcrecord_type (struct Lisp_LDAP, lrecord_ldap);
133 finalize_ldap (void *header, int for_disksave)
135 struct Lisp_LDAP *ldap = (struct Lisp_LDAP *) header;
138 signal_simple_error ("Can't dump an emacs containing LDAP objects",
142 ldap_unbind (ldap->ld);
145 DEFINE_LRECORD_IMPLEMENTATION ("ldap", ldap,
146 mark_ldap, print_ldap, finalize_ldap,
147 NULL, NULL, struct Lisp_LDAP);
152 /************************************************************************/
153 /* Basic ldap accessors */
154 /************************************************************************/
156 DEFUN ("ldapp", Fldapp, 1, 1, 0, /*
157 Return t if OBJECT is a LDAP connection.
161 return LDAPP (object) ? Qt : Qnil;
164 DEFUN ("ldap-host", Fldap_host, 1, 1, 0, /*
165 Return the server host of the connection LDAP, as a string.
170 return (XLDAP (ldap))->host;
173 DEFUN ("ldap-live-p", Fldap_status, 1, 1, 0, /*
174 Return t if LDAP is an active LDAP connection.
179 return (XLDAP (ldap))->livep ? Qt : Qnil;
182 /************************************************************************/
183 /* Opening/Closing a LDAP connection */
184 /************************************************************************/
187 DEFUN ("ldap-open", Fldap_open, 1, 2, 0, /*
188 Open a LDAP connection to HOST.
189 PLIST is a plist containing additional parameters for the connection.
190 Valid keys in that list are:
191 `port' the TCP port to use for the connection if different from
193 `auth' is the authentication method to use, possible values depend on
194 the LDAP library XEmacs was compiled with: `simple', `krbv41' and `krbv42'.
195 `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax).
196 `passwd' is the password to use for simple authentication.
197 `deref' is one of the symbols `never', `always', `search' or `find'.
198 `timelimit' is the timeout limit for the connection in seconds.
199 `sizelimit' is the maximum number of matches to return.
203 /* This function can GC */
204 struct Lisp_LDAP *ldap;
207 int ldap_auth = LDAP_AUTH_SIMPLE;
208 char *ldap_binddn = NULL;
209 char *ldap_passwd = NULL;
210 int ldap_deref = LDAP_DEREF_NEVER;
211 int ldap_timelimit = 0;
212 int ldap_sizelimit = 0;
215 Lisp_Object list, keyword, value;
219 EXTERNAL_PROPERTY_LIST_LOOP (list, keyword, value, plist)
222 if (EQ (keyword, Qport))
225 ldap_port = XINT (value);
227 /* Authentication method */
228 if (EQ (keyword, Qauth))
230 if (EQ (value, Qsimple))
231 ldap_auth = LDAP_AUTH_SIMPLE;
232 #ifdef LDAP_AUTH_KRBV41
233 else if (EQ (value, Qkrbv41))
234 ldap_auth = LDAP_AUTH_KRBV41;
236 #ifdef LDAP_AUTH_KRBV42
237 else if (EQ (value, Qkrbv42))
238 ldap_auth = LDAP_AUTH_KRBV42;
241 signal_simple_error ("Invalid authentication method", value);
244 else if (EQ (keyword, Qbinddn))
246 CHECK_STRING (value);
247 ldap_binddn = alloca (XSTRING_LENGTH (value) + 1);
248 strcpy (ldap_binddn, (char *)XSTRING_DATA (value));
251 else if (EQ (keyword, Qpasswd))
253 CHECK_STRING (value);
254 ldap_passwd = alloca (XSTRING_LENGTH (value) + 1);
255 strcpy (ldap_passwd, (char *)XSTRING_DATA (value));
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);
458 alloca_array (char, 1 + XSTRING_LENGTH (current));
459 /* XSTRING_LENGTH is increased by one in order to copy the final 0 */
460 memcpy (ldap_attributes[i],
461 XSTRING_DATA (current), 1 + XSTRING_LENGTH (current));
464 ldap_attributes[i] = NULL;
467 /* Attributes only ? */
468 CHECK_SYMBOL (attrsonly);
470 /* Perform the search */
472 NILP (base) ? "" : (char *) XSTRING_DATA (base),
474 NILP (filter) ? "" : (char *) XSTRING_DATA (filter),
476 NILP (attrsonly) ? 0 : 1)
479 signal_ldap_error (ld);
482 /* Ensure we don't exit without cleaning up */
483 record_unwind_protect (ldap_search_unwind,
484 make_opaque_ptr (&unwind));
486 /* Build the results list */
489 /* ldap_result calls select() and can get wedged by EINTR signals */
490 slow_down_interrupts ();
491 rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &unwind.res);
492 speed_up_interrupts ();
493 while (rc == LDAP_RES_SEARCH_ENTRY)
497 e = ldap_first_entry (ld, unwind.res);
498 /* #### This call to message() is pretty fascist, because it
499 destroys the current echo area contents, even when invoked
500 from Lisp. It should use echo_area_message() instead, and
501 restore the old echo area contents later. */
502 message ("Parsing ldap results... %d", matches);
504 for (a= ldap_first_attribute (ld, e, &ptr);
506 a= ldap_next_attribute (ld, e, ptr) )
508 list = Fcons (build_ext_string (a, FORMAT_OS), Qnil);
509 unwind.vals = ldap_get_values (ld, e, a);
510 if (unwind.vals != NULL)
512 for (i = 0; unwind.vals[i] != NULL; i++)
514 list = Fcons (build_ext_string (unwind.vals[i], FORMAT_OS),
518 entry = Fcons (Fnreverse (list),
520 ldap_value_free (unwind.vals);
523 result = Fcons (Fnreverse (entry),
525 ldap_msgfree (unwind.res);
528 slow_down_interrupts ();
529 rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &(unwind.res));
530 speed_up_interrupts ();
535 signal_ldap_error (ld);
537 rc = ldap_result2error (ld, unwind.res, 0);
538 if ((rc != LDAP_SUCCESS) &&
539 (rc != LDAP_SIZELIMIT_EXCEEDED))
541 signal_ldap_error (ld);
544 ldap_msgfree (unwind.res);
545 unwind.res = (LDAPMessage *)NULL;
546 /* #### See above for calling message(). */
547 message ("Parsing ldap results... done");
549 unbind_to (speccount, Qnil);
551 return Fnreverse (result);
558 defsymbol (&Qldapp, "ldapp");
560 DEFSUBR (Fldap_host);
561 DEFSUBR (Fldap_status);
562 DEFSUBR (Fldap_open);
563 DEFSUBR (Fldap_close);
564 DEFSUBR (Fldap_search_internal);
570 Fprovide (intern ("ldap"));
572 ldap_default_port = LDAP_PORT;
573 Vldap_default_base = Qnil;
575 DEFVAR_INT ("ldap-default-port", &ldap_default_port /*
576 Default TCP port for LDAP connections.
577 Initialized from the LDAP library. Default value is 389.
580 DEFVAR_LISP ("ldap-default-base", &Vldap_default_base /*
581 Default base for LDAP searches.
582 This is a string using the syntax of RFC 1779.
583 For instance, "o=ACME, c=US" limits the search to the
584 Acme organization in the United States.