Mercurial > hg > xemacs-beta

comparison src/eldap.c @ 276:6330739388db r21-0b36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b36
author cvs
date Mon, 13 Aug 2007 10:30:37 +0200
parents c5d627a313b1
children 90d73dddcdc4
comparison
equal deleted inserted replaced
275:a68ae4439f57 276:6330739388db
33 #include "lisp.h" 33 #include "lisp.h"
34 34
35 #include <errno.h> 35 #include <errno.h>
36 #include <lber.h> 36 #include <lber.h>
37 #include <ldap.h> 37 #include <ldap.h>
38
39 #include "eldap.h"
38 40
39 #ifdef HAVE_NS_LDAP 41 #ifdef HAVE_NS_LDAP
40 #define HAVE_LDAP_SET_OPTION 1 42 #define HAVE_LDAP_SET_OPTION 1
41 #define HAVE_LDAP_GET_ERRNO 1 43 #define HAVE_LDAP_GET_ERRNO 1
42 #else 44 #else
43 #undef HAVE_LDAP_SET_OPTION 45 #undef HAVE_LDAP_SET_OPTION
44 #undef HAVE_LDAP_GET_ERRNO 46 #undef HAVE_LDAP_GET_ERRNO
45 #endif 47 #endif
46 48
49
50
51 static int ldap_default_port;
47 static Lisp_Object Vldap_default_base; 52 static Lisp_Object Vldap_default_base;
48 static Lisp_Object Vldap_default_host; 53
49 54 /* ldap-open plist keywords */
50 /* ldap-search-internal plist keywords */ 55 static Lisp_Object Qport, Qauth, Qbinddn, Qpasswd, Qderef, Qtimelimit,
51 static Lisp_Object Qhost, Qfilter, Qattributes, Qattrsonly, Qbase, Qscope, 56 Qsizelimit;
52 Qauth, Qbinddn, Qpasswd, Qderef, Qtimelimit, Qsizelimit;
53 /* Search scope limits */ 57 /* Search scope limits */
54 static Lisp_Object Qbase, Qonelevel, Qsubtree; 58 static Lisp_Object Qbase, Qonelevel, Qsubtree;
55 /* Authentication methods */ 59 /* Authentication methods */
56 #ifdef LDAP_AUTH_KRBV41 60 #ifdef LDAP_AUTH_KRBV41
57 static Lisp_Object Qkrbv41; 61 static Lisp_Object Qkrbv41;
60 static Lisp_Object Qkrbv42; 64 static Lisp_Object Qkrbv42;
61 #endif 65 #endif
62 /* Deref policy */ 66 /* Deref policy */
63 static Lisp_Object Qnever, Qalways, Qfind; 67 static Lisp_Object Qnever, Qalways, Qfind;
64 68
65 DEFUN ("ldap-search-internal", Fldap_search_internal, 1, 1, 0, /* 69 static Lisp_Object Qldapp;
66 Perform a search on a LDAP server. 70
67 SEARCH-PLIST is a property list describing the search request. 71
72 /************************************************************************/
73 /* Utility Functions */
74 /************************************************************************/
75
76 static void
77 signal_ldap_error (LDAP *ld)
78 {
79 #if HAVE_LDAP_GET_ERRNO
80 signal_simple_error
81 ("LDAP error",
82 build_string (ldap_err2string (ldap_get_lderrno (ld, NULL, NULL))));
83 #else
84 signal_simple_error ("LDAP error",
85 build_string (ldap_err2string (ld->ld_errno)));
86 #endif
87 }
88
89
90 /************************************************************************/
91 /* The ldap Lisp object */
92 /************************************************************************/
93
94 /*
95 * Structure records pertinent information about an open LDAP connection.
96 */
97
98 struct Lisp_LDAP
99 {
100 /* lcrecord header */
101 struct lcrecord_header header;
102 /* The LDAP connection handle used by the LDAP API */
103 LDAP *ld;
104 /* Name of the host we connected to */
105 Lisp_Object host;
106 /* Status of the LDAP connection.
107 This is a symbol: open or closed */
108 Lisp_Object status_symbol;
109 };
110
111
112
113 static Lisp_Object
114 mark_ldap (Lisp_Object obj, void (*markobj) (Lisp_Object))
115 {
116 struct Lisp_LDAP *ldap = XLDAP (obj);
117 ((markobj) (ldap->host));
118 return ldap->status_symbol;
119 }
120
121 static void
122 print_ldap (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
123 {
124 char buf[16];
125
126 struct Lisp_LDAP *ldap = XLDAP (obj);
127
128 if (print_readably)
129 error ("printing unreadable object #<ldap %s>",
130 XSTRING_DATA (ldap->host));
131
132 if (!escapeflag)
133 {
134 print_internal (ldap->host, printcharfun, 0);
135 }
136 else
137 {
138 write_c_string (GETTEXT ("#<ldap "), printcharfun);
139 print_internal (ldap->host, printcharfun, 1);
140 write_c_string (" state:",printcharfun);
141 print_internal (ldap->status_symbol, printcharfun, 1);
142 sprintf (buf, " 0x%x>", ldap);
143 write_c_string (buf, printcharfun);
144 }
145 }
146
147 static struct Lisp_LDAP *
148 allocate_ldap (void)
149 {
150 struct Lisp_LDAP *ldap =
151 alloc_lcrecord_type (struct Lisp_LDAP, lrecord_ldap);
152
153 ldap->ld = (LDAP *) NULL;
154 ldap->host = Qnil;
155 ldap->status_symbol = Qnil;
156 return ldap;
157 }
158
159 DEFINE_LRECORD_IMPLEMENTATION ("ldap", ldap,
160 mark_ldap, print_ldap, NULL,
161 NULL, NULL, struct Lisp_LDAP);
162
163
164
165
166 /************************************************************************/
167 /* Basic ldap accessors */
168 /************************************************************************/
169
170 DEFUN ("ldapp", Fldapp, 1, 1, 0, /*
171 Return t if OBJECT is a LDAP connection.
172 */
173 (object))
174 {
175 return LDAPP (object) ? Qt : Qnil;
176 }
177
178
179 DEFUN ("ldap-host", Fldap_host, 1, 1, 0, /*
180 Return the server host of the connection LDAP, as a string.
181 */
182 (ldap))
183 {
184 CHECK_LDAP (ldap);
185 return (XLDAP (ldap))->host;
186 }
187
188
189
190 DEFUN ("ldap-status", Fldap_status, 1, 1, 0, /*
191 Return the status of the connection LDAP.
192 This is a symbol, one of these:
193
194 open -- for a LDAP connection that is open.
195 closed -- for a LDAP connection that is closed.
196 */
197 (ldap))
198 {
199 CHECK_LDAP (ldap);
200 return (XLDAP (ldap))->status_symbol;
201 }
202
203
204
205 /************************************************************************/
206 /* Opening/Closing a LDAP connection */
207 /************************************************************************/
208
209
210 DEFUN ("ldap-open", Fldap_open, 1, 2, 0, /*
211 Open a LDAP connection to HOST.
212 PLIST is a plist containing additional parameters for the connection.
68 Valid keys in that list are: 213 Valid keys in that list are:
69 `host' is a string naming one or more (blank separated) LDAP servers to 214 `port' the TCP port to use for the connection if different from
70 to try to connect to. Each host name may optionally be of the form host:port. 215 `ldap-default-port'.
71 `filter' is a filter string for the search as described in RFC 1558
72 `attributes' is a list of strings indicating which attributes to retrieve
73 for each matching entry. If nil return all available attributes.
74 `attrsonly' if non-nil indicates that only the attributes are retrieved, not
75 the associated values.
76 `base' is the base for the search as described in RFC 1779.
77 `scope' is one of the three symbols `subtree', `base' or `onelevel'.
78 `auth' is the authentication method to use, possible values depend on 216 `auth' is the authentication method to use, possible values depend on
79 the LDAP library XEmacs was compiled with: `simple', `krbv41' and `krbv42'. 217 the LDAP library XEmacs was compiled with: `simple', `krbv41' and `krbv42'.
80 `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax). 218 `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax).
81 `passwd' is the password to use for simple authentication. 219 `passwd' is the password to use for simple authentication.
82 `deref' is one of the symbols `never', `always', `search' or `find'. 220 `deref' is one of the symbols `never', `always', `search' or `find'.
83 `timelimit' is the timeout limit for the connection in seconds. 221 `timelimit' is the timeout limit for the connection in seconds.
84 `sizelimit' is the maximum number of matches to return. 222 `sizelimit' is the maximum number of matches to return.
85 The function returns a list of matching entries. Each entry is itself
86 an alist of attribute/values.
87 */ 223 */
88 (search_plist)) 224 (host, plist))
89 { 225 {
90 /* This function calls lisp */ 226 /* This function can call lisp */
91 227
92 /* Vars for query */ 228 struct Lisp_LDAP *lisp_ldap;
93 LDAP *ld; 229 LDAP *ld;
94 LDAPMessage *res, *e; 230 int ldap_port = 0;
95 BerElement *ptr;
96 char *a;
97 int i, rc, err;
98
99 char *ldap_host = NULL;
100 char *ldap_filter = NULL;
101 char **ldap_attributes = NULL;
102 int ldap_attrsonly = 0;
103 char *ldap_base = NULL;
104 int ldap_scope = LDAP_SCOPE_SUBTREE;
105 int ldap_auth = LDAP_AUTH_SIMPLE; 231 int ldap_auth = LDAP_AUTH_SIMPLE;
106 char *ldap_binddn = NULL; 232 char *ldap_binddn = NULL;
107 char *ldap_passwd = NULL; 233 char *ldap_passwd = NULL;
108 int ldap_deref = LDAP_DEREF_NEVER; 234 int ldap_deref = LDAP_DEREF_NEVER;
109 int ldap_timelimit = 0; 235 int ldap_timelimit = 0;
110 int ldap_sizelimit = 0; 236 int ldap_sizelimit = 0;
111 237 int err;
112 char **vals = NULL; 238
113 int matches; 239 Lisp_Object ldap, list, keyword, value;
114 240 struct gcpro gcpro1;
115 Lisp_Object list, entry, result, keyword, value; 241
116 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; 242 ldap = Qnil;
117 243 GCPRO1 (ldap);
118 list = entry = result = keyword = value = Qnil; 244
119 GCPRO5 (list, entry, result, keyword, value); 245 CHECK_STRING (host);
120 246
121 247 EXTERNAL_PROPERTY_LIST_LOOP(list, keyword, value, plist)
122 EXTERNAL_PROPERTY_LIST_LOOP(list, keyword, value, search_plist) 248 {
123 { 249 /* TCP Port */
124 /* Host */ 250 if (EQ (keyword, Qport))
125 if (EQ (keyword, Qhost)) 251 {
126 { 252 CHECK_INT (value);
127 CHECK_STRING (value); 253 ldap_port = XINT (value);
128 ldap_host = alloca (XSTRING_LENGTH (value) + 1);
129 strcpy (ldap_host, (char *)XSTRING_DATA (value));
130 }
131 /* Filter */
132 else if (EQ (keyword, Qfilter))
133 {
134 CHECK_STRING (value);
135 ldap_filter = alloca (XSTRING_LENGTH (value) + 1);
136 strcpy (ldap_filter, (char *)XSTRING_DATA (value));
137 }
138 /* Attributes */
139 else if (EQ (keyword, Qattributes))
140 {
141 if (! NILP (value))
142 {
143 Lisp_Object attr_left = value;
144 struct gcpro ngcpro1;
145
146 NGCPRO1 (attr_left);
147 CHECK_CONS (value);
148
149 ldap_attributes = alloca ((XINT (Flength (value)) + 1)*sizeof (char *));
150
151 for (i=0; !NILP (attr_left); i++) {
152 CHECK_STRING (XCAR (attr_left));
153 ldap_attributes[i] = alloca (XSTRING_LENGTH (XCAR (attr_left)) + 1);
154 strcpy(ldap_attributes[i],
155 (char *)(XSTRING_DATA( XCAR (attr_left))));
156 attr_left = XCDR (attr_left);
157 }
158 ldap_attributes[i] = NULL;
159 NUNGCPRO;
160 }
161 }
162 /* Attributes Only */
163 else if (EQ (keyword, Qattrsonly))
164 {
165 CHECK_SYMBOL (value);
166 ldap_attrsonly = NILP (value) ? 0 : 1;
167 }
168 /* Base */
169 else if (EQ (keyword, Qbase))
170 {
171 if (!NILP (value))
172 {
173 CHECK_STRING (value);
174 ldap_base = alloca (XSTRING_LENGTH (value) + 1);
175 strcpy (ldap_base, (char *)XSTRING_DATA (value));
176 }
177 }
178 /* Scope */
179 else if (EQ (keyword, Qscope))
180 {
181 CHECK_SYMBOL (value);
182
183 if (EQ (value, Qbase))
184 ldap_scope = LDAP_SCOPE_BASE;
185 else if (EQ (value, Qonelevel))
186 ldap_scope = LDAP_SCOPE_ONELEVEL;
187 else if (EQ (value, Qsubtree))
188 ldap_scope = LDAP_SCOPE_SUBTREE;
189 else
190 signal_simple_error ("Invalid scope", value);
191 } 254 }
192 /* Authentication method */ 255 /* Authentication method */
193 else if (EQ (keyword, Qauth)) 256 if (EQ (keyword, Qauth))
194 { 257 {
195 CHECK_SYMBOL (value); 258 CHECK_SYMBOL (value);
196 259
197 if (EQ (value, Qsimple)) 260 if (EQ (value, Qsimple))
198 ldap_auth = LDAP_AUTH_SIMPLE; 261 ldap_auth = LDAP_AUTH_SIMPLE;
208 signal_simple_error ("Invalid authentication method", value); 271 signal_simple_error ("Invalid authentication method", value);
209 } 272 }
210 /* Bind DN */ 273 /* Bind DN */
211 else if (EQ (keyword, Qbinddn)) 274 else if (EQ (keyword, Qbinddn))
212 { 275 {
213 if (!NILP (value)) 276 CHECK_STRING (value);
214 { 277 ldap_binddn = alloca (XSTRING_LENGTH (value) + 1);
215 CHECK_STRING (value); 278 strcpy (ldap_binddn, (char *)XSTRING_DATA (value));
216 ldap_binddn = alloca (XSTRING_LENGTH (value) + 1);
217 strcpy (ldap_binddn, (char *)XSTRING_DATA (value));
218 }
219 } 279 }
220 /* Password */ 280 /* Password */
221 else if (EQ (keyword, Qpasswd)) 281 else if (EQ (keyword, Qpasswd))
222 { 282 {
223 if (!NILP (value)) 283 CHECK_STRING (value);
224 { 284 ldap_passwd = alloca (XSTRING_LENGTH (value) + 1);
225 CHECK_STRING (value); 285 strcpy (ldap_passwd, (char *)XSTRING_DATA (value));
226 ldap_passwd = alloca (XSTRING_LENGTH (value) + 1);
227 strcpy (ldap_passwd, (char *)XSTRING_DATA (value));
228 }
229 } 286 }
230 /* Deref */ 287 /* Deref */
231 else if (EQ (keyword, Qderef)) 288 else if (EQ (keyword, Qderef))
232 { 289 {
233 CHECK_SYMBOL (value); 290 CHECK_SYMBOL (value);
243 signal_simple_error ("Invalid deref value", value); 300 signal_simple_error ("Invalid deref value", value);
244 } 301 }
245 /* Timelimit */ 302 /* Timelimit */
246 else if (EQ (keyword, Qtimelimit)) 303 else if (EQ (keyword, Qtimelimit))
247 { 304 {
248 if (!NILP (value)) 305 CHECK_INT (value);
249 { 306 ldap_timelimit = XINT (value);
250 CHECK_INT (value);
251 ldap_timelimit = XINT (value);
252 }
253 } 307 }
254 /* Sizelimit */ 308 /* Sizelimit */
255 else if (EQ (keyword, Qsizelimit)) 309 else if (EQ (keyword, Qsizelimit))
256 { 310 {
257 if (!NILP (value)) 311 CHECK_INT (value);
258 { 312 ldap_sizelimit = XINT (value);
259 CHECK_INT (value); 313 }
260 ldap_sizelimit = XINT (value); 314 }
261 } 315
262 } 316 if (ldap_port == 0)
263 } 317 {
264 318 ldap_port = ldap_default_port;
265 /* Use ldap-default-base if no default base was given */ 319 }
266 if (ldap_base == NULL && !NILP (Vldap_default_base))
267 {
268 CHECK_STRING (Vldap_default_base);
269 ldap_base = alloca (XSTRING_LENGTH (Vldap_default_base) + 1);
270 strcpy (ldap_base, (char *)XSTRING_DATA (Vldap_default_base));
271 }
272
273 /* Use ldap-default-host if no host was given */
274 if (ldap_host == NULL && !NILP (Vldap_default_host))
275 {
276 CHECK_STRING (Vldap_default_host);
277 ldap_host = alloca (XSTRING_LENGTH (Vldap_default_host) + 1);
278 strcpy (ldap_host, (char *)XSTRING_DATA (Vldap_default_host));
279 }
280
281 if (ldap_filter == NULL)
282 error ("Empty search filter");
283
284 /* Garbage collect before connecting (if using UMich lib).
285 This is ugly, I know, but without this, the UMich LDAP library 3.3
286 frequently reports "Can't contact LDAP server". I really need to
287 check what happens inside that lib. Anyway this should be harmless to
288 XEmacs and makes things work. */
289 #if defined (HAVE_UMICH_LDAP)
290 garbage_collect_1 ();
291 #endif
292 320
293 /* Connect to the server and bind */ 321 /* Connect to the server and bind */
294 message ("Connecting to %s...", ldap_host); 322 ld = ldap_open ((char *)XSTRING_DATA (host), ldap_port);
295 if ( (ld = ldap_open (ldap_host, LDAP_PORT)) == NULL ) 323 if (ld == NULL )
296 signal_simple_error_2 ("Failed connecting to host", 324 signal_simple_error_2 ("Failed connecting to host",
297 build_string (ldap_host), 325 host,
298 lisp_strerror (errno)); 326 lisp_strerror (errno));
327
299 328
300 #if HAVE_LDAP_SET_OPTION 329 #if HAVE_LDAP_SET_OPTION
301 if (ldap_set_option (ld, LDAP_OPT_DEREF, (void *)&ldap_deref) != LDAP_SUCCESS) 330 if (ldap_set_option (ld, LDAP_OPT_DEREF, (void *)&ldap_deref) != LDAP_SUCCESS)
302 error ("Failed to set deref option"); 331 signal_ldap_error (ld);
303 if (ldap_set_option (ld, LDAP_OPT_TIMELIMIT, (void *)&ldap_timelimit) != LDAP_SUCCESS) 332 if (ldap_set_option (ld, LDAP_OPT_TIMELIMIT,
304 error ("Failed to set timelimit option"); 333 (void *)&ldap_timelimit) != LDAP_SUCCESS)
305 if (ldap_set_option (ld, LDAP_OPT_SIZELIMIT, (void *)&ldap_sizelimit) != LDAP_SUCCESS) 334 signal_ldap_error (ld);
306 error ("Failed to set sizelimit option"); 335 if (ldap_set_option (ld, LDAP_OPT_SIZELIMIT,
336 (void *)&ldap_sizelimit) != LDAP_SUCCESS)
337 signal_ldap_error (ld);
307 if (ldap_set_option (ld, LDAP_OPT_REFERRALS, LDAP_OPT_ON) != LDAP_SUCCESS) 338 if (ldap_set_option (ld, LDAP_OPT_REFERRALS, LDAP_OPT_ON) != LDAP_SUCCESS)
308 error ("Failed to set referral option"); 339 signal_ldap_error (ld);
309 #else /* HAVE_LDAP_SET_OPTION */ 340 #else /* HAVE_LDAP_SET_OPTION */
310 ld->ld_deref = ldap_deref; 341 ld->ld_deref = ldap_deref;
311 ld->ld_timelimit = ldap_timelimit; 342 ld->ld_timelimit = ldap_timelimit;
312 ld->ld_sizelimit = ldap_sizelimit; 343 ld->ld_sizelimit = ldap_sizelimit;
313 #ifdef LDAP_REFERRALS 344 #ifdef LDAP_REFERRALS
315 #else /* LDAP_REFERRALS */ 346 #else /* LDAP_REFERRALS */
316 ld->ld_options = 0; 347 ld->ld_options = 0;
317 #endif /* LDAP_REFERRALS */ 348 #endif /* LDAP_REFERRALS */
318 #endif /* HAVE_LDAP_SET_OPTION */ 349 #endif /* HAVE_LDAP_SET_OPTION */
319 350
320 message ("Binding to %s...", ldap_host); 351 /* ldap_bind_s calls select and may be wedged by spurious signals */
321 if ( (err = (ldap_bind_s (ld, ldap_binddn, ldap_passwd, ldap_auth ))) != LDAP_SUCCESS ) 352 slow_down_interrupts ();
353 err = ldap_bind_s (ld, ldap_binddn, ldap_passwd, ldap_auth);
354 speed_up_interrupts ();
355 if (err != LDAP_SUCCESS)
322 signal_simple_error ("Failed binding to the server", 356 signal_simple_error ("Failed binding to the server",
323 build_string (ldap_err2string (err))); 357 build_string (ldap_err2string (err)));
324 358
359 lisp_ldap = allocate_ldap ();
360 lisp_ldap->ld = ld;
361 lisp_ldap->host = host;
362 lisp_ldap->status_symbol = Qopen;
363 XSETLDAP (ldap,lisp_ldap);
364
365 UNGCPRO;
366 return ldap;
367 }
368
369
370
371 DEFUN ("ldap-close", Fldap_close, 1, 1, 0, /*
372 Close an LDAP connection.
373 Return t if the connection was actually closed or nil if
374 it was already closed before the call
375 */
376 (ldap))
377 {
378 CHECK_LDAP (ldap);
379 if ( EQ ((XLDAP (ldap))->status_symbol, Qopen) )
380 {
381 ldap_unbind ((XLDAP (ldap))->ld);
382 (XLDAP (ldap))->status_symbol = Qclosed;
383 return Qt;
384 }
385 return Qnil;
386 }
387
388
389
390 /************************************************************************/
391 /* Working on a LDAP connection */
392 /************************************************************************/
393
394 DEFUN ("ldap-search-internal", Fldap_search_internal, 2, 6, 0, /*
395 Perform a search on an open LDAP connection.
396 LDAP is an LDAP connection object created with `ldap-open'.
397 FILTER is a filter string for the search as described in RFC 1558
398 BASE is the distinguished name at which to start the search
399 SCOPE is an integer or a symbol indicating the scope of the search
400 Possible values are `ldap-scope-base', `ldap-scope-onelevel' or
401 `ldap-scope-subtree'
402 ATTRS is a list of strings indicating which attributes to retrieve
403 for each matching entry. If nil return all available attributes.
404 If ATTRSONLY is non-nil then only the attributes are retrieved, not
405 the associated values
406 The function returns a list of matching entries. Each entry is itself
407 an alist of attribute/values.
408 */
409 (ldap, filter, base, scope, attrs, attrsonly))
410 {
411 /* This function can call lisp */
412
413 /* Vars for query */
414 LDAP *ld;
415 LDAPMessage *res, *e;
416 BerElement *ptr;
417 char *a;
418 int i, rc, err;
419
420 char **vals = NULL;
421 int matches;
422
423 int ldap_scope = LDAP_SCOPE_SUBTREE;
424 char **ldap_attributes = NULL;
425
426 Lisp_Object list, entry, result;
427 struct gcpro gcpro1, gcpro2, gcpro3;
428
429 list = entry = result = Qnil;
430 GCPRO3(list, entry, result);
431
432 /* Do all the parameter checking */
433 CHECK_LIVE_LDAP (ldap);
434 ld = (XLDAP (ldap))->ld;
435
436 /* Filter */
437 CHECK_STRING (filter);
438
439 /* Search base */
440 if (NILP (base))
441 {
442 base = Vldap_default_base;
443 }
444 if (!NILP (base))
445 {
446 CHECK_STRING (Vldap_default_base);
447 }
448
449 /* Search scope */
450 if (!NILP (scope))
451 {
452 CHECK_SYMBOL (scope);
453 if (EQ (scope, Qbase))
454 ldap_scope = LDAP_SCOPE_BASE;
455 else if (EQ (scope, Qonelevel))
456 ldap_scope = LDAP_SCOPE_ONELEVEL;
457 else if (EQ (scope, Qsubtree))
458 ldap_scope = LDAP_SCOPE_SUBTREE;
459 else
460 signal_simple_error ("Invalid scope", scope);
461 }
462
463 /* Attributes to search */
464 if (!NILP (attrs))
465 {
466 Lisp_Object attr_left = attrs;
467 struct gcpro ngcpro1;
468
469 NGCPRO1 (attr_left);
470 CHECK_CONS (attrs);
471
472 ldap_attributes = alloca ((XINT (Flength (attrs)) + 1)*sizeof (char *));
473
474 for (i=0; !NILP (attr_left); i++) {
475 CHECK_STRING (XCAR (attr_left));
476 ldap_attributes[i] = alloca (XSTRING_LENGTH (XCAR (attr_left)) + 1);
477 strcpy(ldap_attributes[i],
478 (char *)(XSTRING_DATA( XCAR (attr_left))));
479 attr_left = XCDR (attr_left);
480 }
481 ldap_attributes[i] = NULL;
482 NUNGCPRO;
483 }
484
485 /* Attributes only ? */
486 CHECK_SYMBOL (attrsonly);
487
488
325 /* Perform the search */ 489 /* Perform the search */
326 message ("Searching with LDAP on %s...", ldap_host); 490 if (ldap_search (ld,
327 if ( ldap_search (ld, ldap_base, ldap_scope, ldap_filter, 491 NILP (base) ? "" : (char *) XSTRING_DATA (base),
328 ldap_attributes, ldap_attrsonly) == -1) 492 ldap_scope,
329 { 493 NILP (filter) ? "" : (char *) XSTRING_DATA (filter),
330 ldap_unbind (ld); 494 ldap_attributes,
331 #if HAVE_LDAP_GET_ERRNO 495 NILP (attrsonly) ? 0 : 1)
332 signal_simple_error ("Error during LDAP search", 496 == -1)
333 build_string (ldap_err2string (ldap_get_lderrno (ld, NULL, NULL)))); 497 {
334 #else 498 signal_ldap_error (ld);
335 signal_simple_error ("Error during LDAP search",
336 build_string (ldap_err2string (ld->ld_errno)));
337 #endif
338 } 499 }
339 500
340 /* Build the results list */ 501 /* Build the results list */
341 matches = 0; 502 matches = 0;
342 503
343 while ( (rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &res)) 504 /* ldap_result calls select() and can get wedged by EINTR signals */
344 == LDAP_RES_SEARCH_ENTRY ) 505 slow_down_interrupts ();
506 rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &res);
507 speed_up_interrupts ();
508 while ( rc == LDAP_RES_SEARCH_ENTRY )
345 { 509 {
346 matches ++; 510 matches ++;
347 e = ldap_first_entry (ld, res); 511 e = ldap_first_entry (ld, res);
348 message ("Parsing results... %d", matches); 512 message ("Parsing results... %d", matches);
349 entry = Qnil; 513 entry = Qnil;
366 ldap_value_free (vals); 530 ldap_value_free (vals);
367 } 531 }
368 result = Fcons (Fnreverse (entry), 532 result = Fcons (Fnreverse (entry),
369 result); 533 result);
370 ldap_msgfree (res); 534 ldap_msgfree (res);
535
536 slow_down_interrupts ();
537 rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &res);
538 speed_up_interrupts ();
371 } 539 }
372 540
373 if (rc == -1) 541 if (rc == -1)
374 { 542 {
375 #if HAVE_LDAP_GET_ERRNO 543 signal_ldap_error (ld);
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 } 544 }
383 545
384 if ((rc = ldap_result2error (ld, res, 0)) != LDAP_SUCCESS) 546 if ((rc = ldap_result2error (ld, res, 0)) != LDAP_SUCCESS)
385 { 547 {
386 #if HAVE_LDAP_GET_ERRNO 548 signal_ldap_error (ld);
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 } 549 }
394 550
395 ldap_msgfree (res); 551 ldap_msgfree (res);
396 ldap_unbind (ld);
397 message ("Done."); 552 message ("Done.");
398 553
399 result = Fnreverse (result); 554 result = Fnreverse (result);
400 clear_message (); 555 clear_message ();
401 556
405 560
406 561
407 void 562 void
408 syms_of_eldap (void) 563 syms_of_eldap (void)
409 { 564 {
410 DEFSUBR(Fldap_search_internal); 565 defsymbol (&Qldapp, "ldapp");
411 566
412 defsymbol (&Qhost, "host"); 567 DEFSUBR (Fldapp);
413 defsymbol (&Qfilter, "filter"); 568 DEFSUBR (Fldap_host);
414 defsymbol (&Qattributes, "attributes"); 569 DEFSUBR (Fldap_status);
415 defsymbol (&Qattrsonly, "attrsonly"); 570 DEFSUBR (Fldap_open);
416 defsymbol (&Qbase, "base"); 571 DEFSUBR (Fldap_close);
417 defsymbol (&Qscope, "scope"); 572 DEFSUBR (Fldap_search_internal);
418 defsymbol (&Qauth, "auth");
419 defsymbol (&Qbinddn, "binddn");
420 defsymbol (&Qpasswd, "passwd");
421 defsymbol (&Qderef, "deref");
422 defsymbol (&Qtimelimit, "timelimit");
423 defsymbol (&Qsizelimit, "sizelimit");
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 } 573 }
436 574
437 void 575 void
438 vars_of_eldap (void) 576 vars_of_eldap (void)
439 { 577 {
440 Fprovide (intern ("ldap-internal")); 578 Fprovide (intern ("ldap"));
441 579
442 DEFVAR_LISP ("ldap-default-host", &Vldap_default_host /* 580 ldap_default_port = LDAP_PORT;
443 Default LDAP host. 581 Vldap_default_base = Qnil;
582
583 DEFVAR_INT ("ldap-default-port", &ldap_default_port /*
584 Default TCP port for LDAP connections.
585 Initialized from the LDAP library. Default value is 389.
444 */ ); 586 */ );
445 587
446 DEFVAR_LISP ("ldap-default-base", &Vldap_default_base /* 588 DEFVAR_LISP ("ldap-default-base", &Vldap_default_base /*
447 Default base for LDAP searches. 589 Default base for LDAP searches.
448 This is a string using the syntax of RFC 1779. 590 This is a string using the syntax of RFC 1779.
449 For instance, "o=ACME, c=US" limits the search to the 591 For instance, "o=ACME, c=US" limits the search to the
450 Acme organization in the United States. 592 Acme organization in the United States.
451 */ ); 593 */ );
452 594
453 Vldap_default_host = Qnil; 595 }
454 Vldap_default_base = Qnil; 596
455 } 597