Mercurial > hg > xemacs-beta
annotate modules/ldap/eldap.c @ 5117:3742ea8250b5 ben-lisp-object ben-lisp-object-final-ws-year-2005
Checking in final CVS version of workspace 'ben-lisp-object'
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Sat, 26 Dec 2009 00:20:27 -0600 |
| parents | 986cd22006a9 |
| children | e0db3c197671 |
| rev | line source |
|---|---|
| 428 | 1 /* LDAP client interface for XEmacs. |
| 2 Copyright (C) 1998 Free Software Foundation, Inc. | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3029
diff
changeset
|
3 Copyright (C) 2004, 2005 Ben Wing. |
| 2367 | 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", | |
| 2367 | 102 build_ext_string (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) | |
| 137 write_c_string (printcharfun,"(dead) "); | |
| 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 | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3029
diff
changeset
|
165 #f 0 |
| 1220 | 166 DEFINE_LRECORD_IMPLEMENTATION ("ldap", ldap, 0, |
| 996 | 167 mark_ldap, print_ldap, finalize_ldap, |
| 168 NULL, NULL, ldap_description, Lisp_LDAP); | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3029
diff
changeset
|
169 #else |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3029
diff
changeset
|
170 DEFINE_NONDUMPABLE_LRECORD_IMPLEMENTATION ("ldap", ldap, mark_ldap, |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3029
diff
changeset
|
171 print_ldap, finalize_ldap, |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3029
diff
changeset
|
172 NULL, NULL, ldap_description, |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3029
diff
changeset
|
173 Lisp_LDAP); |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3029
diff
changeset
|
174 #endif |
| 996 | 175 |
| 176 /************************************************************************/ | |
| 177 /* Basic ldap accessors */ | |
| 178 /************************************************************************/ | |
| 179 | |
| 180 /* ###autoload */ | |
| 181 DEFUN ("ldapp", Fldapp, 1, 1, 0, /* | |
| 182 Return t if OBJECT is a LDAP connection. | |
| 183 */ | |
| 184 (object)) | |
| 185 { | |
| 186 return LDAPP (object) ? Qt : Qnil; | |
| 187 } | |
| 188 | |
| 189 DEFUN ("ldap-host", Fldap_host, 1, 1, 0, /* | |
| 190 Return the server host of the connection LDAP, as a string. | |
| 191 */ | |
| 192 (ldap)) | |
| 193 { | |
| 194 CHECK_LDAP (ldap); | |
| 195 return (XLDAP (ldap))->host; | |
| 196 } | |
| 197 | |
| 198 DEFUN ("ldap-live-p", Fldap_live_p, 1, 1, 0, /* | |
| 199 Return t if LDAP is an active LDAP connection. | |
| 200 */ | |
| 201 (ldap)) | |
| 202 { | |
| 203 CHECK_LDAP (ldap); | |
| 204 return (XLDAP (ldap))->ld ? Qt : Qnil; | |
| 205 } | |
| 206 | |
| 207 /************************************************************************/ | |
| 208 /* Opening/Closing a LDAP connection */ | |
| 209 /************************************************************************/ | |
| 210 | |
| 211 | |
| 212 /* ###autoload */ | |
| 213 DEFUN ("ldap-open", Fldap_open, 1, 2, 0, /* | |
| 214 Open a LDAP connection to HOST. | |
| 215 PLIST is a plist containing additional parameters for the connection. | |
| 428 | 216 Valid keys in that list are: |
| 996 | 217 `port' the TCP port to use for the connection if different from |
| 218 `ldap-default-port'. | |
| 428 | 219 `auth' is the authentication method to use, possible values depend on |
| 220 the LDAP library XEmacs was compiled with: `simple', `krbv41' and `krbv42'. | |
| 221 `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax). | |
| 222 `passwd' is the password to use for simple authentication. | |
| 223 `deref' is one of the symbols `never', `always', `search' or `find'. | |
| 224 `timelimit' is the timeout limit for the connection in seconds. | |
| 225 `sizelimit' is the maximum number of matches to return. | |
| 226 */ | |
| 996 | 227 (host, plist)) |
| 428 | 228 { |
| 996 | 229 /* This function can GC */ |
| 230 Lisp_LDAP *ldap; | |
| 428 | 231 LDAP *ld; |
| 996 | 232 int ldap_port = 0; |
| 428 | 233 int ldap_auth = LDAP_AUTH_SIMPLE; |
| 2367 | 234 Extbyte *ldap_binddn = NULL; |
| 235 Extbyte *ldap_password = NULL; | |
| 428 | 236 int ldap_deref = LDAP_DEREF_NEVER; |
| 237 int ldap_timelimit = 0; | |
| 238 int ldap_sizelimit = 0; | |
| 996 | 239 int err; |
| 428 | 240 |
| 996 | 241 CHECK_STRING (host); |
| 428 | 242 |
| 996 | 243 { |
| 244 EXTERNAL_PROPERTY_LIST_LOOP_3 (keyword, value, plist) | |
| 245 { | |
| 246 /* TCP Port */ | |
| 247 if (EQ (keyword, Qport)) | |
| 248 { | |
| 249 CHECK_INT (value); | |
| 250 ldap_port = XINT (value); | |
| 251 } | |
| 252 /* Authentication method */ | |
| 253 if (EQ (keyword, Qauth)) | |
| 254 { | |
| 255 if (EQ (value, Qsimple)) | |
| 256 ldap_auth = LDAP_AUTH_SIMPLE; | |
| 428 | 257 #ifdef LDAP_AUTH_KRBV41 |
| 996 | 258 else if (EQ (value, Qkrbv41)) |
| 259 ldap_auth = LDAP_AUTH_KRBV41; | |
| 428 | 260 #endif |
| 261 #ifdef LDAP_AUTH_KRBV42 | |
| 996 | 262 else if (EQ (value, Qkrbv42)) |
| 263 ldap_auth = LDAP_AUTH_KRBV42; | |
| 428 | 264 #endif |
| 996 | 265 else |
| 266 invalid_constant ("Invalid authentication method", value); | |
| 267 } | |
| 268 /* Bind DN */ | |
| 269 else if (EQ (keyword, Qbinddn)) | |
| 270 { | |
| 271 CHECK_STRING (value); | |
| 272 LISP_STRING_TO_EXTERNAL (value, ldap_binddn, Qnative); | |
| 273 } | |
| 274 /* Password */ | |
| 275 else if (EQ (keyword, Qpasswd)) | |
| 276 { | |
| 277 CHECK_STRING (value); | |
| 2272 | 278 LISP_STRING_TO_EXTERNAL (value, ldap_password, Qnative); |
| 996 | 279 } |
| 280 /* Deref */ | |
| 281 else if (EQ (keyword, Qderef)) | |
| 282 { | |
| 283 if (EQ (value, Qnever)) | |
| 284 ldap_deref = LDAP_DEREF_NEVER; | |
| 285 else if (EQ (value, Qsearch)) | |
| 286 ldap_deref = LDAP_DEREF_SEARCHING; | |
| 287 else if (EQ (value, Qfind)) | |
| 288 ldap_deref = LDAP_DEREF_FINDING; | |
| 289 else if (EQ (value, Qalways)) | |
| 290 ldap_deref = LDAP_DEREF_ALWAYS; | |
| 291 else | |
| 292 invalid_constant ("Invalid deref value", value); | |
| 293 } | |
| 294 /* Timelimit */ | |
| 295 else if (EQ (keyword, Qtimelimit)) | |
| 296 { | |
| 297 CHECK_INT (value); | |
| 298 ldap_timelimit = XINT (value); | |
| 299 } | |
| 300 /* Sizelimit */ | |
| 301 else if (EQ (keyword, Qsizelimit)) | |
| 302 { | |
| 303 CHECK_INT (value); | |
| 304 ldap_sizelimit = XINT (value); | |
| 305 } | |
| 306 } | |
| 307 } | |
| 308 | |
| 309 if (ldap_port == 0) | |
| 310 { | |
| 311 ldap_port = ldap_default_port; | |
| 428 | 312 } |
| 313 | |
| 996 | 314 /* Connect to the server and bind */ |
| 315 slow_down_interrupts (); | |
| 2367 | 316 ld = ldap_open (NEW_LISP_STRING_TO_EXTERNAL (host, Qnative), ldap_port); |
| 996 | 317 speed_up_interrupts (); |
| 428 | 318 |
| 996 | 319 if (ld == NULL ) |
| 320 report_process_error ("Failed connecting to host", host); | |
| 428 | 321 |
| 996 | 322 #ifdef HAVE_LDAP_SET_OPTION |
| 323 if ((err = ldap_set_option (ld, LDAP_OPT_DEREF, | |
| 324 (void *)&ldap_deref)) != LDAP_SUCCESS) | |
| 325 signal_ldap_error (ld, NULL, err); | |
| 326 if ((err = ldap_set_option (ld, LDAP_OPT_TIMELIMIT, | |
| 327 (void *)&ldap_timelimit)) != LDAP_SUCCESS) | |
| 328 signal_ldap_error (ld, NULL, err); | |
| 329 if ((err = ldap_set_option (ld, LDAP_OPT_SIZELIMIT, | |
| 330 (void *)&ldap_sizelimit)) != LDAP_SUCCESS) | |
| 331 signal_ldap_error (ld, NULL, err); | |
| 332 if ((err = ldap_set_option (ld, LDAP_OPT_REFERRALS, | |
| 333 LDAP_OPT_ON)) != LDAP_SUCCESS) | |
| 334 signal_ldap_error (ld, NULL, err); | |
| 335 if ((err = ldap_set_option (ld, LDAP_OPT_RESTART, | |
| 336 LDAP_OPT_ON)) != LDAP_SUCCESS) | |
| 337 signal_ldap_error (ld, NULL, err); | |
| 338 #else /* not HAVE_LDAP_SET_OPTION */ | |
| 428 | 339 ld->ld_deref = ldap_deref; |
| 340 ld->ld_timelimit = ldap_timelimit; | |
| 341 ld->ld_sizelimit = ldap_sizelimit; | |
| 342 #ifdef LDAP_REFERRALS | |
| 343 ld->ld_options = LDAP_OPT_REFERRALS; | |
| 996 | 344 #else /* not LDAP_REFERRALS */ |
| 428 | 345 ld->ld_options = 0; |
| 996 | 346 #endif /* not LDAP_REFERRALS */ |
| 347 /* XEmacs uses interrupts (SIGIO,SIGALRM), LDAP calls need to ignore them */ | |
| 348 ld->ld_options |= LDAP_OPT_RESTART; | |
| 349 #endif /* not HAVE_LDAP_SET_OPTION */ | |
| 350 | |
| 2272 | 351 err = ldap_bind_s (ld, ldap_binddn, ldap_password, ldap_auth); |
| 996 | 352 if (err != LDAP_SUCCESS) |
| 353 { | |
| 354 signal_error (Qprocess_error, "Failed binding to the server", | |
| 2367 | 355 build_ext_string (ldap_err2string (err), Qnative)); |
| 996 | 356 } |
| 357 | |
| 358 ldap = allocate_ldap (); | |
| 359 ldap->ld = ld; | |
| 360 ldap->host = host; | |
| 361 | |
| 362 return make_ldap (ldap); | |
| 363 } | |
| 364 | |
| 365 | |
| 366 | |
| 367 DEFUN ("ldap-close", Fldap_close, 1, 1, 0, /* | |
| 368 Close an LDAP connection. | |
| 369 */ | |
| 370 (ldap)) | |
| 371 { | |
| 372 Lisp_LDAP *lldap; | |
| 373 CHECK_LIVE_LDAP (ldap); | |
| 374 lldap = XLDAP (ldap); | |
| 375 ldap_unbind (lldap->ld); | |
| 376 lldap->ld = NULL; | |
| 377 return Qnil; | |
| 378 } | |
| 379 | |
| 380 | |
| 381 | |
| 382 /************************************************************************/ | |
| 383 /* Working on a LDAP connection */ | |
| 384 /************************************************************************/ | |
| 385 struct ldap_unwind_struct | |
| 386 { | |
| 387 LDAPMessage *res; | |
| 388 struct berval **vals; | |
| 389 }; | |
| 390 | |
| 391 static Lisp_Object | |
| 392 ldap_search_unwind (Lisp_Object unwind_obj) | |
| 393 { | |
| 394 struct ldap_unwind_struct *unwind = | |
| 395 (struct ldap_unwind_struct *) get_opaque_ptr (unwind_obj); | |
| 396 if (unwind->res) | |
| 397 ldap_msgfree (unwind->res); | |
| 398 if (unwind->vals) | |
| 399 ldap_value_free_len (unwind->vals); | |
| 400 return Qnil; | |
| 401 } | |
| 402 | |
| 403 /* The following function is called `ldap-search-basic' instead of */ | |
| 404 /* plain `ldap-search' to maintain compatibility with the XEmacs 21.1 */ | |
| 405 /* API where `ldap-search' was the name of the high-level search */ | |
| 406 /* function */ | |
| 428 | 407 |
| 996 | 408 DEFUN ("ldap-search-basic", Fldap_search_basic, 2, 8, 0, /* |
| 409 Perform a search on an open LDAP connection. | |
| 410 LDAP is an LDAP connection object created with `ldap-open'. | |
| 411 FILTER is a filter string for the search as described in RFC 1558. | |
| 412 BASE is the distinguished name at which to start the search. | |
| 413 SCOPE is one of the symbols `base', `onelevel' or `subtree' indicating | |
| 414 the scope of the search. | |
| 415 ATTRS is a list of strings indicating which attributes to retrieve | |
| 416 for each matching entry. If nil return all available attributes. | |
| 417 If ATTRSONLY is non-nil then only the attributes are retrieved, not | |
| 418 the associated values. | |
| 419 If WITHDN is non-nil each entry in the result will be prepended with | |
| 420 its distinguished name DN. | |
| 421 If VERBOSE is non-nil progress messages will be echoed. | |
| 422 The function returns a list of matching entries. Each entry is itself | |
| 423 an alist of attribute/value pairs optionally preceded by the DN of the | |
| 424 entry according to the value of WITHDN. | |
| 425 */ | |
| 426 (ldap, filter, base, scope, attrs, attrsonly, withdn, verbose)) | |
| 427 { | |
| 428 /* This function can GC */ | |
| 429 | |
| 430 /* Vars for query */ | |
| 431 LDAP *ld; | |
| 432 LDAPMessage *e; | |
| 433 BerElement *ptr; | |
| 2367 | 434 Extbyte *a, *dn; |
| 996 | 435 int i, rc; |
| 436 int matches; | |
| 437 struct ldap_unwind_struct unwind; | |
| 438 | |
| 439 int ldap_scope = LDAP_SCOPE_SUBTREE; | |
| 2367 | 440 Extbyte **ldap_attributes = NULL; |
| 996 | 441 |
| 442 int speccount = specpdl_depth (); | |
| 443 | |
| 444 Lisp_Object list = Qnil; | |
| 445 Lisp_Object entry = Qnil; | |
| 446 Lisp_Object result = Qnil; | |
| 447 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 448 | |
| 449 GCPRO3 (list, entry, result); | |
| 450 | |
| 451 unwind.res = NULL; | |
| 452 unwind.vals = NULL; | |
| 453 | |
| 454 /* Do all the parameter checking */ | |
| 455 CHECK_LIVE_LDAP (ldap); | |
| 456 ld = XLDAP (ldap)->ld; | |
| 457 | |
| 458 /* Filter */ | |
| 459 CHECK_STRING (filter); | |
| 460 | |
| 461 /* Search base */ | |
| 462 if (NILP (base)) | |
| 463 { | |
| 464 base = Vldap_default_base; | |
| 465 } | |
| 466 if (!NILP (base)) | |
| 467 { | |
| 468 CHECK_STRING (base); | |
| 469 } | |
| 470 | |
| 471 /* Search scope */ | |
| 472 if (!NILP (scope)) | |
| 473 { | |
| 474 if (EQ (scope, Qbase)) | |
| 475 ldap_scope = LDAP_SCOPE_BASE; | |
| 476 else if (EQ (scope, Qonelevel)) | |
| 477 ldap_scope = LDAP_SCOPE_ONELEVEL; | |
| 478 else if (EQ (scope, Qsubtree)) | |
| 479 ldap_scope = LDAP_SCOPE_SUBTREE; | |
| 480 else | |
| 481 invalid_constant ("Invalid scope", scope); | |
| 482 } | |
| 483 | |
| 484 /* Attributes to search */ | |
| 485 if (!NILP (attrs)) | |
| 486 { | |
| 487 CHECK_CONS (attrs); | |
| 488 ldap_attributes = alloca_array (char *, 1 + XINT (Flength (attrs))); | |
| 489 | |
| 490 i = 0; | |
| 2367 | 491 { |
| 492 EXTERNAL_LIST_LOOP_2 (current, attrs) | |
| 493 { | |
| 494 CHECK_STRING (current); | |
| 495 LISP_STRING_TO_EXTERNAL (current, ldap_attributes[i], Qnative); | |
| 496 ++i; | |
| 497 } | |
| 498 } | |
| 996 | 499 ldap_attributes[i] = NULL; |
| 500 } | |
| 501 | |
| 502 /* Attributes only ? */ | |
| 503 CHECK_SYMBOL (attrsonly); | |
| 428 | 504 |
| 505 /* Perform the search */ | |
| 996 | 506 if (ldap_search (ld, |
| 2367 | 507 NILP (base) ? "" : |
| 508 NEW_LISP_STRING_TO_EXTERNAL (base, Qnative), | |
| 996 | 509 ldap_scope, |
| 2367 | 510 NILP (filter) ? "" : |
| 511 NEW_LISP_STRING_TO_EXTERNAL (filter, Qnative), | |
| 996 | 512 ldap_attributes, |
| 513 NILP (attrsonly) ? 0 : 1) | |
| 514 == -1) | |
| 428 | 515 { |
| 996 | 516 signal_ldap_error (ld, NULL, 0); |
| 428 | 517 } |
| 518 | |
| 996 | 519 /* Ensure we don't exit without cleaning up */ |
| 520 record_unwind_protect (ldap_search_unwind, | |
| 521 make_opaque_ptr (&unwind)); | |
| 522 | |
| 428 | 523 /* Build the results list */ |
| 524 matches = 0; | |
| 525 | |
| 996 | 526 rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &unwind.res); |
| 527 | |
| 528 while (rc == LDAP_RES_SEARCH_ENTRY) | |
| 428 | 529 { |
| 996 | 530 QUIT; |
| 428 | 531 matches ++; |
| 996 | 532 e = ldap_first_entry (ld, unwind.res); |
| 533 /* #### This call to message() is pretty fascist, because it | |
| 534 destroys the current echo area contents, even when invoked | |
| 535 from Lisp. It should use echo_area_message() instead, and | |
| 536 restore the old echo area contents later. */ | |
| 537 if (! NILP (verbose)) | |
| 538 message ("Parsing ldap results... %d", matches); | |
| 428 | 539 entry = Qnil; |
| 996 | 540 /* Get the DN if required */ |
| 541 if (! NILP (withdn)) | |
| 542 { | |
| 543 dn = ldap_get_dn (ld, e); | |
| 544 if (dn == NULL) | |
| 545 signal_ldap_error (ld, e, 0); | |
| 546 entry = Fcons (build_ext_string (dn, Qnative), Qnil); | |
| 547 } | |
| 2367 | 548 for (a = ldap_first_attribute (ld, e, &ptr); |
| 428 | 549 a != NULL; |
| 2367 | 550 a = ldap_next_attribute (ld, e, ptr)) |
| 428 | 551 { |
| 996 | 552 list = Fcons (build_ext_string (a, Qnative), Qnil); |
| 553 unwind.vals = ldap_get_values_len (ld, e, a); | |
| 554 if (unwind.vals != NULL) | |
| 428 | 555 { |
| 996 | 556 for (i = 0; unwind.vals[i] != NULL; i++) |
| 428 | 557 { |
| 996 | 558 list = Fcons (make_ext_string ((Extbyte *) unwind.vals[i]->bv_val, |
| 559 unwind.vals[i]->bv_len, | |
| 560 Qnative), | |
| 428 | 561 list); |
| 562 } | |
| 563 } | |
| 564 entry = Fcons (Fnreverse (list), | |
| 565 entry); | |
| 996 | 566 ldap_value_free_len (unwind.vals); |
| 567 unwind.vals = NULL; | |
| 428 | 568 } |
| 569 result = Fcons (Fnreverse (entry), | |
| 570 result); | |
| 996 | 571 ldap_msgfree (unwind.res); |
| 572 unwind.res = NULL; | |
| 428 | 573 |
| 996 | 574 rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &(unwind.res)); |
| 428 | 575 } |
| 576 | |
| 996 | 577 #if defined HAVE_LDAP_PARSE_RESULT |
| 578 { | |
| 579 int rc2 = ldap_parse_result (ld, unwind.res, | |
| 580 &rc, | |
| 581 NULL, NULL, NULL, NULL, 0); | |
| 582 if (rc2 != LDAP_SUCCESS) | |
| 583 rc = rc2; | |
| 584 } | |
| 428 | 585 #else |
| 996 | 586 if (rc == 0) |
| 587 signal_ldap_error (ld, NULL, LDAP_TIMELIMIT_EXCEEDED); | |
| 588 | |
| 589 if (rc == -1) | |
| 590 signal_ldap_error (ld, unwind.res, (unwind.res==NULL) ? ld->ld_errno : 0); | |
| 591 | |
| 592 #if defined HAVE_LDAP_RESULT2ERROR | |
| 593 rc = ldap_result2error (ld, unwind.res, 0); | |
| 594 #endif | |
| 428 | 595 #endif |
| 996 | 596 |
| 597 if (rc != LDAP_SUCCESS) | |
| 598 signal_ldap_error (ld, NULL, rc); | |
| 599 | |
| 600 ldap_msgfree (unwind.res); | |
| 601 unwind.res = (LDAPMessage *)NULL; | |
| 602 | |
| 603 /* #### See above for calling message(). */ | |
| 604 if (! NILP (verbose)) | |
| 605 message ("Parsing ldap results... done"); | |
| 606 | |
| 607 unbind_to (speccount); | |
| 608 UNGCPRO; | |
| 609 return Fnreverse (result); | |
| 610 } | |
| 611 | |
| 612 DEFUN ("ldap-add", Fldap_add, 3, 3, 0, /* | |
| 613 Add an entry to an LDAP directory. | |
| 614 LDAP is an LDAP connection object created with `ldap-open'. | |
| 615 DN is the distinguished name of the entry to add. | |
| 616 ENTRY is an entry specification, i.e., a list of cons cells | |
| 617 containing attribute/value string pairs. | |
| 618 */ | |
| 619 (ldap, dn, entry)) | |
| 620 { | |
| 621 LDAP *ld; | |
| 622 LDAPMod *ldap_mods, **ldap_mods_ptrs; | |
| 623 struct berval *bervals; | |
| 624 int rc; | |
| 625 int i, j; | |
| 626 Elemcount len; | |
| 627 Lisp_Object values = Qnil; | |
| 2367 | 628 struct gcpro gcpro1; |
| 996 | 629 |
| 2367 | 630 GCPRO1 (values); |
| 996 | 631 |
| 632 /* Do all the parameter checking */ | |
| 633 CHECK_LIVE_LDAP (ldap); | |
| 634 ld = XLDAP (ldap)->ld; | |
| 635 | |
| 636 /* Check the DN */ | |
| 637 CHECK_STRING (dn); | |
| 638 | |
| 639 /* Check the entry */ | |
| 640 CHECK_CONS (entry); | |
| 641 if (NILP (entry)) | |
| 642 invalid_operation ("Cannot add void entry", entry); | |
| 428 | 643 |
| 996 | 644 /* Build the ldap_mods array */ |
| 645 len = (Elemcount) XINT (Flength (entry)); | |
| 646 ldap_mods = alloca_array (LDAPMod, len); | |
| 647 ldap_mods_ptrs = alloca_array (LDAPMod *, 1 + len); | |
| 648 i = 0; | |
| 2367 | 649 |
| 650 { | |
| 651 EXTERNAL_LIST_LOOP_2 (current, entry) | |
| 652 { | |
| 653 CHECK_CONS (current); | |
| 654 CHECK_STRING (XCAR (current)); | |
| 655 ldap_mods_ptrs[i] = &(ldap_mods[i]); | |
| 656 LISP_STRING_TO_EXTERNAL (XCAR (current), ldap_mods[i].mod_type, | |
| 657 Qnative); | |
| 658 ldap_mods[i].mod_op = LDAP_MOD_ADD | LDAP_MOD_BVALUES; | |
| 659 values = XCDR (current); | |
| 660 if (CONSP (values)) | |
| 661 { | |
| 662 len = (Elemcount) XINT (Flength (values)); | |
| 663 bervals = alloca_array (struct berval, len); | |
| 664 ldap_mods[i].mod_vals.modv_bvals = | |
| 665 alloca_array (struct berval *, 1 + len); | |
| 666 j = 0; | |
| 667 { | |
| 668 EXTERNAL_LIST_LOOP_2 (cur2, values) | |
| 669 { | |
| 670 CHECK_STRING (cur2); | |
| 671 ldap_mods[i].mod_vals.modv_bvals[j] = &(bervals[j]); | |
| 672 TO_EXTERNAL_FORMAT (LISP_STRING, cur2, | |
| 673 ALLOCA, (bervals[j].bv_val, | |
| 674 bervals[j].bv_len), | |
| 675 Qnative); | |
| 676 j++; | |
| 677 } | |
| 678 } | |
| 679 ldap_mods[i].mod_vals.modv_bvals[j] = NULL; | |
| 680 } | |
| 681 else | |
| 682 { | |
| 683 CHECK_STRING (values); | |
| 684 bervals = alloca_array (struct berval, 1); | |
| 685 ldap_mods[i].mod_vals.modv_bvals = alloca_array (struct berval *, | |
| 686 2); | |
| 687 ldap_mods[i].mod_vals.modv_bvals[0] = &(bervals[0]); | |
| 688 TO_EXTERNAL_FORMAT (LISP_STRING, values, | |
| 689 ALLOCA, (bervals[0].bv_val, | |
| 690 bervals[0].bv_len), | |
| 691 Qnative); | |
| 692 ldap_mods[i].mod_vals.modv_bvals[1] = NULL; | |
| 693 } | |
| 694 i++; | |
| 695 } | |
| 696 } | |
| 996 | 697 ldap_mods_ptrs[i] = NULL; |
| 2367 | 698 rc = ldap_add_s (ld, NEW_LISP_STRING_TO_EXTERNAL (dn, Qnative), |
| 699 ldap_mods_ptrs); | |
| 996 | 700 if (rc != LDAP_SUCCESS) |
| 701 signal_ldap_error (ld, NULL, rc); | |
| 428 | 702 |
| 703 UNGCPRO; | |
| 996 | 704 return Qnil; |
| 705 } | |
| 706 | |
| 707 DEFUN ("ldap-modify", Fldap_modify, 3, 3, 0, /* | |
| 708 Add an entry to an LDAP directory. | |
| 709 LDAP is an LDAP connection object created with `ldap-open'. | |
| 710 DN is the distinguished name of the entry to modify. | |
| 711 MODS is a list of modifications to apply. | |
| 712 A modification is a list of the form (MOD-OP ATTR VALUE1 VALUE2 ...) | |
| 713 MOD-OP and ATTR are mandatory, VALUEs are optional depending on MOD-OP. | |
| 714 MOD-OP is the type of modification, one of the symbols `add', `delete' | |
| 715 or `replace'. ATTR is the LDAP attribute type to modify. | |
| 716 */ | |
| 717 (ldap, dn, mods)) | |
| 718 { | |
| 719 LDAP *ld; | |
| 720 LDAPMod *ldap_mods, **ldap_mods_ptrs; | |
| 721 struct berval *bervals; | |
| 722 int i, j, rc; | |
| 723 Lisp_Object mod_op; | |
| 724 Elemcount len; | |
| 725 Lisp_Object values = Qnil; | |
| 3029 | 726 struct gcpro gcpro1; |
| 996 | 727 |
| 728 /* Do all the parameter checking */ | |
| 729 CHECK_LIVE_LDAP (ldap); | |
| 730 ld = XLDAP (ldap)->ld; | |
| 731 | |
| 732 /* Check the DN */ | |
| 733 CHECK_STRING (dn); | |
| 734 | |
| 735 /* Check the entry */ | |
| 736 CHECK_CONS (mods); | |
| 737 if (NILP (mods)) | |
| 738 return Qnil; | |
| 739 | |
| 740 /* Build the ldap_mods array */ | |
| 741 len = (Elemcount) XINT (Flength (mods)); | |
| 742 ldap_mods = alloca_array (LDAPMod, len); | |
| 743 ldap_mods_ptrs = alloca_array (LDAPMod *, 1 + len); | |
| 744 i = 0; | |
| 745 | |
| 2367 | 746 GCPRO1 (values); |
| 747 { | |
| 748 EXTERNAL_LIST_LOOP_2 (current, mods) | |
| 749 { | |
| 750 CHECK_CONS (current); | |
| 751 CHECK_SYMBOL (XCAR (current)); | |
| 752 mod_op = XCAR (current); | |
| 753 ldap_mods_ptrs[i] = &(ldap_mods[i]); | |
| 754 ldap_mods[i].mod_op = LDAP_MOD_BVALUES; | |
| 755 if (EQ (mod_op, Qadd)) | |
| 756 ldap_mods[i].mod_op |= LDAP_MOD_ADD; | |
| 757 else if (EQ (mod_op, Qdelete)) | |
| 758 ldap_mods[i].mod_op |= LDAP_MOD_DELETE; | |
| 759 else if (EQ (mod_op, Qreplace)) | |
| 760 ldap_mods[i].mod_op |= LDAP_MOD_REPLACE; | |
| 761 else | |
| 762 invalid_constant ("Invalid LDAP modification type", mod_op); | |
| 763 current = XCDR (current); | |
| 764 CHECK_STRING (XCAR (current)); | |
| 765 LISP_STRING_TO_EXTERNAL (XCAR (current), ldap_mods[i].mod_type, | |
| 766 Qnative); | |
| 767 values = XCDR (current); | |
| 768 len = (Elemcount) XINT (Flength (values)); | |
| 769 bervals = alloca_array (struct berval, len); | |
| 770 ldap_mods[i].mod_vals.modv_bvals = | |
| 771 alloca_array (struct berval *, 1 + len); | |
| 772 j = 0; | |
| 2387 | 773 { |
| 774 EXTERNAL_LIST_LOOP_2 (cur2, values) | |
| 775 { | |
| 776 CHECK_STRING (cur2); | |
| 777 ldap_mods[i].mod_vals.modv_bvals[j] = &(bervals[j]); | |
| 778 TO_EXTERNAL_FORMAT (LISP_STRING, cur2, | |
| 779 ALLOCA, (bervals[j].bv_val, | |
| 780 bervals[j].bv_len), | |
| 781 Qnative); | |
| 782 j++; | |
| 783 } | |
| 784 ldap_mods[i].mod_vals.modv_bvals[j] = NULL; | |
| 785 i++; | |
| 786 } | |
| 2367 | 787 } |
| 788 } | |
| 996 | 789 ldap_mods_ptrs[i] = NULL; |
| 2367 | 790 rc = ldap_modify_s (ld, NEW_LISP_STRING_TO_EXTERNAL (dn, Qnative), |
| 791 ldap_mods_ptrs); | |
| 996 | 792 if (rc != LDAP_SUCCESS) |
| 793 signal_ldap_error (ld, NULL, rc); | |
| 794 | |
| 795 UNGCPRO; | |
| 796 return Qnil; | |
| 797 } | |
| 798 | |
| 799 | |
| 800 DEFUN ("ldap-delete", Fldap_delete, 2, 2, 0, /* | |
| 801 Delete an entry to an LDAP directory. | |
| 802 LDAP is an LDAP connection object created with `ldap-open'. | |
| 803 DN is the distinguished name of the entry to delete. | |
| 804 */ | |
| 805 (ldap, dn)) | |
| 806 { | |
| 807 LDAP *ld; | |
| 808 int rc; | |
| 809 | |
| 810 /* Check parameters */ | |
| 811 CHECK_LIVE_LDAP (ldap); | |
| 812 ld = XLDAP (ldap)->ld; | |
| 813 CHECK_STRING (dn); | |
| 814 | |
| 2367 | 815 rc = ldap_delete_s (ld, NEW_LISP_STRING_TO_EXTERNAL (dn, Qnative)); |
| 996 | 816 if (rc != LDAP_SUCCESS) |
| 817 signal_ldap_error (ld, NULL, rc); | |
| 818 | |
| 819 return Qnil; | |
| 428 | 820 } |
| 821 | |
| 822 void | |
| 996 | 823 syms_of_eldap (void) |
| 428 | 824 { |
| 996 | 825 INIT_LRECORD_IMPLEMENTATION (ldap); |
| 428 | 826 |
| 996 | 827 DEFSYMBOL (Qeldap); |
| 828 DEFSYMBOL (Qldapp); | |
| 829 DEFSYMBOL (Qport); | |
| 830 DEFSYMBOL (Qauth); | |
| 831 DEFSYMBOL (Qbinddn); | |
| 832 DEFSYMBOL (Qpasswd); | |
| 833 DEFSYMBOL (Qderef); | |
| 834 DEFSYMBOL (Qtimelimit); | |
| 835 DEFSYMBOL (Qsizelimit); | |
| 836 DEFSYMBOL (Qbase); | |
| 837 DEFSYMBOL (Qonelevel); | |
| 838 DEFSYMBOL (Qsubtree); | |
| 839 DEFSYMBOL (Qkrbv41); | |
| 840 DEFSYMBOL (Qkrbv42); | |
| 841 DEFSYMBOL (Qnever); | |
| 842 DEFSYMBOL (Qalways); | |
| 843 DEFSYMBOL (Qfind); | |
| 844 DEFSYMBOL (Qadd); | |
| 845 DEFSYMBOL (Qreplace); | |
| 846 | |
| 847 DEFSUBR (Fldapp); | |
| 848 DEFSUBR (Fldap_host); | |
| 849 DEFSUBR (Fldap_live_p); | |
| 850 DEFSUBR (Fldap_open); | |
| 851 DEFSUBR (Fldap_close); | |
| 852 DEFSUBR (Fldap_search_basic); | |
| 853 DEFSUBR (Fldap_add); | |
| 854 DEFSUBR (Fldap_modify); | |
| 855 DEFSUBR (Fldap_delete); | |
| 428 | 856 } |
| 857 | |
| 858 void | |
| 996 | 859 vars_of_eldap (void) |
| 428 | 860 { |
| 996 | 861 |
| 862 Fprovide (Qeldap); | |
| 428 | 863 |
| 996 | 864 ldap_default_port = LDAP_PORT; |
| 865 Vldap_default_base = Qnil; | |
| 866 | |
| 867 DEFVAR_INT ("ldap-default-port", &ldap_default_port /* | |
| 868 Default TCP port for LDAP connections. | |
| 869 Initialized from the LDAP library. Default value is 389. | |
| 428 | 870 */ ); |
| 871 | |
| 872 DEFVAR_LISP ("ldap-default-base", &Vldap_default_base /* | |
| 873 Default base for LDAP searches. | |
| 874 This is a string using the syntax of RFC 1779. | |
| 875 For instance, "o=ACME, c=US" limits the search to the | |
| 876 Acme organization in the United States. | |
| 877 */ ); | |
| 878 | |
| 879 } | |
| 880 | |
| 996 | 881 #ifdef HAVE_SHLIB |
| 1706 | 882 EXTERN_C void unload_eldap (void); |
| 996 | 883 void |
| 884 unload_eldap (void) | |
| 885 { | |
| 886 /* Remove defined types */ | |
| 887 UNDEF_LRECORD_IMPLEMENTATION (ldap); | |
| 888 | |
| 889 /* Remove staticpro'ing of symbols */ | |
| 890 unstaticpro_nodump (&Qeldap); | |
| 891 unstaticpro_nodump (&Qldapp); | |
| 892 unstaticpro_nodump (&Qport); | |
| 893 unstaticpro_nodump (&Qauth); | |
| 894 unstaticpro_nodump (&Qbinddn); | |
| 895 unstaticpro_nodump (&Qpasswd); | |
| 896 unstaticpro_nodump (&Qderef); | |
| 897 unstaticpro_nodump (&Qtimelimit); | |
| 898 unstaticpro_nodump (&Qsizelimit); | |
| 899 unstaticpro_nodump (&Qbase); | |
| 900 unstaticpro_nodump (&Qonelevel); | |
| 901 unstaticpro_nodump (&Qsubtree); | |
| 902 unstaticpro_nodump (&Qkrbv41); | |
| 903 unstaticpro_nodump (&Qkrbv42); | |
| 904 unstaticpro_nodump (&Qnever); | |
| 905 unstaticpro_nodump (&Qalways); | |
| 906 unstaticpro_nodump (&Qfind); | |
| 907 unstaticpro_nodump (&Qadd); | |
| 908 unstaticpro_nodump (&Qreplace); | |
| 909 } | |
| 910 #endif /* HAVE_SHLIB */ |