Mercurial > hg > xemacs-beta
annotate modules/ldap/eldap.c @ 5602:c9e5612f5424
Support the MP library on recent FreeBSD, have it pass relevant tests.
src/ChangeLog addition:
2011-11-26 Aidan Kehoe <kehoea@parhasard.net>
* number-mp.c (bignum_to_string):
Don't overwrite the accumulator we've just set up for this
function.
* number-mp.c (BIGNUM_TO_TYPE):
mp_itom() doesn't necessarily do what this code used to think with
negative numbers, it can treat them as unsigned ints. Subtract
numbers from bignum_zero instead of multiplying them by -1 to
convert them to their negative equivalents.
* number-mp.c (bignum_to_int):
* number-mp.c (bignum_to_uint):
* number-mp.c (bignum_to_long):
* number-mp.c (bignum_to_ulong):
* number-mp.c (bignum_to_double):
Use the changed BIGNUM_TO_TYPE() in these functions.
* number-mp.c (bignum_ceil):
* number-mp.c (bignum_floor):
In these functions, be more careful about rounding to positive and
negative infinity, respectively. Don't use the sign of QUOTIENT
when working out out whether to add or subtract one, rather use
the sign QUOTIENT would have if arbitrary-precision division were
done.
* number-mp.h:
* number-mp.h (MP_GCD):
Wrap #include <mp.h> in BEGIN_C_DECLS/END_C_DECLS.
* number.c (Fbigfloat_get_precision):
* number.c (Fbigfloat_set_precision):
Don't attempt to call XBIGFLOAT_GET_PREC if this build doesn't
support big floats.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Sat, 26 Nov 2011 17:59:14 +0000 |
parents | 56144c8593a8 |
children |
rev | line source |
---|---|
428 | 1 /* LDAP client interface for XEmacs. |
2 Copyright (C) 1998 Free Software Foundation, Inc. | |
5125 | 3 Copyright (C) 2004, 2005, 2010 Ben Wing. |
2367 | 4 |
428 | 5 |
6 This file is part of XEmacs. | |
7 | |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5142
diff
changeset
|
8 XEmacs is free software: you can redistribute it and/or modify it |
428 | 9 under the terms of the GNU General Public License as published by the |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5142
diff
changeset
|
10 Free Software Foundation, either version 3 of the License, or (at your |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5142
diff
changeset
|
11 option) any later version. |
428 | 12 |
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
16 for more details. | |
17 | |
18 You should have received a copy of the GNU General Public License | |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5142
diff
changeset
|
19 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
428 | 20 |
21 /* Synched up with: Not in FSF. */ | |
22 | |
996 | 23 /* Author: Oscar Figueiredo with lots of support from Hrvoje Niksic */ |
428 | 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/) | |
996 | 29 - OpenLDAP 1.2 (http://www.openldap.org/) |
30 - Netscape's LDAP SDK (http://developer.netscape.com/) */ | |
31 | |
428 | 32 |
996 | 33 #include <config.h> |
34 #include "lisp.h" | |
35 #include "opaque.h" | |
36 #include "sysdep.h" | |
37 #include "buffer.h" | |
38 #include "process.h" /* for report_process_error */ | |
1632 | 39 #ifdef HAVE_SHLIB |
40 # include "emodules.h" | |
41 #endif | |
428 | 42 |
996 | 43 #include <errno.h> |
428 | 44 |
45 #include "eldap.h" | |
996 | 46 |
47 static Fixnum ldap_default_port; | |
48 static Lisp_Object Vldap_default_base; | |
49 | |
50 static Lisp_Object Qeldap; | |
428 | 51 |
996 | 52 /* Needed by the lrecord definition */ |
53 Lisp_Object Qldapp; | |
428 | 54 |
996 | 55 /* ldap-open plist keywords */ |
56 static Lisp_Object Qport, Qauth, Qbinddn, Qpasswd, Qderef, Qtimelimit, Qsizelimit; | |
428 | 57 /* Search scope limits */ |
58 static Lisp_Object Qbase, Qonelevel, Qsubtree; | |
59 /* Authentication methods */ | |
996 | 60 static Lisp_Object Qkrbv41, Qkrbv42; |
428 | 61 /* Deref policy */ |
62 static Lisp_Object Qnever, Qalways, Qfind; | |
996 | 63 /* Modification types (Qdelete is defined in general.c) */ |
64 static Lisp_Object Qadd, Qreplace; | |
428 | 65 |
996 | 66 |
67 /************************************************************************/ | |
68 /* Utility Functions */ | |
69 /************************************************************************/ | |
70 | |
2268 | 71 static DECLARE_DOESNT_RETURN (signal_ldap_error (LDAP *, LDAPMessage *, int)); |
72 | |
73 static DOESNT_RETURN | |
2286 | 74 signal_ldap_error (LDAP *ld, |
75 #if defined HAVE_LDAP_PARSE_RESULT || defined HAVE_LDAP_RESULT2ERROR | |
76 LDAPMessage *res, | |
77 #else | |
78 LDAPMessage *UNUSED (res), | |
79 #endif | |
80 int ldap_err) | |
996 | 81 { |
82 if (ldap_err <= 0) | |
83 { | |
84 #if defined HAVE_LDAP_PARSE_RESULT | |
85 int err; | |
86 ldap_err = ldap_parse_result (ld, res, | |
87 &err, | |
88 NULL, NULL, NULL, NULL, 0); | |
89 if (ldap_err == LDAP_SUCCESS) | |
90 ldap_err = err; | |
91 #elif defined HAVE_LDAP_GET_LDERRNO | |
92 ldap_err = ldap_get_lderrno (ld, NULL, NULL); | |
93 #elif defined HAVE_LDAP_RESULT2ERROR | |
94 ldap_err = ldap_result2error (ld, res, 0); | |
95 #else | |
96 ldap_err = ld->ld_errno; | |
97 #endif | |
98 } | |
99 invalid_operation ("LDAP error", | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
100 build_extstring (ldap_err2string (ldap_err), Qnative)); |
996 | 101 } |
102 | |
103 | |
104 /************************************************************************/ | |
105 /* ldap lrecord basic functions */ | |
106 /************************************************************************/ | |
107 | |
108 static Lisp_Object | |
109 make_ldap (Lisp_LDAP *ldap) | |
110 { | |
111 return wrap_ldap (ldap); | |
112 } | |
113 | |
1220 | 114 static const struct memory_description ldap_description [] = { |
996 | 115 { XD_LISP_OBJECT, offsetof (struct Lisp_LDAP, host) }, |
116 { XD_END } | |
117 }; | |
118 | |
119 static Lisp_Object | |
120 mark_ldap (Lisp_Object obj) | |
121 { | |
122 return XLDAP (obj)->host; | |
123 } | |
124 | |
125 static void | |
2286 | 126 print_ldap (Lisp_Object obj, Lisp_Object printcharfun, int UNUSED (escapeflag)) |
996 | 127 { |
128 Lisp_LDAP *ldap = XLDAP (obj); | |
129 | |
130 if (print_readably) | |
5142
f965e31a35f0
reduce lcrecord headers to 2 words, rename printing_unreadable_object
Ben Wing <ben@xemacs.org>
parents:
5141
diff
changeset
|
131 printing_unreadable_object_fmt ("#<ldap %s>", XSTRING_DATA (ldap->host)); |
996 | 132 |
133 write_fmt_string_lisp (printcharfun, "#<ldap %S", 1, ldap->host); | |
134 if (!ldap->ld) | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4824
diff
changeset
|
135 write_ascstring (printcharfun,"(dead) "); |
996 | 136 write_fmt_string (printcharfun, " 0x%lx>", (long)ldap); |
137 } | |
138 | |
139 static Lisp_LDAP * | |
140 allocate_ldap (void) | |
141 { | |
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
142 Lisp_LDAP *ldap = XLDAP (ALLOC_NORMAL_LISP_OBJECT (ldap)); |
996 | 143 |
144 ldap->ld = NULL; | |
145 ldap->host = Qnil; | |
146 return ldap; | |
147 } | |
148 | |
149 static void | |
5141
0dcd22290039
fix issues with finalizers in number.c, postgresql, ldap
Ben Wing <ben@xemacs.org>
parents:
5127
diff
changeset
|
150 finalize_ldap (Lisp_Object obj) |
996 | 151 { |
5141
0dcd22290039
fix issues with finalizers in number.c, postgresql, ldap
Ben Wing <ben@xemacs.org>
parents:
5127
diff
changeset
|
152 Lisp_LDAP *ldap = XLDAP (obj); |
996 | 153 |
154 if (ldap->ld) | |
155 ldap_unbind (ldap->ld); | |
156 ldap->ld = NULL; | |
157 } | |
158 | |
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
159 DEFINE_NODUMP_LISP_OBJECT ("ldap", ldap, mark_ldap, |
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
160 print_ldap, finalize_ldap, |
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
161 NULL, NULL, ldap_description, |
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
162 Lisp_LDAP); |
996 | 163 |
164 /************************************************************************/ | |
165 /* Basic ldap accessors */ | |
166 /************************************************************************/ | |
167 | |
168 /* ###autoload */ | |
169 DEFUN ("ldapp", Fldapp, 1, 1, 0, /* | |
170 Return t if OBJECT is a LDAP connection. | |
171 */ | |
172 (object)) | |
173 { | |
174 return LDAPP (object) ? Qt : Qnil; | |
175 } | |
176 | |
177 DEFUN ("ldap-host", Fldap_host, 1, 1, 0, /* | |
178 Return the server host of the connection LDAP, as a string. | |
179 */ | |
180 (ldap)) | |
181 { | |
182 CHECK_LDAP (ldap); | |
183 return (XLDAP (ldap))->host; | |
184 } | |
185 | |
186 DEFUN ("ldap-live-p", Fldap_live_p, 1, 1, 0, /* | |
187 Return t if LDAP is an active LDAP connection. | |
188 */ | |
189 (ldap)) | |
190 { | |
191 CHECK_LDAP (ldap); | |
192 return (XLDAP (ldap))->ld ? Qt : Qnil; | |
193 } | |
194 | |
195 /************************************************************************/ | |
196 /* Opening/Closing a LDAP connection */ | |
197 /************************************************************************/ | |
198 | |
199 | |
200 /* ###autoload */ | |
201 DEFUN ("ldap-open", Fldap_open, 1, 2, 0, /* | |
202 Open a LDAP connection to HOST. | |
203 PLIST is a plist containing additional parameters for the connection. | |
428 | 204 Valid keys in that list are: |
996 | 205 `port' the TCP port to use for the connection if different from |
206 `ldap-default-port'. | |
428 | 207 `auth' is the authentication method to use, possible values depend on |
208 the LDAP library XEmacs was compiled with: `simple', `krbv41' and `krbv42'. | |
209 `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax). | |
210 `passwd' is the password to use for simple authentication. | |
211 `deref' is one of the symbols `never', `always', `search' or `find'. | |
212 `timelimit' is the timeout limit for the connection in seconds. | |
213 `sizelimit' is the maximum number of matches to return. | |
214 */ | |
996 | 215 (host, plist)) |
428 | 216 { |
996 | 217 /* This function can GC */ |
218 Lisp_LDAP *ldap; | |
428 | 219 LDAP *ld; |
996 | 220 int ldap_port = 0; |
428 | 221 int ldap_auth = LDAP_AUTH_SIMPLE; |
2367 | 222 Extbyte *ldap_binddn = NULL; |
223 Extbyte *ldap_password = NULL; | |
428 | 224 int ldap_deref = LDAP_DEREF_NEVER; |
225 int ldap_timelimit = 0; | |
226 int ldap_sizelimit = 0; | |
996 | 227 int err; |
428 | 228 |
996 | 229 CHECK_STRING (host); |
428 | 230 |
996 | 231 { |
232 EXTERNAL_PROPERTY_LIST_LOOP_3 (keyword, value, plist) | |
233 { | |
234 /* TCP Port */ | |
235 if (EQ (keyword, Qport)) | |
236 { | |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
237 CHECK_FIXNUM (value); |
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
238 ldap_port = XFIXNUM (value); |
996 | 239 } |
240 /* Authentication method */ | |
241 if (EQ (keyword, Qauth)) | |
242 { | |
243 if (EQ (value, Qsimple)) | |
244 ldap_auth = LDAP_AUTH_SIMPLE; | |
428 | 245 #ifdef LDAP_AUTH_KRBV41 |
996 | 246 else if (EQ (value, Qkrbv41)) |
247 ldap_auth = LDAP_AUTH_KRBV41; | |
428 | 248 #endif |
249 #ifdef LDAP_AUTH_KRBV42 | |
996 | 250 else if (EQ (value, Qkrbv42)) |
251 ldap_auth = LDAP_AUTH_KRBV42; | |
428 | 252 #endif |
996 | 253 else |
254 invalid_constant ("Invalid authentication method", value); | |
255 } | |
256 /* Bind DN */ | |
257 else if (EQ (keyword, Qbinddn)) | |
258 { | |
259 CHECK_STRING (value); | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
260 ldap_binddn = LISP_STRING_TO_EXTERNAL (value, Qnative); |
996 | 261 } |
262 /* Password */ | |
263 else if (EQ (keyword, Qpasswd)) | |
264 { | |
265 CHECK_STRING (value); | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
266 ldap_password = LISP_STRING_TO_EXTERNAL (value, Qnative); |
996 | 267 } |
268 /* Deref */ | |
269 else if (EQ (keyword, Qderef)) | |
270 { | |
271 if (EQ (value, Qnever)) | |
272 ldap_deref = LDAP_DEREF_NEVER; | |
273 else if (EQ (value, Qsearch)) | |
274 ldap_deref = LDAP_DEREF_SEARCHING; | |
275 else if (EQ (value, Qfind)) | |
276 ldap_deref = LDAP_DEREF_FINDING; | |
277 else if (EQ (value, Qalways)) | |
278 ldap_deref = LDAP_DEREF_ALWAYS; | |
279 else | |
280 invalid_constant ("Invalid deref value", value); | |
281 } | |
282 /* Timelimit */ | |
283 else if (EQ (keyword, Qtimelimit)) | |
284 { | |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
285 CHECK_FIXNUM (value); |
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
286 ldap_timelimit = XFIXNUM (value); |
996 | 287 } |
288 /* Sizelimit */ | |
289 else if (EQ (keyword, Qsizelimit)) | |
290 { | |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
291 CHECK_FIXNUM (value); |
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
292 ldap_sizelimit = XFIXNUM (value); |
996 | 293 } |
294 } | |
295 } | |
296 | |
297 if (ldap_port == 0) | |
298 { | |
299 ldap_port = ldap_default_port; | |
428 | 300 } |
301 | |
996 | 302 /* Connect to the server and bind */ |
303 slow_down_interrupts (); | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
304 ld = ldap_open (LISP_STRING_TO_EXTERNAL (host, Qnative), ldap_port); |
996 | 305 speed_up_interrupts (); |
428 | 306 |
996 | 307 if (ld == NULL ) |
308 report_process_error ("Failed connecting to host", host); | |
428 | 309 |
996 | 310 #ifdef HAVE_LDAP_SET_OPTION |
311 if ((err = ldap_set_option (ld, LDAP_OPT_DEREF, | |
312 (void *)&ldap_deref)) != LDAP_SUCCESS) | |
313 signal_ldap_error (ld, NULL, err); | |
314 if ((err = ldap_set_option (ld, LDAP_OPT_TIMELIMIT, | |
315 (void *)&ldap_timelimit)) != LDAP_SUCCESS) | |
316 signal_ldap_error (ld, NULL, err); | |
317 if ((err = ldap_set_option (ld, LDAP_OPT_SIZELIMIT, | |
318 (void *)&ldap_sizelimit)) != LDAP_SUCCESS) | |
319 signal_ldap_error (ld, NULL, err); | |
320 if ((err = ldap_set_option (ld, LDAP_OPT_REFERRALS, | |
321 LDAP_OPT_ON)) != LDAP_SUCCESS) | |
322 signal_ldap_error (ld, NULL, err); | |
323 if ((err = ldap_set_option (ld, LDAP_OPT_RESTART, | |
324 LDAP_OPT_ON)) != LDAP_SUCCESS) | |
325 signal_ldap_error (ld, NULL, err); | |
326 #else /* not HAVE_LDAP_SET_OPTION */ | |
428 | 327 ld->ld_deref = ldap_deref; |
328 ld->ld_timelimit = ldap_timelimit; | |
329 ld->ld_sizelimit = ldap_sizelimit; | |
330 #ifdef LDAP_REFERRALS | |
331 ld->ld_options = LDAP_OPT_REFERRALS; | |
996 | 332 #else /* not LDAP_REFERRALS */ |
428 | 333 ld->ld_options = 0; |
996 | 334 #endif /* not LDAP_REFERRALS */ |
335 /* XEmacs uses interrupts (SIGIO,SIGALRM), LDAP calls need to ignore them */ | |
336 ld->ld_options |= LDAP_OPT_RESTART; | |
337 #endif /* not HAVE_LDAP_SET_OPTION */ | |
338 | |
2272 | 339 err = ldap_bind_s (ld, ldap_binddn, ldap_password, ldap_auth); |
996 | 340 if (err != LDAP_SUCCESS) |
341 { | |
342 signal_error (Qprocess_error, "Failed binding to the server", | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
343 build_extstring (ldap_err2string (err), Qnative)); |
996 | 344 } |
345 | |
346 ldap = allocate_ldap (); | |
347 ldap->ld = ld; | |
348 ldap->host = host; | |
349 | |
350 return make_ldap (ldap); | |
351 } | |
352 | |
353 | |
354 | |
355 DEFUN ("ldap-close", Fldap_close, 1, 1, 0, /* | |
356 Close an LDAP connection. | |
357 */ | |
358 (ldap)) | |
359 { | |
360 Lisp_LDAP *lldap; | |
361 CHECK_LIVE_LDAP (ldap); | |
362 lldap = XLDAP (ldap); | |
363 ldap_unbind (lldap->ld); | |
364 lldap->ld = NULL; | |
365 return Qnil; | |
366 } | |
367 | |
368 | |
369 | |
370 /************************************************************************/ | |
371 /* Working on a LDAP connection */ | |
372 /************************************************************************/ | |
373 struct ldap_unwind_struct | |
374 { | |
375 LDAPMessage *res; | |
376 struct berval **vals; | |
377 }; | |
378 | |
379 static Lisp_Object | |
380 ldap_search_unwind (Lisp_Object unwind_obj) | |
381 { | |
382 struct ldap_unwind_struct *unwind = | |
383 (struct ldap_unwind_struct *) get_opaque_ptr (unwind_obj); | |
384 if (unwind->res) | |
385 ldap_msgfree (unwind->res); | |
386 if (unwind->vals) | |
387 ldap_value_free_len (unwind->vals); | |
388 return Qnil; | |
389 } | |
390 | |
391 /* The following function is called `ldap-search-basic' instead of */ | |
392 /* plain `ldap-search' to maintain compatibility with the XEmacs 21.1 */ | |
393 /* API where `ldap-search' was the name of the high-level search */ | |
394 /* function */ | |
428 | 395 |
996 | 396 DEFUN ("ldap-search-basic", Fldap_search_basic, 2, 8, 0, /* |
397 Perform a search on an open LDAP connection. | |
398 LDAP is an LDAP connection object created with `ldap-open'. | |
399 FILTER is a filter string for the search as described in RFC 1558. | |
400 BASE is the distinguished name at which to start the search. | |
401 SCOPE is one of the symbols `base', `onelevel' or `subtree' indicating | |
402 the scope of the search. | |
403 ATTRS is a list of strings indicating which attributes to retrieve | |
404 for each matching entry. If nil return all available attributes. | |
405 If ATTRSONLY is non-nil then only the attributes are retrieved, not | |
406 the associated values. | |
407 If WITHDN is non-nil each entry in the result will be prepended with | |
408 its distinguished name DN. | |
409 If VERBOSE is non-nil progress messages will be echoed. | |
410 The function returns a list of matching entries. Each entry is itself | |
411 an alist of attribute/value pairs optionally preceded by the DN of the | |
412 entry according to the value of WITHDN. | |
413 */ | |
414 (ldap, filter, base, scope, attrs, attrsonly, withdn, verbose)) | |
415 { | |
416 /* This function can GC */ | |
417 | |
418 /* Vars for query */ | |
419 LDAP *ld; | |
420 LDAPMessage *e; | |
421 BerElement *ptr; | |
4710
3a87551bfeb5
Fixes for a number of minor warnings issued by gcc. See xemacs-patches message
Jerry James <james@xemacs.org>
parents:
3029
diff
changeset
|
422 Extbyte *a, *dn, *bs, *filt; |
996 | 423 int i, rc; |
424 int matches; | |
425 struct ldap_unwind_struct unwind; | |
426 | |
427 int ldap_scope = LDAP_SCOPE_SUBTREE; | |
2367 | 428 Extbyte **ldap_attributes = NULL; |
996 | 429 |
430 int speccount = specpdl_depth (); | |
431 | |
432 Lisp_Object list = Qnil; | |
433 Lisp_Object entry = Qnil; | |
434 Lisp_Object result = Qnil; | |
435 struct gcpro gcpro1, gcpro2, gcpro3; | |
436 | |
437 GCPRO3 (list, entry, result); | |
438 | |
439 unwind.res = NULL; | |
440 unwind.vals = NULL; | |
441 | |
442 /* Do all the parameter checking */ | |
443 CHECK_LIVE_LDAP (ldap); | |
444 ld = XLDAP (ldap)->ld; | |
445 | |
446 /* Filter */ | |
447 CHECK_STRING (filter); | |
448 | |
449 /* Search base */ | |
450 if (NILP (base)) | |
451 { | |
452 base = Vldap_default_base; | |
453 } | |
454 if (!NILP (base)) | |
455 { | |
456 CHECK_STRING (base); | |
457 } | |
458 | |
459 /* Search scope */ | |
460 if (!NILP (scope)) | |
461 { | |
462 if (EQ (scope, Qbase)) | |
463 ldap_scope = LDAP_SCOPE_BASE; | |
464 else if (EQ (scope, Qonelevel)) | |
465 ldap_scope = LDAP_SCOPE_ONELEVEL; | |
466 else if (EQ (scope, Qsubtree)) | |
467 ldap_scope = LDAP_SCOPE_SUBTREE; | |
468 else | |
469 invalid_constant ("Invalid scope", scope); | |
470 } | |
471 | |
472 /* Attributes to search */ | |
473 if (!NILP (attrs)) | |
474 { | |
475 CHECK_CONS (attrs); | |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
476 ldap_attributes = alloca_array (char *, 1 + XFIXNUM (Flength (attrs))); |
996 | 477 |
478 i = 0; | |
2367 | 479 { |
480 EXTERNAL_LIST_LOOP_2 (current, attrs) | |
481 { | |
482 CHECK_STRING (current); | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
483 ldap_attributes[i] = LISP_STRING_TO_EXTERNAL (current, Qnative); |
2367 | 484 ++i; |
485 } | |
486 } | |
996 | 487 ldap_attributes[i] = NULL; |
488 } | |
489 | |
490 /* Attributes only ? */ | |
491 CHECK_SYMBOL (attrsonly); | |
428 | 492 |
493 /* Perform the search */ | |
4824
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4710
diff
changeset
|
494 bs = NILP (base) ? (Extbyte *) "" : |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
495 LISP_STRING_TO_EXTERNAL (base, Qnative); |
4824
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4710
diff
changeset
|
496 filt = NILP (filter) ? (Extbyte *) "" : |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
497 LISP_STRING_TO_EXTERNAL (filter, Qnative); |
4710
3a87551bfeb5
Fixes for a number of minor warnings issued by gcc. See xemacs-patches message
Jerry James <james@xemacs.org>
parents:
3029
diff
changeset
|
498 if (ldap_search (ld, bs, ldap_scope, filt, ldap_attributes, |
3a87551bfeb5
Fixes for a number of minor warnings issued by gcc. See xemacs-patches message
Jerry James <james@xemacs.org>
parents:
3029
diff
changeset
|
499 NILP (attrsonly) ? 0 : 1) |
996 | 500 == -1) |
428 | 501 { |
996 | 502 signal_ldap_error (ld, NULL, 0); |
428 | 503 } |
504 | |
996 | 505 /* Ensure we don't exit without cleaning up */ |
506 record_unwind_protect (ldap_search_unwind, | |
507 make_opaque_ptr (&unwind)); | |
508 | |
428 | 509 /* Build the results list */ |
510 matches = 0; | |
511 | |
996 | 512 rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &unwind.res); |
513 | |
514 while (rc == LDAP_RES_SEARCH_ENTRY) | |
428 | 515 { |
996 | 516 QUIT; |
428 | 517 matches ++; |
996 | 518 e = ldap_first_entry (ld, unwind.res); |
519 /* #### This call to message() is pretty fascist, because it | |
520 destroys the current echo area contents, even when invoked | |
521 from Lisp. It should use echo_area_message() instead, and | |
522 restore the old echo area contents later. */ | |
523 if (! NILP (verbose)) | |
524 message ("Parsing ldap results... %d", matches); | |
428 | 525 entry = Qnil; |
996 | 526 /* Get the DN if required */ |
527 if (! NILP (withdn)) | |
528 { | |
529 dn = ldap_get_dn (ld, e); | |
530 if (dn == NULL) | |
531 signal_ldap_error (ld, e, 0); | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
532 entry = Fcons (build_extstring (dn, Qnative), Qnil); |
996 | 533 } |
2367 | 534 for (a = ldap_first_attribute (ld, e, &ptr); |
428 | 535 a != NULL; |
2367 | 536 a = ldap_next_attribute (ld, e, ptr)) |
428 | 537 { |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
538 list = Fcons (build_extstring (a, Qnative), Qnil); |
996 | 539 unwind.vals = ldap_get_values_len (ld, e, a); |
540 if (unwind.vals != NULL) | |
428 | 541 { |
996 | 542 for (i = 0; unwind.vals[i] != NULL; i++) |
428 | 543 { |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
544 list = Fcons (make_extstring ((Extbyte *) unwind.vals[i]->bv_val, |
996 | 545 unwind.vals[i]->bv_len, |
546 Qnative), | |
428 | 547 list); |
548 } | |
549 } | |
550 entry = Fcons (Fnreverse (list), | |
551 entry); | |
996 | 552 ldap_value_free_len (unwind.vals); |
553 unwind.vals = NULL; | |
428 | 554 } |
555 result = Fcons (Fnreverse (entry), | |
556 result); | |
996 | 557 ldap_msgfree (unwind.res); |
558 unwind.res = NULL; | |
428 | 559 |
996 | 560 rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &(unwind.res)); |
428 | 561 } |
562 | |
996 | 563 #if defined HAVE_LDAP_PARSE_RESULT |
564 { | |
565 int rc2 = ldap_parse_result (ld, unwind.res, | |
566 &rc, | |
567 NULL, NULL, NULL, NULL, 0); | |
568 if (rc2 != LDAP_SUCCESS) | |
569 rc = rc2; | |
570 } | |
428 | 571 #else |
996 | 572 if (rc == 0) |
573 signal_ldap_error (ld, NULL, LDAP_TIMELIMIT_EXCEEDED); | |
574 | |
575 if (rc == -1) | |
576 signal_ldap_error (ld, unwind.res, (unwind.res==NULL) ? ld->ld_errno : 0); | |
577 | |
578 #if defined HAVE_LDAP_RESULT2ERROR | |
579 rc = ldap_result2error (ld, unwind.res, 0); | |
580 #endif | |
428 | 581 #endif |
996 | 582 |
583 if (rc != LDAP_SUCCESS) | |
584 signal_ldap_error (ld, NULL, rc); | |
585 | |
586 ldap_msgfree (unwind.res); | |
587 unwind.res = (LDAPMessage *)NULL; | |
588 | |
589 /* #### See above for calling message(). */ | |
590 if (! NILP (verbose)) | |
591 message ("Parsing ldap results... done"); | |
592 | |
593 unbind_to (speccount); | |
594 UNGCPRO; | |
595 return Fnreverse (result); | |
596 } | |
597 | |
598 DEFUN ("ldap-add", Fldap_add, 3, 3, 0, /* | |
599 Add an entry to an LDAP directory. | |
600 LDAP is an LDAP connection object created with `ldap-open'. | |
601 DN is the distinguished name of the entry to add. | |
602 ENTRY is an entry specification, i.e., a list of cons cells | |
603 containing attribute/value string pairs. | |
604 */ | |
605 (ldap, dn, entry)) | |
606 { | |
607 LDAP *ld; | |
608 LDAPMod *ldap_mods, **ldap_mods_ptrs; | |
609 struct berval *bervals; | |
610 int rc; | |
611 int i, j; | |
612 Elemcount len; | |
613 Lisp_Object values = Qnil; | |
2367 | 614 struct gcpro gcpro1; |
996 | 615 |
2367 | 616 GCPRO1 (values); |
996 | 617 |
618 /* Do all the parameter checking */ | |
619 CHECK_LIVE_LDAP (ldap); | |
620 ld = XLDAP (ldap)->ld; | |
621 | |
622 /* Check the DN */ | |
623 CHECK_STRING (dn); | |
624 | |
625 /* Check the entry */ | |
626 CHECK_CONS (entry); | |
627 if (NILP (entry)) | |
628 invalid_operation ("Cannot add void entry", entry); | |
428 | 629 |
996 | 630 /* Build the ldap_mods array */ |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
631 len = (Elemcount) XFIXNUM (Flength (entry)); |
996 | 632 ldap_mods = alloca_array (LDAPMod, len); |
633 ldap_mods_ptrs = alloca_array (LDAPMod *, 1 + len); | |
634 i = 0; | |
2367 | 635 |
636 { | |
637 EXTERNAL_LIST_LOOP_2 (current, entry) | |
638 { | |
639 CHECK_CONS (current); | |
640 CHECK_STRING (XCAR (current)); | |
641 ldap_mods_ptrs[i] = &(ldap_mods[i]); | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
642 ldap_mods[i].mod_type = |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
643 LISP_STRING_TO_EXTERNAL (XCAR (current), Qnative); |
2367 | 644 ldap_mods[i].mod_op = LDAP_MOD_ADD | LDAP_MOD_BVALUES; |
645 values = XCDR (current); | |
646 if (CONSP (values)) | |
647 { | |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
648 len = (Elemcount) XFIXNUM (Flength (values)); |
2367 | 649 bervals = alloca_array (struct berval, len); |
650 ldap_mods[i].mod_vals.modv_bvals = | |
651 alloca_array (struct berval *, 1 + len); | |
652 j = 0; | |
653 { | |
654 EXTERNAL_LIST_LOOP_2 (cur2, values) | |
655 { | |
656 CHECK_STRING (cur2); | |
657 ldap_mods[i].mod_vals.modv_bvals[j] = &(bervals[j]); | |
658 TO_EXTERNAL_FORMAT (LISP_STRING, cur2, | |
659 ALLOCA, (bervals[j].bv_val, | |
660 bervals[j].bv_len), | |
661 Qnative); | |
662 j++; | |
663 } | |
664 } | |
665 ldap_mods[i].mod_vals.modv_bvals[j] = NULL; | |
666 } | |
667 else | |
668 { | |
669 CHECK_STRING (values); | |
670 bervals = alloca_array (struct berval, 1); | |
671 ldap_mods[i].mod_vals.modv_bvals = alloca_array (struct berval *, | |
672 2); | |
673 ldap_mods[i].mod_vals.modv_bvals[0] = &(bervals[0]); | |
674 TO_EXTERNAL_FORMAT (LISP_STRING, values, | |
675 ALLOCA, (bervals[0].bv_val, | |
676 bervals[0].bv_len), | |
677 Qnative); | |
678 ldap_mods[i].mod_vals.modv_bvals[1] = NULL; | |
679 } | |
680 i++; | |
681 } | |
682 } | |
996 | 683 ldap_mods_ptrs[i] = NULL; |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
684 rc = ldap_add_s (ld, LISP_STRING_TO_EXTERNAL (dn, Qnative), |
2367 | 685 ldap_mods_ptrs); |
996 | 686 if (rc != LDAP_SUCCESS) |
687 signal_ldap_error (ld, NULL, rc); | |
428 | 688 |
689 UNGCPRO; | |
996 | 690 return Qnil; |
691 } | |
692 | |
693 DEFUN ("ldap-modify", Fldap_modify, 3, 3, 0, /* | |
694 Add an entry to an LDAP directory. | |
695 LDAP is an LDAP connection object created with `ldap-open'. | |
696 DN is the distinguished name of the entry to modify. | |
697 MODS is a list of modifications to apply. | |
698 A modification is a list of the form (MOD-OP ATTR VALUE1 VALUE2 ...) | |
699 MOD-OP and ATTR are mandatory, VALUEs are optional depending on MOD-OP. | |
700 MOD-OP is the type of modification, one of the symbols `add', `delete' | |
701 or `replace'. ATTR is the LDAP attribute type to modify. | |
702 */ | |
703 (ldap, dn, mods)) | |
704 { | |
705 LDAP *ld; | |
706 LDAPMod *ldap_mods, **ldap_mods_ptrs; | |
707 struct berval *bervals; | |
708 int i, j, rc; | |
709 Lisp_Object mod_op; | |
710 Elemcount len; | |
711 Lisp_Object values = Qnil; | |
3029 | 712 struct gcpro gcpro1; |
996 | 713 |
714 /* Do all the parameter checking */ | |
715 CHECK_LIVE_LDAP (ldap); | |
716 ld = XLDAP (ldap)->ld; | |
717 | |
718 /* Check the DN */ | |
719 CHECK_STRING (dn); | |
720 | |
721 /* Check the entry */ | |
722 CHECK_CONS (mods); | |
723 if (NILP (mods)) | |
724 return Qnil; | |
725 | |
726 /* Build the ldap_mods array */ | |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
727 len = (Elemcount) XFIXNUM (Flength (mods)); |
996 | 728 ldap_mods = alloca_array (LDAPMod, len); |
729 ldap_mods_ptrs = alloca_array (LDAPMod *, 1 + len); | |
730 i = 0; | |
731 | |
2367 | 732 GCPRO1 (values); |
733 { | |
734 EXTERNAL_LIST_LOOP_2 (current, mods) | |
735 { | |
736 CHECK_CONS (current); | |
737 CHECK_SYMBOL (XCAR (current)); | |
738 mod_op = XCAR (current); | |
739 ldap_mods_ptrs[i] = &(ldap_mods[i]); | |
740 ldap_mods[i].mod_op = LDAP_MOD_BVALUES; | |
741 if (EQ (mod_op, Qadd)) | |
742 ldap_mods[i].mod_op |= LDAP_MOD_ADD; | |
743 else if (EQ (mod_op, Qdelete)) | |
744 ldap_mods[i].mod_op |= LDAP_MOD_DELETE; | |
745 else if (EQ (mod_op, Qreplace)) | |
746 ldap_mods[i].mod_op |= LDAP_MOD_REPLACE; | |
747 else | |
748 invalid_constant ("Invalid LDAP modification type", mod_op); | |
749 current = XCDR (current); | |
750 CHECK_STRING (XCAR (current)); | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
751 ldap_mods[i].mod_type = |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
752 LISP_STRING_TO_EXTERNAL (XCAR (current), Qnative); |
2367 | 753 values = XCDR (current); |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
754 len = (Elemcount) XFIXNUM (Flength (values)); |
2367 | 755 bervals = alloca_array (struct berval, len); |
756 ldap_mods[i].mod_vals.modv_bvals = | |
757 alloca_array (struct berval *, 1 + len); | |
758 j = 0; | |
2387 | 759 { |
760 EXTERNAL_LIST_LOOP_2 (cur2, values) | |
761 { | |
762 CHECK_STRING (cur2); | |
763 ldap_mods[i].mod_vals.modv_bvals[j] = &(bervals[j]); | |
764 TO_EXTERNAL_FORMAT (LISP_STRING, cur2, | |
765 ALLOCA, (bervals[j].bv_val, | |
766 bervals[j].bv_len), | |
767 Qnative); | |
768 j++; | |
769 } | |
770 ldap_mods[i].mod_vals.modv_bvals[j] = NULL; | |
771 i++; | |
772 } | |
2367 | 773 } |
774 } | |
996 | 775 ldap_mods_ptrs[i] = NULL; |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
776 rc = ldap_modify_s (ld, LISP_STRING_TO_EXTERNAL (dn, Qnative), |
2367 | 777 ldap_mods_ptrs); |
996 | 778 if (rc != LDAP_SUCCESS) |
779 signal_ldap_error (ld, NULL, rc); | |
780 | |
781 UNGCPRO; | |
782 return Qnil; | |
783 } | |
784 | |
785 | |
786 DEFUN ("ldap-delete", Fldap_delete, 2, 2, 0, /* | |
787 Delete an entry to an LDAP directory. | |
788 LDAP is an LDAP connection object created with `ldap-open'. | |
789 DN is the distinguished name of the entry to delete. | |
790 */ | |
791 (ldap, dn)) | |
792 { | |
793 LDAP *ld; | |
794 int rc; | |
795 | |
796 /* Check parameters */ | |
797 CHECK_LIVE_LDAP (ldap); | |
798 ld = XLDAP (ldap)->ld; | |
799 CHECK_STRING (dn); | |
800 | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
801 rc = ldap_delete_s (ld, LISP_STRING_TO_EXTERNAL (dn, Qnative)); |
996 | 802 if (rc != LDAP_SUCCESS) |
803 signal_ldap_error (ld, NULL, rc); | |
804 | |
805 return Qnil; | |
428 | 806 } |
807 | |
808 void | |
996 | 809 syms_of_eldap (void) |
428 | 810 { |
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
811 INIT_LISP_OBJECT (ldap); |
428 | 812 |
996 | 813 DEFSYMBOL (Qeldap); |
814 DEFSYMBOL (Qldapp); | |
815 DEFSYMBOL (Qport); | |
816 DEFSYMBOL (Qauth); | |
817 DEFSYMBOL (Qbinddn); | |
818 DEFSYMBOL (Qpasswd); | |
819 DEFSYMBOL (Qderef); | |
820 DEFSYMBOL (Qtimelimit); | |
821 DEFSYMBOL (Qsizelimit); | |
822 DEFSYMBOL (Qbase); | |
823 DEFSYMBOL (Qonelevel); | |
824 DEFSYMBOL (Qsubtree); | |
825 DEFSYMBOL (Qkrbv41); | |
826 DEFSYMBOL (Qkrbv42); | |
827 DEFSYMBOL (Qnever); | |
828 DEFSYMBOL (Qalways); | |
829 DEFSYMBOL (Qfind); | |
830 DEFSYMBOL (Qadd); | |
831 DEFSYMBOL (Qreplace); | |
832 | |
833 DEFSUBR (Fldapp); | |
834 DEFSUBR (Fldap_host); | |
835 DEFSUBR (Fldap_live_p); | |
836 DEFSUBR (Fldap_open); | |
837 DEFSUBR (Fldap_close); | |
838 DEFSUBR (Fldap_search_basic); | |
839 DEFSUBR (Fldap_add); | |
840 DEFSUBR (Fldap_modify); | |
841 DEFSUBR (Fldap_delete); | |
428 | 842 } |
843 | |
844 void | |
996 | 845 vars_of_eldap (void) |
428 | 846 { |
996 | 847 |
848 Fprovide (Qeldap); | |
428 | 849 |
996 | 850 ldap_default_port = LDAP_PORT; |
851 Vldap_default_base = Qnil; | |
852 | |
853 DEFVAR_INT ("ldap-default-port", &ldap_default_port /* | |
854 Default TCP port for LDAP connections. | |
855 Initialized from the LDAP library. Default value is 389. | |
428 | 856 */ ); |
857 | |
858 DEFVAR_LISP ("ldap-default-base", &Vldap_default_base /* | |
859 Default base for LDAP searches. | |
860 This is a string using the syntax of RFC 1779. | |
861 For instance, "o=ACME, c=US" limits the search to the | |
862 Acme organization in the United States. | |
863 */ ); | |
864 | |
865 } | |
866 | |
996 | 867 #ifdef HAVE_SHLIB |
1706 | 868 EXTERN_C void unload_eldap (void); |
996 | 869 void |
870 unload_eldap (void) | |
871 { | |
872 /* Remove defined types */ | |
5120
d1247f3cc363
latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents:
5119
diff
changeset
|
873 UNDEF_LISP_OBJECT (ldap); |
996 | 874 |
875 /* Remove staticpro'ing of symbols */ | |
876 unstaticpro_nodump (&Qeldap); | |
877 unstaticpro_nodump (&Qldapp); | |
878 unstaticpro_nodump (&Qport); | |
879 unstaticpro_nodump (&Qauth); | |
880 unstaticpro_nodump (&Qbinddn); | |
881 unstaticpro_nodump (&Qpasswd); | |
882 unstaticpro_nodump (&Qderef); | |
883 unstaticpro_nodump (&Qtimelimit); | |
884 unstaticpro_nodump (&Qsizelimit); | |
885 unstaticpro_nodump (&Qbase); | |
886 unstaticpro_nodump (&Qonelevel); | |
887 unstaticpro_nodump (&Qsubtree); | |
888 unstaticpro_nodump (&Qkrbv41); | |
889 unstaticpro_nodump (&Qkrbv42); | |
890 unstaticpro_nodump (&Qnever); | |
891 unstaticpro_nodump (&Qalways); | |
892 unstaticpro_nodump (&Qfind); | |
893 unstaticpro_nodump (&Qadd); | |
894 unstaticpro_nodump (&Qreplace); | |
895 } | |
896 #endif /* HAVE_SHLIB */ |