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