Mercurial > hg > xemacs-beta
annotate modules/ldap/eldap.c @ 5142:f965e31a35f0
reduce lcrecord headers to 2 words, rename printing_unreadable_object
-------------------- ChangeLog entries follow: --------------------
man/ChangeLog addition:
2010-03-13 Ben Wing <ben@xemacs.org>
* internals/internals.texi (Working with Lisp Objects):
* internals/internals.texi (Writing Macros):
* internals/internals.texi (lrecords):
More rewriting to correspond with changes from
*LRECORD* to *LISP_OBJECT*.
modules/ChangeLog addition:
2010-03-13 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c (print_pgconn):
* postgresql/postgresql.c (print_pgresult):
printing_unreadable_object -> printing_unreadable_object_fmt.
2010-03-13 Ben Wing <ben@xemacs.org>
* ldap/eldap.c (print_ldap):
printing_unreadable_object -> printing_unreadable_object_fmt.
src/ChangeLog addition:
2010-03-13 Ben Wing <ben@xemacs.org>
* alloc.c (alloc_sized_lrecord_1):
* alloc.c (alloc_sized_lrecord_array):
* alloc.c (old_alloc_sized_lcrecord):
* alloc.c (disksave_object_finalization_1):
* alloc.c (mark_lcrecord_list):
* alloc.c (alloc_managed_lcrecord):
* alloc.c (free_managed_lcrecord):
* alloc.c (tick_lcrecord_stats):
* alloc.c (sweep_lcrecords_1):
* buffer.c (print_buffer):
* buffer.c (DEFVAR_BUFFER_LOCAL_1):
* casetab.c:
* casetab.c (print_case_table):
* console.c (print_console):
* console.c (DEFVAR_CONSOLE_LOCAL_1):
* data.c (print_weak_list):
* data.c (print_weak_box):
* data.c (print_ephemeron):
* data.c (ephemeron_equal):
* database.c (print_database):
* database.c (finalize_database):
* device-msw.c (sync_printer_with_devmode):
* device-msw.c (print_devmode):
* device-msw.c (finalize_devmode):
* device.c:
* device.c (print_device):
* elhash.c:
* elhash.c (print_hash_table):
* eval.c (print_subr):
* eval.c (print_multiple_value):
* event-stream.c (event_stream_resignal_wakeup):
* events.c (clear_event_resource):
* events.c (zero_event):
* events.c (print_event):
* extents.c:
* extents.c (print_extent):
* file-coding.c (print_coding_system):
* font-mgr.c:
* font-mgr.c (Ffc_init):
* frame.c:
* frame.c (print_frame):
* gc.c:
* gc.c (GC_CHECK_NOT_FREE):
* glyphs.c:
* glyphs.c (print_image_instance):
* glyphs.c (print_glyph):
* gui.c (print_gui_item):
* gui.c (copy_gui_item):
* keymap.c (print_keymap):
* keymap.c (MARKED_SLOT):
* lisp.h:
* lisp.h (struct Lisp_String):
* lisp.h (DEFUN):
* lisp.h (DEFUN_NORETURN):
* lrecord.h:
* lrecord.h (NORMAL_LISP_OBJECT_UID):
* lrecord.h (struct lrecord_header):
* lrecord.h (set_lheader_implementation):
* lrecord.h (struct old_lcrecord_header):
* lrecord.h (struct free_lcrecord_header):
* marker.c (print_marker):
* mule-charset.c:
* mule-charset.c (print_charset):
* objects.c (print_color_instance):
* objects.c (print_font_instance):
* objects.c (finalize_font_instance):
* print.c (print_cons):
* print.c (printing_unreadable_object_fmt):
* print.c (printing_unreadable_lisp_object):
* print.c (external_object_printer):
* print.c (internal_object_printer):
* print.c (debug_p4):
* print.c (ext_print_begin):
* process.c (print_process):
* rangetab.c (print_range_table):
* rangetab.c (range_table_equal):
* scrollbar.c (free_scrollbar_instance):
* specifier.c (print_specifier):
* specifier.c (finalize_specifier):
* symbols.c (guts_of_unbound_marker):
* symeval.h:
* symeval.h (DEFVAR_SYMVAL_FWD):
* tooltalk.c:
* tooltalk.c (print_tooltalk_message):
* tooltalk.c (print_tooltalk_pattern):
* ui-gtk.c (ffi_object_printer):
* ui-gtk.c (emacs_gtk_object_printer):
* ui-gtk.c (emacs_gtk_boxed_printer):
* window.c (print_window):
* window.c (free_window_mirror):
* window.c (debug_print_window):
* xemacs.def.in.in:
(1) printing_unreadable_object -> printing_unreadable_object_fmt.
(2) printing_unreadable_lcrecord -> printing_unreadable_lisp_object
and fix up so it no longer requires an lcrecord.
These previous changes eliminate most of the remaining places where
the terms `lcrecord' and `lrecord' occurred outside of specialized
code.
(3) Fairly major change: Reduce the number of words in an lcrecord
from 3 to 2. The third word consisted of a uid that duplicated the
lrecord uid, and a single free bit, which was moved into the lrecord
structure. This reduces the size of the `uid' slot from 21 bits to
20 bits. Arguably this isn't enough -- we could easily have more than
1,000,000 or so objects created in a session. The answer is
(a) It doesn't really matter if we overflow the uid field because
it's only used for debugging, to identify an object uniquely
(or pretty much so).
(b) If we cared about it overflowing and wanted to reduce this,
we could make it so that cons, string, float and certain other
frob-block types that never print out the uid simply don't
store a uid in them and don't increment the lrecord_uid_counter.
(4) In conjunction with (3), create new macro NORMAL_LISP_OBJECT_UID()
and use it to abstract out the differences between NEWGC and old-GC
in accessing the `uid' value from a "normal Lisp Object pointer".
(5) In events.c, use zero_nonsized_lisp_object() in place of custom-
written equivalent. In font-mgr.c use external_object_printer()
in place of custom-written equivalents.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Sat, 13 Mar 2010 05:38:08 -0600 |
| parents | 0dcd22290039 |
| children | 308d34e9f07d |
| 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 | |
| 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) | |
|
5142
f965e31a35f0
reduce lcrecord headers to 2 words, rename printing_unreadable_object
Ben Wing <ben@xemacs.org>
parents:
5141
diff
changeset
|
133 printing_unreadable_object_fmt ("#<ldap %s>", XSTRING_DATA (ldap->host)); |
| 996 | 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 { | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
144 Lisp_LDAP *ldap = XLDAP (ALLOC_NORMAL_LISP_OBJECT (ldap)); |
| 996 | 145 |
| 146 ldap->ld = NULL; | |
| 147 ldap->host = Qnil; | |
| 148 return ldap; | |
| 149 } | |
| 150 | |
| 151 static void | |
|
5141
0dcd22290039
fix issues with finalizers in number.c, postgresql, ldap
Ben Wing <ben@xemacs.org>
parents:
5127
diff
changeset
|
152 finalize_ldap (Lisp_Object obj) |
| 996 | 153 { |
|
5141
0dcd22290039
fix issues with finalizers in number.c, postgresql, ldap
Ben Wing <ben@xemacs.org>
parents:
5127
diff
changeset
|
154 Lisp_LDAP *ldap = XLDAP (obj); |
| 996 | 155 |
| 156 if (ldap->ld) | |
| 157 ldap_unbind (ldap->ld); | |
| 158 ldap->ld = NULL; | |
| 159 } | |
| 160 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
161 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
|
162 print_ldap, finalize_ldap, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
163 NULL, NULL, ldap_description, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
164 Lisp_LDAP); |
| 996 | 165 |
| 166 /************************************************************************/ | |
| 167 /* Basic ldap accessors */ | |
| 168 /************************************************************************/ | |
| 169 | |
| 170 /* ###autoload */ | |
| 171 DEFUN ("ldapp", Fldapp, 1, 1, 0, /* | |
| 172 Return t if OBJECT is a LDAP connection. | |
| 173 */ | |
| 174 (object)) | |
| 175 { | |
| 176 return LDAPP (object) ? Qt : Qnil; | |
| 177 } | |
| 178 | |
| 179 DEFUN ("ldap-host", Fldap_host, 1, 1, 0, /* | |
| 180 Return the server host of the connection LDAP, as a string. | |
| 181 */ | |
| 182 (ldap)) | |
| 183 { | |
| 184 CHECK_LDAP (ldap); | |
| 185 return (XLDAP (ldap))->host; | |
| 186 } | |
| 187 | |
| 188 DEFUN ("ldap-live-p", Fldap_live_p, 1, 1, 0, /* | |
| 189 Return t if LDAP is an active LDAP connection. | |
| 190 */ | |
| 191 (ldap)) | |
| 192 { | |
| 193 CHECK_LDAP (ldap); | |
| 194 return (XLDAP (ldap))->ld ? Qt : Qnil; | |
| 195 } | |
| 196 | |
| 197 /************************************************************************/ | |
| 198 /* Opening/Closing a LDAP connection */ | |
| 199 /************************************************************************/ | |
| 200 | |
| 201 | |
| 202 /* ###autoload */ | |
| 203 DEFUN ("ldap-open", Fldap_open, 1, 2, 0, /* | |
| 204 Open a LDAP connection to HOST. | |
| 205 PLIST is a plist containing additional parameters for the connection. | |
| 428 | 206 Valid keys in that list are: |
| 996 | 207 `port' the TCP port to use for the connection if different from |
| 208 `ldap-default-port'. | |
| 428 | 209 `auth' is the authentication method to use, possible values depend on |
| 210 the LDAP library XEmacs was compiled with: `simple', `krbv41' and `krbv42'. | |
| 211 `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax). | |
| 212 `passwd' is the password to use for simple authentication. | |
| 213 `deref' is one of the symbols `never', `always', `search' or `find'. | |
| 214 `timelimit' is the timeout limit for the connection in seconds. | |
| 215 `sizelimit' is the maximum number of matches to return. | |
| 216 */ | |
| 996 | 217 (host, plist)) |
| 428 | 218 { |
| 996 | 219 /* This function can GC */ |
| 220 Lisp_LDAP *ldap; | |
| 428 | 221 LDAP *ld; |
| 996 | 222 int ldap_port = 0; |
| 428 | 223 int ldap_auth = LDAP_AUTH_SIMPLE; |
| 2367 | 224 Extbyte *ldap_binddn = NULL; |
| 225 Extbyte *ldap_password = NULL; | |
| 428 | 226 int ldap_deref = LDAP_DEREF_NEVER; |
| 227 int ldap_timelimit = 0; | |
| 228 int ldap_sizelimit = 0; | |
| 996 | 229 int err; |
| 428 | 230 |
| 996 | 231 CHECK_STRING (host); |
| 428 | 232 |
| 996 | 233 { |
| 234 EXTERNAL_PROPERTY_LIST_LOOP_3 (keyword, value, plist) | |
| 235 { | |
| 236 /* TCP Port */ | |
| 237 if (EQ (keyword, Qport)) | |
| 238 { | |
| 239 CHECK_INT (value); | |
| 240 ldap_port = XINT (value); | |
| 241 } | |
| 242 /* Authentication method */ | |
| 243 if (EQ (keyword, Qauth)) | |
| 244 { | |
| 245 if (EQ (value, Qsimple)) | |
| 246 ldap_auth = LDAP_AUTH_SIMPLE; | |
| 428 | 247 #ifdef LDAP_AUTH_KRBV41 |
| 996 | 248 else if (EQ (value, Qkrbv41)) |
| 249 ldap_auth = LDAP_AUTH_KRBV41; | |
| 428 | 250 #endif |
| 251 #ifdef LDAP_AUTH_KRBV42 | |
| 996 | 252 else if (EQ (value, Qkrbv42)) |
| 253 ldap_auth = LDAP_AUTH_KRBV42; | |
| 428 | 254 #endif |
| 996 | 255 else |
| 256 invalid_constant ("Invalid authentication method", value); | |
| 257 } | |
| 258 /* Bind DN */ | |
| 259 else if (EQ (keyword, Qbinddn)) | |
| 260 { | |
| 261 CHECK_STRING (value); | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
262 ldap_binddn = LISP_STRING_TO_EXTERNAL (value, Qnative); |
| 996 | 263 } |
| 264 /* Password */ | |
| 265 else if (EQ (keyword, Qpasswd)) | |
| 266 { | |
| 267 CHECK_STRING (value); | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
268 ldap_password = LISP_STRING_TO_EXTERNAL (value, Qnative); |
| 996 | 269 } |
| 270 /* Deref */ | |
| 271 else if (EQ (keyword, Qderef)) | |
| 272 { | |
| 273 if (EQ (value, Qnever)) | |
| 274 ldap_deref = LDAP_DEREF_NEVER; | |
| 275 else if (EQ (value, Qsearch)) | |
| 276 ldap_deref = LDAP_DEREF_SEARCHING; | |
| 277 else if (EQ (value, Qfind)) | |
| 278 ldap_deref = LDAP_DEREF_FINDING; | |
| 279 else if (EQ (value, Qalways)) | |
| 280 ldap_deref = LDAP_DEREF_ALWAYS; | |
| 281 else | |
| 282 invalid_constant ("Invalid deref value", value); | |
| 283 } | |
| 284 /* Timelimit */ | |
| 285 else if (EQ (keyword, Qtimelimit)) | |
| 286 { | |
| 287 CHECK_INT (value); | |
| 288 ldap_timelimit = XINT (value); | |
| 289 } | |
| 290 /* Sizelimit */ | |
| 291 else if (EQ (keyword, Qsizelimit)) | |
| 292 { | |
| 293 CHECK_INT (value); | |
| 294 ldap_sizelimit = XINT (value); | |
| 295 } | |
| 296 } | |
| 297 } | |
| 298 | |
| 299 if (ldap_port == 0) | |
| 300 { | |
| 301 ldap_port = ldap_default_port; | |
| 428 | 302 } |
| 303 | |
| 996 | 304 /* Connect to the server and bind */ |
| 305 slow_down_interrupts (); | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
306 ld = ldap_open (LISP_STRING_TO_EXTERNAL (host, Qnative), ldap_port); |
| 996 | 307 speed_up_interrupts (); |
| 428 | 308 |
| 996 | 309 if (ld == NULL ) |
| 310 report_process_error ("Failed connecting to host", host); | |
| 428 | 311 |
| 996 | 312 #ifdef HAVE_LDAP_SET_OPTION |
| 313 if ((err = ldap_set_option (ld, LDAP_OPT_DEREF, | |
| 314 (void *)&ldap_deref)) != LDAP_SUCCESS) | |
| 315 signal_ldap_error (ld, NULL, err); | |
| 316 if ((err = ldap_set_option (ld, LDAP_OPT_TIMELIMIT, | |
| 317 (void *)&ldap_timelimit)) != LDAP_SUCCESS) | |
| 318 signal_ldap_error (ld, NULL, err); | |
| 319 if ((err = ldap_set_option (ld, LDAP_OPT_SIZELIMIT, | |
| 320 (void *)&ldap_sizelimit)) != LDAP_SUCCESS) | |
| 321 signal_ldap_error (ld, NULL, err); | |
| 322 if ((err = ldap_set_option (ld, LDAP_OPT_REFERRALS, | |
| 323 LDAP_OPT_ON)) != LDAP_SUCCESS) | |
| 324 signal_ldap_error (ld, NULL, err); | |
| 325 if ((err = ldap_set_option (ld, LDAP_OPT_RESTART, | |
| 326 LDAP_OPT_ON)) != LDAP_SUCCESS) | |
| 327 signal_ldap_error (ld, NULL, err); | |
| 328 #else /* not HAVE_LDAP_SET_OPTION */ | |
| 428 | 329 ld->ld_deref = ldap_deref; |
| 330 ld->ld_timelimit = ldap_timelimit; | |
| 331 ld->ld_sizelimit = ldap_sizelimit; | |
| 332 #ifdef LDAP_REFERRALS | |
| 333 ld->ld_options = LDAP_OPT_REFERRALS; | |
| 996 | 334 #else /* not LDAP_REFERRALS */ |
| 428 | 335 ld->ld_options = 0; |
| 996 | 336 #endif /* not LDAP_REFERRALS */ |
| 337 /* XEmacs uses interrupts (SIGIO,SIGALRM), LDAP calls need to ignore them */ | |
| 338 ld->ld_options |= LDAP_OPT_RESTART; | |
| 339 #endif /* not HAVE_LDAP_SET_OPTION */ | |
| 340 | |
| 2272 | 341 err = ldap_bind_s (ld, ldap_binddn, ldap_password, ldap_auth); |
| 996 | 342 if (err != LDAP_SUCCESS) |
| 343 { | |
| 344 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
|
345 build_extstring (ldap_err2string (err), Qnative)); |
| 996 | 346 } |
| 347 | |
| 348 ldap = allocate_ldap (); | |
| 349 ldap->ld = ld; | |
| 350 ldap->host = host; | |
| 351 | |
| 352 return make_ldap (ldap); | |
| 353 } | |
| 354 | |
| 355 | |
| 356 | |
| 357 DEFUN ("ldap-close", Fldap_close, 1, 1, 0, /* | |
| 358 Close an LDAP connection. | |
| 359 */ | |
| 360 (ldap)) | |
| 361 { | |
| 362 Lisp_LDAP *lldap; | |
| 363 CHECK_LIVE_LDAP (ldap); | |
| 364 lldap = XLDAP (ldap); | |
| 365 ldap_unbind (lldap->ld); | |
| 366 lldap->ld = NULL; | |
| 367 return Qnil; | |
| 368 } | |
| 369 | |
| 370 | |
| 371 | |
| 372 /************************************************************************/ | |
| 373 /* Working on a LDAP connection */ | |
| 374 /************************************************************************/ | |
| 375 struct ldap_unwind_struct | |
| 376 { | |
| 377 LDAPMessage *res; | |
| 378 struct berval **vals; | |
| 379 }; | |
| 380 | |
| 381 static Lisp_Object | |
| 382 ldap_search_unwind (Lisp_Object unwind_obj) | |
| 383 { | |
| 384 struct ldap_unwind_struct *unwind = | |
| 385 (struct ldap_unwind_struct *) get_opaque_ptr (unwind_obj); | |
| 386 if (unwind->res) | |
| 387 ldap_msgfree (unwind->res); | |
| 388 if (unwind->vals) | |
| 389 ldap_value_free_len (unwind->vals); | |
| 390 return Qnil; | |
| 391 } | |
| 392 | |
| 393 /* The following function is called `ldap-search-basic' instead of */ | |
| 394 /* plain `ldap-search' to maintain compatibility with the XEmacs 21.1 */ | |
| 395 /* API where `ldap-search' was the name of the high-level search */ | |
| 396 /* function */ | |
| 428 | 397 |
| 996 | 398 DEFUN ("ldap-search-basic", Fldap_search_basic, 2, 8, 0, /* |
| 399 Perform a search on an open LDAP connection. | |
| 400 LDAP is an LDAP connection object created with `ldap-open'. | |
| 401 FILTER is a filter string for the search as described in RFC 1558. | |
| 402 BASE is the distinguished name at which to start the search. | |
| 403 SCOPE is one of the symbols `base', `onelevel' or `subtree' indicating | |
| 404 the scope of the search. | |
| 405 ATTRS is a list of strings indicating which attributes to retrieve | |
| 406 for each matching entry. If nil return all available attributes. | |
| 407 If ATTRSONLY is non-nil then only the attributes are retrieved, not | |
| 408 the associated values. | |
| 409 If WITHDN is non-nil each entry in the result will be prepended with | |
| 410 its distinguished name DN. | |
| 411 If VERBOSE is non-nil progress messages will be echoed. | |
| 412 The function returns a list of matching entries. Each entry is itself | |
| 413 an alist of attribute/value pairs optionally preceded by the DN of the | |
| 414 entry according to the value of WITHDN. | |
| 415 */ | |
| 416 (ldap, filter, base, scope, attrs, attrsonly, withdn, verbose)) | |
| 417 { | |
| 418 /* This function can GC */ | |
| 419 | |
| 420 /* Vars for query */ | |
| 421 LDAP *ld; | |
| 422 LDAPMessage *e; | |
| 423 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
|
424 Extbyte *a, *dn, *bs, *filt; |
| 996 | 425 int i, rc; |
| 426 int matches; | |
| 427 struct ldap_unwind_struct unwind; | |
| 428 | |
| 429 int ldap_scope = LDAP_SCOPE_SUBTREE; | |
| 2367 | 430 Extbyte **ldap_attributes = NULL; |
| 996 | 431 |
| 432 int speccount = specpdl_depth (); | |
| 433 | |
| 434 Lisp_Object list = Qnil; | |
| 435 Lisp_Object entry = Qnil; | |
| 436 Lisp_Object result = Qnil; | |
| 437 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 438 | |
| 439 GCPRO3 (list, entry, result); | |
| 440 | |
| 441 unwind.res = NULL; | |
| 442 unwind.vals = NULL; | |
| 443 | |
| 444 /* Do all the parameter checking */ | |
| 445 CHECK_LIVE_LDAP (ldap); | |
| 446 ld = XLDAP (ldap)->ld; | |
| 447 | |
| 448 /* Filter */ | |
| 449 CHECK_STRING (filter); | |
| 450 | |
| 451 /* Search base */ | |
| 452 if (NILP (base)) | |
| 453 { | |
| 454 base = Vldap_default_base; | |
| 455 } | |
| 456 if (!NILP (base)) | |
| 457 { | |
| 458 CHECK_STRING (base); | |
| 459 } | |
| 460 | |
| 461 /* Search scope */ | |
| 462 if (!NILP (scope)) | |
| 463 { | |
| 464 if (EQ (scope, Qbase)) | |
| 465 ldap_scope = LDAP_SCOPE_BASE; | |
| 466 else if (EQ (scope, Qonelevel)) | |
| 467 ldap_scope = LDAP_SCOPE_ONELEVEL; | |
| 468 else if (EQ (scope, Qsubtree)) | |
| 469 ldap_scope = LDAP_SCOPE_SUBTREE; | |
| 470 else | |
| 471 invalid_constant ("Invalid scope", scope); | |
| 472 } | |
| 473 | |
| 474 /* Attributes to search */ | |
| 475 if (!NILP (attrs)) | |
| 476 { | |
| 477 CHECK_CONS (attrs); | |
| 478 ldap_attributes = alloca_array (char *, 1 + XINT (Flength (attrs))); | |
| 479 | |
| 480 i = 0; | |
| 2367 | 481 { |
| 482 EXTERNAL_LIST_LOOP_2 (current, attrs) | |
| 483 { | |
| 484 CHECK_STRING (current); | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
485 ldap_attributes[i] = LISP_STRING_TO_EXTERNAL (current, Qnative); |
| 2367 | 486 ++i; |
| 487 } | |
| 488 } | |
| 996 | 489 ldap_attributes[i] = NULL; |
| 490 } | |
| 491 | |
| 492 /* Attributes only ? */ | |
| 493 CHECK_SYMBOL (attrsonly); | |
| 428 | 494 |
| 495 /* Perform the search */ | |
|
4824
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4710
diff
changeset
|
496 bs = NILP (base) ? (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 (base, Qnative); |
|
4824
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4710
diff
changeset
|
498 filt = NILP (filter) ? (Extbyte *) "" : |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
499 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
|
500 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
|
501 NILP (attrsonly) ? 0 : 1) |
| 996 | 502 == -1) |
| 428 | 503 { |
| 996 | 504 signal_ldap_error (ld, NULL, 0); |
| 428 | 505 } |
| 506 | |
| 996 | 507 /* Ensure we don't exit without cleaning up */ |
| 508 record_unwind_protect (ldap_search_unwind, | |
| 509 make_opaque_ptr (&unwind)); | |
| 510 | |
| 428 | 511 /* Build the results list */ |
| 512 matches = 0; | |
| 513 | |
| 996 | 514 rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &unwind.res); |
| 515 | |
| 516 while (rc == LDAP_RES_SEARCH_ENTRY) | |
| 428 | 517 { |
| 996 | 518 QUIT; |
| 428 | 519 matches ++; |
| 996 | 520 e = ldap_first_entry (ld, unwind.res); |
| 521 /* #### This call to message() is pretty fascist, because it | |
| 522 destroys the current echo area contents, even when invoked | |
| 523 from Lisp. It should use echo_area_message() instead, and | |
| 524 restore the old echo area contents later. */ | |
| 525 if (! NILP (verbose)) | |
| 526 message ("Parsing ldap results... %d", matches); | |
| 428 | 527 entry = Qnil; |
| 996 | 528 /* Get the DN if required */ |
| 529 if (! NILP (withdn)) | |
| 530 { | |
| 531 dn = ldap_get_dn (ld, e); | |
| 532 if (dn == NULL) | |
| 533 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
|
534 entry = Fcons (build_extstring (dn, Qnative), Qnil); |
| 996 | 535 } |
| 2367 | 536 for (a = ldap_first_attribute (ld, e, &ptr); |
| 428 | 537 a != NULL; |
| 2367 | 538 a = ldap_next_attribute (ld, e, ptr)) |
| 428 | 539 { |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
540 list = Fcons (build_extstring (a, Qnative), Qnil); |
| 996 | 541 unwind.vals = ldap_get_values_len (ld, e, a); |
| 542 if (unwind.vals != NULL) | |
| 428 | 543 { |
| 996 | 544 for (i = 0; unwind.vals[i] != NULL; i++) |
| 428 | 545 { |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
546 list = Fcons (make_extstring ((Extbyte *) unwind.vals[i]->bv_val, |
| 996 | 547 unwind.vals[i]->bv_len, |
| 548 Qnative), | |
| 428 | 549 list); |
| 550 } | |
| 551 } | |
| 552 entry = Fcons (Fnreverse (list), | |
| 553 entry); | |
| 996 | 554 ldap_value_free_len (unwind.vals); |
| 555 unwind.vals = NULL; | |
| 428 | 556 } |
| 557 result = Fcons (Fnreverse (entry), | |
| 558 result); | |
| 996 | 559 ldap_msgfree (unwind.res); |
| 560 unwind.res = NULL; | |
| 428 | 561 |
| 996 | 562 rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &(unwind.res)); |
| 428 | 563 } |
| 564 | |
| 996 | 565 #if defined HAVE_LDAP_PARSE_RESULT |
| 566 { | |
| 567 int rc2 = ldap_parse_result (ld, unwind.res, | |
| 568 &rc, | |
| 569 NULL, NULL, NULL, NULL, 0); | |
| 570 if (rc2 != LDAP_SUCCESS) | |
| 571 rc = rc2; | |
| 572 } | |
| 428 | 573 #else |
| 996 | 574 if (rc == 0) |
| 575 signal_ldap_error (ld, NULL, LDAP_TIMELIMIT_EXCEEDED); | |
| 576 | |
| 577 if (rc == -1) | |
| 578 signal_ldap_error (ld, unwind.res, (unwind.res==NULL) ? ld->ld_errno : 0); | |
| 579 | |
| 580 #if defined HAVE_LDAP_RESULT2ERROR | |
| 581 rc = ldap_result2error (ld, unwind.res, 0); | |
| 582 #endif | |
| 428 | 583 #endif |
| 996 | 584 |
| 585 if (rc != LDAP_SUCCESS) | |
| 586 signal_ldap_error (ld, NULL, rc); | |
| 587 | |
| 588 ldap_msgfree (unwind.res); | |
| 589 unwind.res = (LDAPMessage *)NULL; | |
| 590 | |
| 591 /* #### See above for calling message(). */ | |
| 592 if (! NILP (verbose)) | |
| 593 message ("Parsing ldap results... done"); | |
| 594 | |
| 595 unbind_to (speccount); | |
| 596 UNGCPRO; | |
| 597 return Fnreverse (result); | |
| 598 } | |
| 599 | |
| 600 DEFUN ("ldap-add", Fldap_add, 3, 3, 0, /* | |
| 601 Add an entry to an LDAP directory. | |
| 602 LDAP is an LDAP connection object created with `ldap-open'. | |
| 603 DN is the distinguished name of the entry to add. | |
| 604 ENTRY is an entry specification, i.e., a list of cons cells | |
| 605 containing attribute/value string pairs. | |
| 606 */ | |
| 607 (ldap, dn, entry)) | |
| 608 { | |
| 609 LDAP *ld; | |
| 610 LDAPMod *ldap_mods, **ldap_mods_ptrs; | |
| 611 struct berval *bervals; | |
| 612 int rc; | |
| 613 int i, j; | |
| 614 Elemcount len; | |
| 615 Lisp_Object values = Qnil; | |
| 2367 | 616 struct gcpro gcpro1; |
| 996 | 617 |
| 2367 | 618 GCPRO1 (values); |
| 996 | 619 |
| 620 /* Do all the parameter checking */ | |
| 621 CHECK_LIVE_LDAP (ldap); | |
| 622 ld = XLDAP (ldap)->ld; | |
| 623 | |
| 624 /* Check the DN */ | |
| 625 CHECK_STRING (dn); | |
| 626 | |
| 627 /* Check the entry */ | |
| 628 CHECK_CONS (entry); | |
| 629 if (NILP (entry)) | |
| 630 invalid_operation ("Cannot add void entry", entry); | |
| 428 | 631 |
| 996 | 632 /* Build the ldap_mods array */ |
| 633 len = (Elemcount) XINT (Flength (entry)); | |
| 634 ldap_mods = alloca_array (LDAPMod, len); | |
| 635 ldap_mods_ptrs = alloca_array (LDAPMod *, 1 + len); | |
| 636 i = 0; | |
| 2367 | 637 |
| 638 { | |
| 639 EXTERNAL_LIST_LOOP_2 (current, entry) | |
| 640 { | |
| 641 CHECK_CONS (current); | |
| 642 CHECK_STRING (XCAR (current)); | |
| 643 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
|
644 ldap_mods[i].mod_type = |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
645 LISP_STRING_TO_EXTERNAL (XCAR (current), Qnative); |
| 2367 | 646 ldap_mods[i].mod_op = LDAP_MOD_ADD | LDAP_MOD_BVALUES; |
| 647 values = XCDR (current); | |
| 648 if (CONSP (values)) | |
| 649 { | |
| 650 len = (Elemcount) XINT (Flength (values)); | |
| 651 bervals = alloca_array (struct berval, len); | |
| 652 ldap_mods[i].mod_vals.modv_bvals = | |
| 653 alloca_array (struct berval *, 1 + len); | |
| 654 j = 0; | |
| 655 { | |
| 656 EXTERNAL_LIST_LOOP_2 (cur2, values) | |
| 657 { | |
| 658 CHECK_STRING (cur2); | |
| 659 ldap_mods[i].mod_vals.modv_bvals[j] = &(bervals[j]); | |
| 660 TO_EXTERNAL_FORMAT (LISP_STRING, cur2, | |
| 661 ALLOCA, (bervals[j].bv_val, | |
| 662 bervals[j].bv_len), | |
| 663 Qnative); | |
| 664 j++; | |
| 665 } | |
| 666 } | |
| 667 ldap_mods[i].mod_vals.modv_bvals[j] = NULL; | |
| 668 } | |
| 669 else | |
| 670 { | |
| 671 CHECK_STRING (values); | |
| 672 bervals = alloca_array (struct berval, 1); | |
| 673 ldap_mods[i].mod_vals.modv_bvals = alloca_array (struct berval *, | |
| 674 2); | |
| 675 ldap_mods[i].mod_vals.modv_bvals[0] = &(bervals[0]); | |
| 676 TO_EXTERNAL_FORMAT (LISP_STRING, values, | |
| 677 ALLOCA, (bervals[0].bv_val, | |
| 678 bervals[0].bv_len), | |
| 679 Qnative); | |
| 680 ldap_mods[i].mod_vals.modv_bvals[1] = NULL; | |
| 681 } | |
| 682 i++; | |
| 683 } | |
| 684 } | |
| 996 | 685 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
|
686 rc = ldap_add_s (ld, LISP_STRING_TO_EXTERNAL (dn, Qnative), |
| 2367 | 687 ldap_mods_ptrs); |
| 996 | 688 if (rc != LDAP_SUCCESS) |
| 689 signal_ldap_error (ld, NULL, rc); | |
| 428 | 690 |
| 691 UNGCPRO; | |
| 996 | 692 return Qnil; |
| 693 } | |
| 694 | |
| 695 DEFUN ("ldap-modify", Fldap_modify, 3, 3, 0, /* | |
| 696 Add an entry to an LDAP directory. | |
| 697 LDAP is an LDAP connection object created with `ldap-open'. | |
| 698 DN is the distinguished name of the entry to modify. | |
| 699 MODS is a list of modifications to apply. | |
| 700 A modification is a list of the form (MOD-OP ATTR VALUE1 VALUE2 ...) | |
| 701 MOD-OP and ATTR are mandatory, VALUEs are optional depending on MOD-OP. | |
| 702 MOD-OP is the type of modification, one of the symbols `add', `delete' | |
| 703 or `replace'. ATTR is the LDAP attribute type to modify. | |
| 704 */ | |
| 705 (ldap, dn, mods)) | |
| 706 { | |
| 707 LDAP *ld; | |
| 708 LDAPMod *ldap_mods, **ldap_mods_ptrs; | |
| 709 struct berval *bervals; | |
| 710 int i, j, rc; | |
| 711 Lisp_Object mod_op; | |
| 712 Elemcount len; | |
| 713 Lisp_Object values = Qnil; | |
| 3029 | 714 struct gcpro gcpro1; |
| 996 | 715 |
| 716 /* Do all the parameter checking */ | |
| 717 CHECK_LIVE_LDAP (ldap); | |
| 718 ld = XLDAP (ldap)->ld; | |
| 719 | |
| 720 /* Check the DN */ | |
| 721 CHECK_STRING (dn); | |
| 722 | |
| 723 /* Check the entry */ | |
| 724 CHECK_CONS (mods); | |
| 725 if (NILP (mods)) | |
| 726 return Qnil; | |
| 727 | |
| 728 /* Build the ldap_mods array */ | |
| 729 len = (Elemcount) XINT (Flength (mods)); | |
| 730 ldap_mods = alloca_array (LDAPMod, len); | |
| 731 ldap_mods_ptrs = alloca_array (LDAPMod *, 1 + len); | |
| 732 i = 0; | |
| 733 | |
| 2367 | 734 GCPRO1 (values); |
| 735 { | |
| 736 EXTERNAL_LIST_LOOP_2 (current, mods) | |
| 737 { | |
| 738 CHECK_CONS (current); | |
| 739 CHECK_SYMBOL (XCAR (current)); | |
| 740 mod_op = XCAR (current); | |
| 741 ldap_mods_ptrs[i] = &(ldap_mods[i]); | |
| 742 ldap_mods[i].mod_op = LDAP_MOD_BVALUES; | |
| 743 if (EQ (mod_op, Qadd)) | |
| 744 ldap_mods[i].mod_op |= LDAP_MOD_ADD; | |
| 745 else if (EQ (mod_op, Qdelete)) | |
| 746 ldap_mods[i].mod_op |= LDAP_MOD_DELETE; | |
| 747 else if (EQ (mod_op, Qreplace)) | |
| 748 ldap_mods[i].mod_op |= LDAP_MOD_REPLACE; | |
| 749 else | |
| 750 invalid_constant ("Invalid LDAP modification type", mod_op); | |
| 751 current = XCDR (current); | |
| 752 CHECK_STRING (XCAR (current)); | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
753 ldap_mods[i].mod_type = |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
754 LISP_STRING_TO_EXTERNAL (XCAR (current), Qnative); |
| 2367 | 755 values = XCDR (current); |
| 756 len = (Elemcount) XINT (Flength (values)); | |
| 757 bervals = alloca_array (struct berval, len); | |
| 758 ldap_mods[i].mod_vals.modv_bvals = | |
| 759 alloca_array (struct berval *, 1 + len); | |
| 760 j = 0; | |
| 2387 | 761 { |
| 762 EXTERNAL_LIST_LOOP_2 (cur2, values) | |
| 763 { | |
| 764 CHECK_STRING (cur2); | |
| 765 ldap_mods[i].mod_vals.modv_bvals[j] = &(bervals[j]); | |
| 766 TO_EXTERNAL_FORMAT (LISP_STRING, cur2, | |
| 767 ALLOCA, (bervals[j].bv_val, | |
| 768 bervals[j].bv_len), | |
| 769 Qnative); | |
| 770 j++; | |
| 771 } | |
| 772 ldap_mods[i].mod_vals.modv_bvals[j] = NULL; | |
| 773 i++; | |
| 774 } | |
| 2367 | 775 } |
| 776 } | |
| 996 | 777 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
|
778 rc = ldap_modify_s (ld, LISP_STRING_TO_EXTERNAL (dn, Qnative), |
| 2367 | 779 ldap_mods_ptrs); |
| 996 | 780 if (rc != LDAP_SUCCESS) |
| 781 signal_ldap_error (ld, NULL, rc); | |
| 782 | |
| 783 UNGCPRO; | |
| 784 return Qnil; | |
| 785 } | |
| 786 | |
| 787 | |
| 788 DEFUN ("ldap-delete", Fldap_delete, 2, 2, 0, /* | |
| 789 Delete an entry to an LDAP directory. | |
| 790 LDAP is an LDAP connection object created with `ldap-open'. | |
| 791 DN is the distinguished name of the entry to delete. | |
| 792 */ | |
| 793 (ldap, dn)) | |
| 794 { | |
| 795 LDAP *ld; | |
| 796 int rc; | |
| 797 | |
| 798 /* Check parameters */ | |
| 799 CHECK_LIVE_LDAP (ldap); | |
| 800 ld = XLDAP (ldap)->ld; | |
| 801 CHECK_STRING (dn); | |
| 802 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
803 rc = ldap_delete_s (ld, LISP_STRING_TO_EXTERNAL (dn, Qnative)); |
| 996 | 804 if (rc != LDAP_SUCCESS) |
| 805 signal_ldap_error (ld, NULL, rc); | |
| 806 | |
| 807 return Qnil; | |
| 428 | 808 } |
| 809 | |
| 810 void | |
| 996 | 811 syms_of_eldap (void) |
| 428 | 812 { |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
813 INIT_LISP_OBJECT (ldap); |
| 428 | 814 |
| 996 | 815 DEFSYMBOL (Qeldap); |
| 816 DEFSYMBOL (Qldapp); | |
| 817 DEFSYMBOL (Qport); | |
| 818 DEFSYMBOL (Qauth); | |
| 819 DEFSYMBOL (Qbinddn); | |
| 820 DEFSYMBOL (Qpasswd); | |
| 821 DEFSYMBOL (Qderef); | |
| 822 DEFSYMBOL (Qtimelimit); | |
| 823 DEFSYMBOL (Qsizelimit); | |
| 824 DEFSYMBOL (Qbase); | |
| 825 DEFSYMBOL (Qonelevel); | |
| 826 DEFSYMBOL (Qsubtree); | |
| 827 DEFSYMBOL (Qkrbv41); | |
| 828 DEFSYMBOL (Qkrbv42); | |
| 829 DEFSYMBOL (Qnever); | |
| 830 DEFSYMBOL (Qalways); | |
| 831 DEFSYMBOL (Qfind); | |
| 832 DEFSYMBOL (Qadd); | |
| 833 DEFSYMBOL (Qreplace); | |
| 834 | |
| 835 DEFSUBR (Fldapp); | |
| 836 DEFSUBR (Fldap_host); | |
| 837 DEFSUBR (Fldap_live_p); | |
| 838 DEFSUBR (Fldap_open); | |
| 839 DEFSUBR (Fldap_close); | |
| 840 DEFSUBR (Fldap_search_basic); | |
| 841 DEFSUBR (Fldap_add); | |
| 842 DEFSUBR (Fldap_modify); | |
| 843 DEFSUBR (Fldap_delete); | |
| 428 | 844 } |
| 845 | |
| 846 void | |
| 996 | 847 vars_of_eldap (void) |
| 428 | 848 { |
| 996 | 849 |
| 850 Fprovide (Qeldap); | |
| 428 | 851 |
| 996 | 852 ldap_default_port = LDAP_PORT; |
| 853 Vldap_default_base = Qnil; | |
| 854 | |
| 855 DEFVAR_INT ("ldap-default-port", &ldap_default_port /* | |
| 856 Default TCP port for LDAP connections. | |
| 857 Initialized from the LDAP library. Default value is 389. | |
| 428 | 858 */ ); |
| 859 | |
| 860 DEFVAR_LISP ("ldap-default-base", &Vldap_default_base /* | |
| 861 Default base for LDAP searches. | |
| 862 This is a string using the syntax of RFC 1779. | |
| 863 For instance, "o=ACME, c=US" limits the search to the | |
| 864 Acme organization in the United States. | |
| 865 */ ); | |
| 866 | |
| 867 } | |
| 868 | |
| 996 | 869 #ifdef HAVE_SHLIB |
| 1706 | 870 EXTERN_C void unload_eldap (void); |
| 996 | 871 void |
| 872 unload_eldap (void) | |
| 873 { | |
| 874 /* Remove defined types */ | |
|
5120
d1247f3cc363
latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents:
5119
diff
changeset
|
875 UNDEF_LISP_OBJECT (ldap); |
| 996 | 876 |
| 877 /* Remove staticpro'ing of symbols */ | |
| 878 unstaticpro_nodump (&Qeldap); | |
| 879 unstaticpro_nodump (&Qldapp); | |
| 880 unstaticpro_nodump (&Qport); | |
| 881 unstaticpro_nodump (&Qauth); | |
| 882 unstaticpro_nodump (&Qbinddn); | |
| 883 unstaticpro_nodump (&Qpasswd); | |
| 884 unstaticpro_nodump (&Qderef); | |
| 885 unstaticpro_nodump (&Qtimelimit); | |
| 886 unstaticpro_nodump (&Qsizelimit); | |
| 887 unstaticpro_nodump (&Qbase); | |
| 888 unstaticpro_nodump (&Qonelevel); | |
| 889 unstaticpro_nodump (&Qsubtree); | |
| 890 unstaticpro_nodump (&Qkrbv41); | |
| 891 unstaticpro_nodump (&Qkrbv42); | |
| 892 unstaticpro_nodump (&Qnever); | |
| 893 unstaticpro_nodump (&Qalways); | |
| 894 unstaticpro_nodump (&Qfind); | |
| 895 unstaticpro_nodump (&Qadd); | |
| 896 unstaticpro_nodump (&Qreplace); | |
| 897 } | |
| 898 #endif /* HAVE_SHLIB */ |