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