Mercurial > hg > xemacs-beta
annotate modules/ldap/eldap.c @ 5581:56144c8593a8
Mechanically change INT to FIXNUM in our sources.
src/ChangeLog addition:
2011-10-09 Aidan Kehoe <kehoea@parhasard.net>
[...]
Mechanically change INT (where it refers to non-bignum Lisp
integers) to FIXNUM in our sources. Done for the following
functions, enums, and macros: Lisp_Type_Int_Even,
Lisp_Type_Int_Odd, INT_GCBITS, INT_VALBITS, make_int(), INTP(),
XINT(), CHECK_INT(), XREALINT(), INT_PLUS(), INT_MINUS(),
EMACS_INT_MAX (to MOST_POSITIVE_FIXNUM), EMACS_INT_MIN (to
MOST_NEGATIVE_FIXNUM), NUMBER_FITS_IN_AN_EMACS_INT() to
NUMBER_FITS_IN_A_FIXNUM(), XFLOATINT, XCHAR_OR_INT, INT_OR_FLOAT.
The EMACS_INT typedef was not changed, it does not describe
non-bignum Lisp integers.
Script that did the change available in
http://mid.gmane.org/20067.17650.181273.12014@parhasard.net .
modules/ChangeLog addition:
2011-10-09 Aidan Kehoe <kehoea@parhasard.net>
[...]
Mechanically change INT to FIXNUM, where the usage describes non-bignum
Lisp integers. See the src/ChangeLog entry for more details.
man/ChangeLog addition:
2011-10-09 Aidan Kehoe <kehoea@parhasard.net>
* internals/internals.texi (How Lisp Objects Are Represented in C):
* internals/internals.texi (Integers and Characters):
Mechanically change INT to FIXNUM, where the usage describes non-bignum
Lisp integers.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Sun, 09 Oct 2011 09:51:57 +0100 |
parents | 308d34e9f07d |
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 */ |