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