update.
[chise/xemacs-chise.git.1] / modules / ldap / eldap.c
1 /* LDAP client interface for XEmacs.
2    Copyright (C) 1998 Free Software Foundation, Inc.
3
4 This file is part of XEmacs.
5
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
9 later version.
10
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
14 for more details.
15
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.  */
20
21 /* Synched up with: Not in FSF. */
22
23 /* Author: Oscar Figueiredo */
24
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) */
30
31 #include <emodules.h>
32
33 #if defined (HAVE_LDAP)
34 /* The entire file is within this conditional */
35
36 #include "eldap.h"
37 #include <lber.h>
38 /* #### NEEDS REWRITE!
39    Thanks to Mats Lidell <matsl@xemacs.org> for the report & patch:
40    <871wgnqunm.fsf@spencer.lidell.homelinux.net>
41    "See http://www.openldap.org/faq/data/cache/1278.html.
42    Temporary workaround would be use the deprecated interface. Long term
43    solution is a rewrite." */
44 #define LDAP_DEPRECATED 1
45 #include <ldap.h>
46
47 #ifdef HAVE_NS_LDAP
48 #define HAVE_LDAP_SET_OPTION 1
49 #define HAVE_LDAP_GET_ERRNO 1
50 #else
51 #undef HAVE_LDAP_SET_OPTION
52 #undef HAVE_LDAP_GET_ERRNO
53 #endif
54
55 static Lisp_Object Vldap_default_base;
56 static Lisp_Object Vldap_default_host;
57
58 /* ldap-search-internal plist keywords */
59 static Lisp_Object Qhost, Qfilter, Qattributes, Qattrsonly, Qbase, Qscope,
60   Qauth, Qbinddn, Qpasswd, Qderef, Qtimelimit, Qsizelimit;
61 /* Search scope limits */
62 static Lisp_Object Qbase, Qonelevel, Qsubtree;
63 /* Authentication methods */
64 #ifdef LDAP_AUTH_KRBV41
65 static Lisp_Object Qkrbv41;
66 #endif
67 #ifdef LDAP_AUTH_KRBV42
68 static Lisp_Object Qkrbv42;
69 #endif
70 /* Deref policy */
71 static Lisp_Object Qnever, Qalways, Qfind;
72
73 DEFUN ("ldap-search-internal", Fldap_search_internal, 1, 1, 0, /*
74 Perform a search on a LDAP server.
75 SEARCH-PLIST is a property list describing the search request.
76 Valid keys in that list are:
77   `host' is a string naming one or more (blank separated) LDAP servers to
78 to try to connect to. Each host name may optionally be of the form host:port.
79   `filter' is a filter string for the search as described in RFC 1558
80   `attributes' is a list of strings indicating which attributes to retrieve
81 for each matching entry. If nil return all available attributes.
82   `attrsonly' if non-nil indicates that only the attributes are retrieved, not
83 the associated values.
84   `base' is the base for the search as described in RFC 1779.
85   `scope' is one of the three symbols `subtree', `base' or `onelevel'.
86   `auth' is the authentication method to use, possible values depend on
87 the LDAP library XEmacs was compiled with: `simple', `krbv41' and `krbv42'.
88   `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax).
89   `passwd' is the password to use for simple authentication.
90   `deref' is one of the symbols `never', `always', `search' or `find'.
91   `timelimit' is the timeout limit for the connection in seconds.
92   `sizelimit' is the maximum number of matches to return.
93 The function returns a list of matching entries.  Each entry is itself
94 an alist of attribute/values.
95 */
96        (search_plist))
97 {
98  /* This function calls lisp */
99
100   /* Vars for query */
101   LDAP *ld;
102   LDAPMessage *res, *e;
103   BerElement *ptr;
104   char *a;
105   int i, rc, err;
106
107   char *ldap_host = NULL;
108   char *ldap_filter = NULL;
109   char **ldap_attributes = NULL;
110   int  ldap_attrsonly = 0;
111   char *ldap_base = NULL;
112   int  ldap_scope = LDAP_SCOPE_SUBTREE;
113   int  ldap_auth = LDAP_AUTH_SIMPLE;
114   char *ldap_binddn = NULL;
115   char *ldap_passwd = NULL;
116   int  ldap_deref = LDAP_DEREF_NEVER;
117   int  ldap_timelimit = 0;
118   int  ldap_sizelimit = 0;
119
120   char **vals = NULL;
121   int  matches;
122
123   Lisp_Object list, entry, result, keyword, value;
124   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
125
126   list = entry = result = keyword = value = Qnil;
127   GCPRO5 (list, entry, result, keyword, value);
128
129
130   EXTERNAL_PROPERTY_LIST_LOOP(list, keyword, value, search_plist)
131     {
132       /* Host */
133       if (EQ (keyword, Qhost))
134         {
135           CHECK_STRING (value);
136           ldap_host = alloca (XSTRING_LENGTH (value) + 1);
137           strcpy (ldap_host, (char *)XSTRING_DATA (value));
138         }
139       /* Filter */
140       else if (EQ (keyword, Qfilter))
141         {
142           CHECK_STRING (value);
143           ldap_filter = alloca (XSTRING_LENGTH (value) + 1);
144           strcpy (ldap_filter, (char *)XSTRING_DATA (value));
145         }
146       /* Attributes */
147       else if (EQ (keyword, Qattributes))
148         {
149           if (! NILP (value))
150             {
151               Lisp_Object attr_left = value;
152               struct gcpro ngcpro1;
153
154               NGCPRO1 (attr_left);
155               CHECK_CONS (value);
156
157               ldap_attributes = alloca ((XINT (Flength (value)) + 1)*sizeof (char *));
158
159               for (i=0; !NILP (attr_left); i++) {
160                 CHECK_STRING (XCAR (attr_left));
161                 ldap_attributes[i] = alloca (XSTRING_LENGTH (XCAR (attr_left)) + 1);
162                 strcpy(ldap_attributes[i],
163                        (char *)(XSTRING_DATA( XCAR (attr_left))));
164                 attr_left = XCDR (attr_left);
165               }
166               ldap_attributes[i] = NULL;
167               NUNGCPRO;
168             }
169         }
170       /* Attributes Only */
171       else if (EQ (keyword, Qattrsonly))
172         {
173           CHECK_SYMBOL (value);
174           ldap_attrsonly = NILP (value) ? 0 : 1;
175         }
176       /* Base */
177       else if (EQ (keyword, Qbase))
178         {
179           if (!NILP (value))
180             {
181               CHECK_STRING (value);
182               ldap_base = alloca (XSTRING_LENGTH (value) + 1);
183               strcpy (ldap_base, (char *)XSTRING_DATA (value));
184             }
185         }
186       /* Scope */
187       else if (EQ (keyword, Qscope))
188         {
189           CHECK_SYMBOL (value);
190
191           if (EQ (value, Qbase))
192             ldap_scope = LDAP_SCOPE_BASE;
193           else if (EQ (value, Qonelevel))
194             ldap_scope = LDAP_SCOPE_ONELEVEL;
195           else if (EQ (value, Qsubtree))
196             ldap_scope = LDAP_SCOPE_SUBTREE;
197           else
198             signal_simple_error ("Invalid scope", value);
199         }
200       /* Authentication method */
201       else if (EQ (keyword, Qauth))
202         {
203           CHECK_SYMBOL (value);
204
205           if (EQ (value, Qsimple))
206             ldap_auth = LDAP_AUTH_SIMPLE;
207 #ifdef LDAP_AUTH_KRBV41
208           else if (EQ (value, Qkrbv41))
209             ldap_auth = LDAP_AUTH_KRBV41;
210 #endif
211 #ifdef LDAP_AUTH_KRBV42
212           else if (EQ (value, Qkrbv42))
213             ldap_auth = LDAP_AUTH_KRBV42;
214 #endif
215           else
216             signal_simple_error ("Invalid authentication method", value);
217         }
218       /* Bind DN */
219       else if (EQ (keyword, Qbinddn))
220         {
221           if (!NILP (value))
222             {
223               CHECK_STRING (value);
224               ldap_binddn = alloca (XSTRING_LENGTH (value) + 1);
225               strcpy (ldap_binddn, (char *)XSTRING_DATA (value));
226             }
227         }
228       /* Password */
229       else if (EQ (keyword, Qpasswd))
230         {
231           if (!NILP (value))
232             {
233               CHECK_STRING (value);
234               ldap_passwd = alloca (XSTRING_LENGTH (value) + 1);
235               strcpy (ldap_passwd, (char *)XSTRING_DATA (value));
236             }
237         }
238       /* Deref */
239       else if (EQ (keyword, Qderef))
240         {
241           CHECK_SYMBOL (value);
242           if (EQ (value, Qnever))
243             ldap_deref = LDAP_DEREF_NEVER;
244           else if (EQ (value, Qsearch))
245             ldap_deref = LDAP_DEREF_SEARCHING;
246           else if (EQ (value, Qfind))
247             ldap_deref = LDAP_DEREF_FINDING;
248           else if (EQ (value, Qalways))
249             ldap_deref = LDAP_DEREF_ALWAYS;
250           else
251             signal_simple_error ("Invalid deref value", value);
252         }
253       /* Timelimit */
254       else if (EQ (keyword, Qtimelimit))
255         {
256           if (!NILP (value))
257             {
258               CHECK_INT (value);
259               ldap_timelimit = XINT (value);
260             }
261         }
262       /* Sizelimit */
263       else if (EQ (keyword, Qsizelimit))
264         {
265           if (!NILP (value))
266             {
267               CHECK_INT (value);
268               ldap_sizelimit = XINT (value);
269             }
270         }
271     }
272
273   /* Use ldap-default-base if no default base was given */
274   if (ldap_base == NULL && !NILP (Vldap_default_base))
275     {
276       CHECK_STRING (Vldap_default_base);
277       ldap_base = alloca (XSTRING_LENGTH (Vldap_default_base) + 1);
278       strcpy (ldap_base, (char *)XSTRING_DATA (Vldap_default_base));
279     }
280
281   /* Use ldap-default-host if no host was given */
282   if (ldap_host == NULL && !NILP (Vldap_default_host))
283     {
284       CHECK_STRING (Vldap_default_host);
285       ldap_host = alloca (XSTRING_LENGTH (Vldap_default_host) + 1);
286       strcpy (ldap_host, (char *)XSTRING_DATA (Vldap_default_host));
287     }
288
289   if (ldap_filter == NULL)
290     error ("Empty search filter");
291
292   /* Garbage collect before connecting (if using UMich lib).
293      This is ugly, I know, but without this, the UMich LDAP library 3.3
294      frequently reports "Can't contact LDAP server".  I really need to
295      check what happens inside that lib. Anyway this should be harmless to
296      XEmacs and makes things work. */
297 #if defined (HAVE_UMICH_LDAP)
298   garbage_collect_1 ();
299 #endif
300
301   /* Connect to the server and bind */
302   message ("Connecting to %s...", ldap_host);
303   if ( (ld = ldap_open (ldap_host, LDAP_PORT)) == NULL )
304      signal_simple_error ("Failed connecting to host",
305                           build_string (ldap_host));
306
307 #if HAVE_LDAP_SET_OPTION
308   if (ldap_set_option (ld, LDAP_OPT_DEREF, (void *)&ldap_deref) != LDAP_SUCCESS)
309     error ("Failed to set deref option");
310   if (ldap_set_option (ld, LDAP_OPT_TIMELIMIT, (void *)&ldap_timelimit) != LDAP_SUCCESS)
311     error ("Failed to set timelimit option");
312   if (ldap_set_option (ld, LDAP_OPT_SIZELIMIT, (void *)&ldap_sizelimit) != LDAP_SUCCESS)
313     error ("Failed to set sizelimit option");
314   if (ldap_set_option (ld, LDAP_OPT_REFERRALS, LDAP_OPT_ON) != LDAP_SUCCESS)
315     error ("Failed to set referral option");
316 #else /* HAVE_LDAP_SET_OPTION */
317   ld->ld_deref = ldap_deref;
318   ld->ld_timelimit = ldap_timelimit;
319   ld->ld_sizelimit = ldap_sizelimit;
320 #ifdef LDAP_REFERRALS
321   ld->ld_options = LDAP_OPT_REFERRALS;
322 #else /* LDAP_REFERRALS */
323   ld->ld_options = 0;
324 #endif /* LDAP_REFERRALS */
325 #endif /* HAVE_LDAP_SET_OPTION */
326
327   message ("Binding to %s...", ldap_host);
328   if ( (err = (ldap_bind_s (ld, ldap_binddn, ldap_passwd, ldap_auth ))) != LDAP_SUCCESS )
329     signal_simple_error ("Failed binding to the server",
330                          build_string (ldap_err2string (err)));
331
332   /* Perform the search */
333   message ("Searching with LDAP on %s...", ldap_host);
334   if ( ldap_search (ld, ldap_base, ldap_scope, ldap_filter,
335                       ldap_attributes, ldap_attrsonly) == -1)
336     {
337       ldap_unbind (ld);
338 #if HAVE_LDAP_GET_ERRNO
339       signal_simple_error ("Error during LDAP search",
340                            build_string (ldap_err2string (ldap_get_lderrno (ld, NULL, NULL))));
341 #else
342       signal_simple_error ("Error during LDAP search",
343                            build_string (ldap_err2string (ld->ld_errno)));
344 #endif
345     }
346
347   /* Build the results list */
348   matches = 0;
349
350   while ( (rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &res))
351           == LDAP_RES_SEARCH_ENTRY )
352     {
353       matches ++;
354       e = ldap_first_entry (ld, res);
355       message ("Parsing results... %d", matches);
356       entry = Qnil;
357       for (a= ldap_first_attribute (ld, e, &ptr);
358            a != NULL;
359            a= ldap_next_attribute (ld, e, ptr) )
360         {
361           list = Fcons (build_string (a), Qnil);
362           vals = ldap_get_values (ld, e, a);
363           if (vals != NULL)
364             {
365               for (i=0; vals[i]!=NULL; i++)
366                 {
367                   list = Fcons (build_string (vals[i]),
368                                 list);
369                 }
370             }
371           entry = Fcons (Fnreverse (list),
372                          entry);
373           ldap_value_free (vals);
374         }
375       result = Fcons (Fnreverse (entry),
376                       result);
377       ldap_msgfree (res);
378     }
379
380   if (rc == -1)
381     {
382 #if HAVE_LDAP_GET_ERRNO
383       signal_simple_error ("Error retrieving result",
384                            build_string (ldap_err2string (ldap_get_lderrno (ld, NULL, NULL))));
385 #else
386       signal_simple_error ("Error retrieving result",
387                            build_string (ldap_err2string (ld->ld_errno)));
388 #endif
389     }
390
391   if ((rc = ldap_result2error (ld, res, 0)) != LDAP_SUCCESS)
392     {
393 #if HAVE_LDAP_GET_ERRNO
394       signal_simple_error ("Error on result",
395                            build_string (ldap_err2string (ldap_get_lderrno (ld, NULL, NULL))));
396 #else
397       signal_simple_error ("Error on result",
398                            build_string (ldap_err2string (ld->ld_errno)));
399 #endif
400     }
401
402   ldap_msgfree (res);
403   ldap_unbind (ld);
404   message ("Done.");
405
406   result = Fnreverse (result);
407   clear_message ();
408
409   UNGCPRO;
410   return result;
411 }
412
413 void
414 syms_of_ldap (void)
415 {
416   DEFSUBR(Fldap_search_internal);
417
418   defsymbol (&Qhost, "host");
419   defsymbol (&Qfilter, "filter");
420   defsymbol (&Qattributes, "attributes");
421   defsymbol (&Qattrsonly, "attrsonly");
422   defsymbol (&Qbase, "base");
423   defsymbol (&Qscope, "scope");
424   defsymbol (&Qauth, "auth");
425   defsymbol (&Qbinddn, "binddn");
426   defsymbol (&Qpasswd, "passwd");
427   defsymbol (&Qderef, "deref");
428   defsymbol (&Qtimelimit, "timelimit");
429   defsymbol (&Qsizelimit, "sizelimit");
430   defsymbol (&Qbase, "base");
431   defsymbol (&Qonelevel, "onelevel");
432   defsymbol (&Qsubtree, "subtree");
433 #ifdef LDAP_AUTH_KRBV41
434   defsymbol (&Qkrbv41, "krbv41");
435 #endif
436 #ifdef LDAP_AUTH_KRBV42
437   defsymbol (&Qkrbv42, "krbv42");
438 #endif
439   defsymbol (&Qnever, "never");
440   defsymbol (&Qalways, "always");
441   defsymbol (&Qfind, "find");
442 }
443
444 void
445 vars_of_ldap (void)
446 {
447   Fprovide (intern ("ldap-internal"));
448
449   DEFVAR_LISP ("ldap-default-host", &Vldap_default_host /*
450 Default LDAP host.
451 */ );
452
453   DEFVAR_LISP ("ldap-default-base", &Vldap_default_base /*
454 Default base for LDAP searches.
455 This is a string using the syntax of RFC 1779.
456 For instance, "o=ACME, c=US" limits the search to the
457 Acme organization in the United States.
458 */ );
459
460   Vldap_default_host =  Qnil;
461   Vldap_default_base =  Qnil;
462 }
463
464 #endif /* HAVE_LDAP */