Mercurial > hg > xemacs-beta
view lisp/ldap.el @ 5127:a9c41067dd88 ben-lisp-object
more cleanups, terminology clarification, lots of doc work
-------------------- ChangeLog entries follow: --------------------
man/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* internals/internals.texi (Introduction to Allocation):
* internals/internals.texi (Integers and Characters):
* internals/internals.texi (Allocation from Frob Blocks):
* internals/internals.texi (lrecords):
* internals/internals.texi (Low-level allocation):
Rewrite section on allocation of Lisp objects to reflect the new
reality. Remove references to nonexistent XSETINT and XSETCHAR.
modules/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c (allocate_pgconn):
* postgresql/postgresql.c (allocate_pgresult):
* postgresql/postgresql.h (struct Lisp_PGconn):
* postgresql/postgresql.h (struct Lisp_PGresult):
* ldap/eldap.c (allocate_ldap):
* ldap/eldap.h (struct Lisp_LDAP):
Same changes as in src/ dir. See large log there in ChangeLog,
but basically:
ALLOC_LISP_OBJECT -> ALLOC_NORMAL_LISP_OBJECT
LISP_OBJECT_HEADER -> NORMAL_LISP_OBJECT_HEADER
../hlo/src/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (old_alloc_sized_lcrecord):
* alloc.c (very_old_free_lcrecord):
* alloc.c (copy_lisp_object):
* alloc.c (zero_sized_lisp_object):
* alloc.c (zero_nonsized_lisp_object):
* alloc.c (lisp_object_storage_size):
* alloc.c (free_normal_lisp_object):
* alloc.c (FREE_FIXED_TYPE_WHEN_NOT_IN_GC):
* alloc.c (ALLOC_FROB_BLOCK_LISP_OBJECT):
* alloc.c (Fcons):
* alloc.c (noseeum_cons):
* alloc.c (make_float):
* alloc.c (make_bignum):
* alloc.c (make_bignum_bg):
* alloc.c (make_ratio):
* alloc.c (make_ratio_bg):
* alloc.c (make_ratio_rt):
* alloc.c (make_bigfloat):
* alloc.c (make_bigfloat_bf):
* alloc.c (size_vector):
* alloc.c (make_compiled_function):
* alloc.c (Fmake_symbol):
* alloc.c (allocate_extent):
* alloc.c (allocate_event):
* alloc.c (make_key_data):
* alloc.c (make_button_data):
* alloc.c (make_motion_data):
* alloc.c (make_process_data):
* alloc.c (make_timeout_data):
* alloc.c (make_magic_data):
* alloc.c (make_magic_eval_data):
* alloc.c (make_eval_data):
* alloc.c (make_misc_user_data):
* alloc.c (Fmake_marker):
* alloc.c (noseeum_make_marker):
* alloc.c (size_string_direct_data):
* alloc.c (make_uninit_string):
* alloc.c (make_string_nocopy):
* alloc.c (mark_lcrecord_list):
* alloc.c (alloc_managed_lcrecord):
* alloc.c (free_managed_lcrecord):
* alloc.c (sweep_lcrecords_1):
* alloc.c (malloced_storage_size):
* buffer.c (allocate_buffer):
* buffer.c (compute_buffer_usage):
* buffer.c (DEFVAR_BUFFER_LOCAL_1):
* buffer.c (nuke_all_buffer_slots):
* buffer.c (common_init_complex_vars_of_buffer):
* buffer.h (struct buffer_text):
* buffer.h (struct buffer):
* bytecode.c:
* bytecode.c (make_compiled_function_args):
* bytecode.c (size_compiled_function_args):
* bytecode.h (struct compiled_function_args):
* casetab.c (allocate_case_table):
* casetab.h (struct Lisp_Case_Table):
* charset.h (struct Lisp_Charset):
* chartab.c (fill_char_table):
* chartab.c (Fmake_char_table):
* chartab.c (make_char_table_entry):
* chartab.c (copy_char_table_entry):
* chartab.c (Fcopy_char_table):
* chartab.c (put_char_table):
* chartab.h (struct Lisp_Char_Table_Entry):
* chartab.h (struct Lisp_Char_Table):
* console-gtk-impl.h (struct gtk_device):
* console-gtk-impl.h (struct gtk_frame):
* console-impl.h (struct console):
* console-msw-impl.h (struct Lisp_Devmode):
* console-msw-impl.h (struct mswindows_device):
* console-msw-impl.h (struct msprinter_device):
* console-msw-impl.h (struct mswindows_frame):
* console-msw-impl.h (struct mswindows_dialog_id):
* console-stream-impl.h (struct stream_console):
* console-stream.c (stream_init_console):
* console-tty-impl.h (struct tty_console):
* console-tty-impl.h (struct tty_device):
* console-tty.c (allocate_tty_console_struct):
* console-x-impl.h (struct x_device):
* console-x-impl.h (struct x_frame):
* console.c (allocate_console):
* console.c (nuke_all_console_slots):
* console.c (DEFVAR_CONSOLE_LOCAL_1):
* console.c (common_init_complex_vars_of_console):
* data.c (make_weak_list):
* data.c (make_weak_box):
* data.c (make_ephemeron):
* database.c:
* database.c (struct Lisp_Database):
* database.c (allocate_database):
* database.c (finalize_database):
* device-gtk.c (allocate_gtk_device_struct):
* device-impl.h (struct device):
* device-msw.c:
* device-msw.c (mswindows_init_device):
* device-msw.c (msprinter_init_device):
* device-msw.c (finalize_devmode):
* device-msw.c (allocate_devmode):
* device-tty.c (allocate_tty_device_struct):
* device-x.c (allocate_x_device_struct):
* device.c:
* device.c (nuke_all_device_slots):
* device.c (allocate_device):
* dialog-msw.c (handle_question_dialog_box):
* elhash.c:
* elhash.c (struct Lisp_Hash_Table):
* elhash.c (finalize_hash_table):
* elhash.c (make_general_lisp_hash_table):
* elhash.c (Fcopy_hash_table):
* elhash.h (htentry):
* emacs.c (main_1):
* eval.c:
* eval.c (size_multiple_value):
* event-stream.c (finalize_command_builder):
* event-stream.c (allocate_command_builder):
* event-stream.c (free_command_builder):
* event-stream.c (event_stream_generate_wakeup):
* event-stream.c (event_stream_resignal_wakeup):
* event-stream.c (event_stream_disable_wakeup):
* event-stream.c (event_stream_wakeup_pending_p):
* events.h (struct Lisp_Timeout):
* events.h (struct command_builder):
* extents-impl.h:
* extents-impl.h (struct extent_auxiliary):
* extents-impl.h (struct extent_info):
* extents-impl.h (set_extent_no_chase_aux_field):
* extents-impl.h (set_extent_no_chase_normal_field):
* extents.c:
* extents.c (gap_array_marker):
* extents.c (gap_array):
* extents.c (extent_list_marker):
* extents.c (extent_list):
* extents.c (stack_of_extents):
* extents.c (gap_array_make_marker):
* extents.c (extent_list_make_marker):
* extents.c (allocate_extent_list):
* extents.c (SLOT):
* extents.c (mark_extent_auxiliary):
* extents.c (allocate_extent_auxiliary):
* extents.c (attach_extent_auxiliary):
* extents.c (size_gap_array):
* extents.c (finalize_extent_info):
* extents.c (allocate_extent_info):
* extents.c (uninit_buffer_extents):
* extents.c (allocate_soe):
* extents.c (copy_extent):
* extents.c (vars_of_extents):
* extents.h:
* faces.c (allocate_face):
* faces.h (struct Lisp_Face):
* faces.h (struct face_cachel):
* file-coding.c:
* file-coding.c (finalize_coding_system):
* file-coding.c (sizeof_coding_system):
* file-coding.c (Fcopy_coding_system):
* file-coding.h (struct Lisp_Coding_System):
* file-coding.h (MARKED_SLOT):
* fns.c (size_bit_vector):
* font-mgr.c:
* font-mgr.c (finalize_fc_pattern):
* font-mgr.c (print_fc_pattern):
* font-mgr.c (Ffc_pattern_p):
* font-mgr.c (Ffc_pattern_create):
* font-mgr.c (Ffc_name_parse):
* font-mgr.c (Ffc_name_unparse):
* font-mgr.c (Ffc_pattern_duplicate):
* font-mgr.c (Ffc_pattern_add):
* font-mgr.c (Ffc_pattern_del):
* font-mgr.c (Ffc_pattern_get):
* font-mgr.c (fc_config_create_using):
* font-mgr.c (fc_strlist_to_lisp_using):
* font-mgr.c (fontset_to_list):
* font-mgr.c (Ffc_config_p):
* font-mgr.c (Ffc_config_up_to_date):
* font-mgr.c (Ffc_config_build_fonts):
* font-mgr.c (Ffc_config_get_cache):
* font-mgr.c (Ffc_config_get_fonts):
* font-mgr.c (Ffc_config_set_current):
* font-mgr.c (Ffc_config_get_blanks):
* font-mgr.c (Ffc_config_get_rescan_interval):
* font-mgr.c (Ffc_config_set_rescan_interval):
* font-mgr.c (Ffc_config_app_font_add_file):
* font-mgr.c (Ffc_config_app_font_add_dir):
* font-mgr.c (Ffc_config_app_font_clear):
* font-mgr.c (size):
* font-mgr.c (Ffc_config_substitute):
* font-mgr.c (Ffc_font_render_prepare):
* font-mgr.c (Ffc_font_match):
* font-mgr.c (Ffc_font_sort):
* font-mgr.c (finalize_fc_config):
* font-mgr.c (print_fc_config):
* font-mgr.h:
* font-mgr.h (struct fc_pattern):
* font-mgr.h (XFC_PATTERN):
* font-mgr.h (struct fc_config):
* font-mgr.h (XFC_CONFIG):
* frame-gtk.c (allocate_gtk_frame_struct):
* frame-impl.h (struct frame):
* frame-msw.c (mswindows_init_frame_1):
* frame-x.c (allocate_x_frame_struct):
* frame.c (nuke_all_frame_slots):
* frame.c (allocate_frame_core):
* gc.c:
* gc.c (GC_CHECK_NOT_FREE):
* glyphs.c (finalize_image_instance):
* glyphs.c (allocate_image_instance):
* glyphs.c (Fcolorize_image_instance):
* glyphs.c (allocate_glyph):
* glyphs.c (unmap_subwindow_instance_cache_mapper):
* glyphs.c (register_ignored_expose):
* glyphs.h (struct Lisp_Image_Instance):
* glyphs.h (struct Lisp_Glyph):
* glyphs.h (struct glyph_cachel):
* glyphs.h (struct expose_ignore):
* gui.c (allocate_gui_item):
* gui.h (struct Lisp_Gui_Item):
* keymap.c (struct Lisp_Keymap):
* keymap.c (make_keymap):
* lisp.h:
* lisp.h (struct Lisp_String_Direct_Data):
* lisp.h (struct Lisp_String_Indirect_Data):
* lisp.h (struct Lisp_Vector):
* lisp.h (struct Lisp_Bit_Vector):
* lisp.h (DECLARE_INLINE_LISP_BIT_VECTOR):
* lisp.h (struct weak_box):
* lisp.h (struct ephemeron):
* lisp.h (struct weak_list):
* lrecord.h:
* lrecord.h (struct lrecord_implementation):
* lrecord.h (MC_ALLOC_CALL_FINALIZER):
* lrecord.h (struct lcrecord_list):
* lstream.c (finalize_lstream):
* lstream.c (sizeof_lstream):
* lstream.c (Lstream_new):
* lstream.c (Lstream_delete):
* lstream.h (struct lstream):
* marker.c:
* marker.c (finalize_marker):
* marker.c (compute_buffer_marker_usage):
* mule-charset.c:
* mule-charset.c (make_charset):
* mule-charset.c (compute_charset_usage):
* objects-impl.h (struct Lisp_Color_Instance):
* objects-impl.h (struct Lisp_Font_Instance):
* objects-tty-impl.h (struct tty_color_instance_data):
* objects-tty-impl.h (struct tty_font_instance_data):
* objects-tty.c (tty_initialize_color_instance):
* objects-tty.c (tty_initialize_font_instance):
* objects.c (finalize_color_instance):
* objects.c (Fmake_color_instance):
* objects.c (finalize_font_instance):
* objects.c (Fmake_font_instance):
* objects.c (reinit_vars_of_objects):
* opaque.c:
* opaque.c (sizeof_opaque):
* opaque.c (make_opaque_ptr):
* opaque.c (free_opaque_ptr):
* opaque.h:
* opaque.h (Lisp_Opaque):
* opaque.h (Lisp_Opaque_Ptr):
* print.c (printing_unreadable_lcrecord):
* print.c (external_object_printer):
* print.c (debug_p4):
* process.c (finalize_process):
* process.c (make_process_internal):
* procimpl.h (struct Lisp_Process):
* rangetab.c (Fmake_range_table):
* rangetab.c (Fcopy_range_table):
* rangetab.h (struct Lisp_Range_Table):
* scrollbar.c:
* scrollbar.c (create_scrollbar_instance):
* scrollbar.c (compute_scrollbar_instance_usage):
* scrollbar.h (struct scrollbar_instance):
* specifier.c (finalize_specifier):
* specifier.c (sizeof_specifier):
* specifier.c (set_specifier_caching):
* specifier.h (struct Lisp_Specifier):
* specifier.h (struct specifier_caching):
* symeval.h:
* symeval.h (SYMBOL_VALUE_MAGIC_P):
* symeval.h (DEFVAR_SYMVAL_FWD):
* symsinit.h:
* syntax.c (init_buffer_syntax_cache):
* syntax.h (struct syntax_cache):
* toolbar.c:
* toolbar.c (allocate_toolbar_button):
* toolbar.c (update_toolbar_button):
* toolbar.h (struct toolbar_button):
* tooltalk.c (struct Lisp_Tooltalk_Message):
* tooltalk.c (make_tooltalk_message):
* tooltalk.c (struct Lisp_Tooltalk_Pattern):
* tooltalk.c (make_tooltalk_pattern):
* ui-gtk.c:
* ui-gtk.c (allocate_ffi_data):
* ui-gtk.c (emacs_gtk_object_finalizer):
* ui-gtk.c (allocate_emacs_gtk_object_data):
* ui-gtk.c (allocate_emacs_gtk_boxed_data):
* ui-gtk.h:
* window-impl.h (struct window):
* window-impl.h (struct window_mirror):
* window.c (finalize_window):
* window.c (allocate_window):
* window.c (new_window_mirror):
* window.c (mark_window_as_deleted):
* window.c (make_dummy_parent):
* window.c (compute_window_mirror_usage):
* window.c (compute_window_usage):
Overall point of this change and previous ones in this repository:
(1) Introduce new, clearer terminology: everything other than int
or char is a "record" object, which comes in two types: "normal
objects" and "frob-block objects". Fix up all places that
referred to frob-block objects as "simple", "basic", etc.
(2) Provide an advertised interface for doing operations on Lisp
objects, including creating new types, that is clean and
consistent in its naming, uses the above-referenced terms and
avoids referencing "lrecords", "old lcrecords", etc., which should
hide under the surface.
(3) Make the size_in_bytes and finalizer methods take a
Lisp_Object rather than a void * for consistency with other methods.
(4) Separate finalizer method into finalizer and disksaver, so
that normal finalize methods don't have to worry about disksaving.
Other specifics:
(1) Renaming:
LISP_OBJECT_HEADER -> NORMAL_LISP_OBJECT_HEADER
ALLOC_LISP_OBJECT -> ALLOC_NORMAL_LISP_OBJECT
implementation->basic_p -> implementation->frob_block_p
ALLOCATE_FIXED_TYPE_AND_SET_IMPL -> ALLOC_FROB_BLOCK_LISP_OBJECT
*FCCONFIG*, wrap_fcconfig -> *FC_CONFIG*, wrap_fc_config
*FCPATTERN*, wrap_fcpattern -> *FC_PATTERN*, wrap_fc_pattern
(the last two changes make the naming of these macros consistent
with the naming of all other macros, since the objects are named
fc-config and fc-pattern with a hyphen)
(2) Lots of documentation fixes in lrecord.h.
(3) Eliminate macros for copying, freeing, zeroing objects, getting
their storage size. Instead, new functions:
zero_sized_lisp_object()
zero_nonsized_lisp_object()
lisp_object_storage_size()
free_normal_lisp_object()
(copy_lisp_object() already exists)
LISP_OBJECT_FROB_BLOCK_P() (actually a macro)
Eliminated:
free_lrecord()
zero_lrecord()
copy_lrecord()
copy_sized_lrecord()
old_copy_lcrecord()
old_copy_sized_lcrecord()
old_zero_lcrecord()
old_zero_sized_lcrecord()
LISP_OBJECT_STORAGE_SIZE()
COPY_SIZED_LISP_OBJECT()
COPY_SIZED_LCRECORD()
COPY_LISP_OBJECT()
ZERO_LISP_OBJECT()
FREE_LISP_OBJECT()
(4) Catch the remaining places where lrecord stuff was used directly
and use the advertised interface, e.g. alloc_sized_lrecord() ->
ALLOC_SIZED_LISP_OBJECT().
(5) Make certain statically-declared pseudo-objects
(buffer_local_flags, console_local_flags) have their lheader
initialized correctly, so things like copy_lisp_object() can work
on them. Make extent_auxiliary_defaults a proper heap object
Vextent_auxiliary_defaults, and make extent auxiliaries dumpable
so that this object can be dumped. allocate_extent_auxiliary()
now just creates the object, and attach_extent_auxiliary()
creates an extent auxiliary and attaches to an extent, like the
old allocate_extent_auxiliary().
(6) Create EXTENT_AUXILIARY_SLOTS macro, similar to the foo-slots.h
files but in a macro instead of a file. The purpose is to avoid
duplication when iterating over all the slots in an extent auxiliary.
Use it.
(7) In lstream.c, don't zero out object after allocation because
allocation routines take care of this.
(8) In marker.c, fix a mistake in computing marker overhead.
(9) In print.c, clean up printing_unreadable_lcrecord(),
external_object_printer() to avoid lots of ifdef NEW_GC's.
(10) Separate toolbar-button allocation into a separate
allocate_toolbar_button() function for use in the example code
in lrecord.h.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Fri, 05 Mar 2010 04:08:17 -0600 |
| parents | e29fcfd8df5f |
| children | f00192e1cd49 91b3aa59f49b |
line wrap: on
line source
;;; ldap.el --- LDAP support for Emacs ;; Copyright (C) 1997 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> ;; Created: Jan 1998 ;; Version: $Revision: 1.12 $ ;; Keywords: help comm ;; This file is part of XEmacs ;; XEmacs is free software; you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; XEmacs is distributed in the hope that it will be useful, but ;; WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with XEmacs; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: ;; This file provides mid-level and user-level functions to access directory ;; servers using the LDAP protocol (RFC 1777). ;;; Installation: ;; LDAP support must have been built into XEmacs. ;;; Code: (globally-declare-fboundp '(ldapp ldap-open ldap-close ldap-add ldap-modify ldap-delete)) (eval-when '(load) (if (not (fboundp 'ldap-open)) (error "No LDAP support compiled in this XEmacs"))) (defgroup ldap nil "Lightweight Directory Access Protocol" :group 'comm) (defcustom ldap-default-host nil "*Default LDAP server hostname. A TCP port number can be appended to that name using a colon as a separator." :type '(choice (string :tag "Host name") (const :tag "Use library default" nil)) :group 'ldap) (defcustom ldap-default-port nil "*Default TCP port for LDAP connections. Initialized from the LDAP library at build time. Default value is 389." :type '(choice (const :tag "Use library default" nil) (integer :tag "Port number")) :group 'ldap) (defcustom ldap-default-base nil "*Default base for LDAP searches. This is a string using the syntax of RFC 1779. For instance, \"o=ACME, c=US\" limits the search to the Acme organization in the United States." :type '(choice (const :tag "Use library default" nil) (string :tag "Search base")) :group 'ldap) (defcustom ldap-host-parameters-alist nil "*Alist of host-specific options for LDAP transactions. The format of each list element is: \(HOST PROP1 VAL1 PROP2 VAL2 ...) HOST is the hostname of an LDAP server (with an optional TCP port number appended to it using a colon as a separator). PROPn and VALn are property/value pairs describing parameters for the server. Valid properties include: `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax). `passwd' is the password to use for simple authentication. `auth' is the authentication method to use. Possible values are: `simple', `krbv41' and `krbv42'. `base' is the base for the search as described in RFC 1779. `scope' is one of the three symbols `subtree', `base' or `onelevel'. `deref' is one of the symbols `never', `always', `search' or `find'. `timelimit' is the timeout limit for the connection in seconds. `sizelimit' is the maximum number of matches to return." :type '(repeat :menu-tag "Host parameters" :tag "Host parameters" (list :menu-tag "Host parameters" :tag "Host parameters" :value nil (string :tag "Host name") (checklist :inline t :greedy t (list :tag "Search Base" :inline t (const :tag "Search Base" base) string) (list :tag "Binding DN" :inline t (const :tag "Binding DN" binddn) string) (list :tag "Password" :inline t (const :tag "Password" passwd) string) (list :tag "Authentication Method" :inline t (const :tag "Authentication Method" auth) (choice (const :menu-tag "None" :tag "None" nil) (const :menu-tag "Simple" :tag "Simple" simple) (const :menu-tag "Kerberos 4.1" :tag "Kerberos 4.1" krbv41) (const :menu-tag "Kerberos 4.2" :tag "Kerberos 4.2" krbv42))) (list :tag "Search Scope" :inline t (const :tag "Search Scope" scope) (choice (const :menu-tag "Default" :tag "Default" nil) (const :menu-tag "Subtree" :tag "Subtree" subtree) (const :menu-tag "Base" :tag "Base" base) (const :menu-tag "One Level" :tag "One Level" onelevel))) (list :tag "Dereferencing" :inline t (const :tag "Dereferencing" deref) (choice (const :menu-tag "Default" :tag "Default" nil) (const :menu-tag "Never" :tag "Never" never) (const :menu-tag "Always" :tag "Always" always) (const :menu-tag "When searching" :tag "When searching" search) (const :menu-tag "When locating base" :tag "When locating base" find))) (list :tag "Time Limit" :inline t (const :tag "Time Limit" timelimit) (integer :tag "(in seconds)")) (list :tag "Size Limit" :inline t (const :tag "Size Limit" sizelimit) (integer :tag "(number of records)"))))) :group 'ldap) (defcustom ldap-verbose nil "*If non-nil, LDAP operations echo progress messages." :type 'boolean :group 'ldap) (defcustom ldap-ignore-attribute-codings nil "*If non-nil, do not perform any encoding/decoding on LDAP attribute values." :type 'boolean :group 'ldap) (defcustom ldap-default-attribute-decoder nil "*Decoder function to use for attributes whose syntax is unknown." :type 'symbol :group 'ldap) (defcustom ldap-coding-system nil "*Coding system of LDAP string values. LDAP v3 specifies the coding system of strings to be UTF-8. Mule support is needed for this." :type 'symbol :group 'ldap) (defvar ldap-attribute-syntax-encoders [nil ; 1 ACI Item N nil ; 2 Access Point Y nil ; 3 Attribute Type Description Y nil ; 4 Audio N nil ; 5 Binary N nil ; 6 Bit String Y ldap-encode-boolean ; 7 Boolean Y nil ; 8 Certificate N nil ; 9 Certificate List N nil ; 10 Certificate Pair N ldap-encode-country-string ; 11 Country String Y ldap-encode-string ; 12 DN Y nil ; 13 Data Quality Syntax Y nil ; 14 Delivery Method Y ldap-encode-string ; 15 Directory String Y nil ; 16 DIT Content Rule Description Y nil ; 17 DIT Structure Rule Description Y nil ; 18 DL Submit Permission Y nil ; 19 DSA Quality Syntax Y nil ; 20 DSE Type Y nil ; 21 Enhanced Guide Y nil ; 22 Facsimile Telephone Number Y nil ; 23 Fax N nil ; 24 Generalized Time Y nil ; 25 Guide Y nil ; 26 IA5 String Y number-to-string ; 27 INTEGER Y nil ; 28 JPEG N nil ; 29 Master And Shadow Access Points Y nil ; 30 Matching Rule Description Y nil ; 31 Matching Rule Use Description Y nil ; 32 Mail Preference Y nil ; 33 MHS OR Address Y nil ; 34 Name And Optional UID Y nil ; 35 Name Form Description Y nil ; 36 Numeric String Y nil ; 37 Object Class Description Y nil ; 38 OID Y nil ; 39 Other Mailbox Y nil ; 40 Octet String Y ldap-encode-address ; 41 Postal Address Y nil ; 42 Protocol Information Y nil ; 43 Presentation Address Y ldap-encode-string ; 44 Printable String Y nil ; 45 Subtree Specification Y nil ; 46 Supplier Information Y nil ; 47 Supplier Or Consumer Y nil ; 48 Supplier And Consumer Y nil ; 49 Supported Algorithm N nil ; 50 Telephone Number Y nil ; 51 Teletex Terminal Identifier Y nil ; 52 Telex Number Y nil ; 53 UTC Time Y nil ; 54 LDAP Syntax Description Y nil ; 55 Modify Rights Y nil ; 56 LDAP Schema Definition Y nil ; 57 LDAP Schema Description Y nil ; 58 Substring Assertion Y ] "A vector of functions used to encode LDAP attribute values. The sequence of functions corresponds to the sequence of LDAP attribute syntax object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in RFC2252 section 4.3.2") (defvar ldap-attribute-syntax-decoders [nil ; 1 ACI Item N nil ; 2 Access Point Y nil ; 3 Attribute Type Description Y nil ; 4 Audio N nil ; 5 Binary N nil ; 6 Bit String Y ldap-decode-boolean ; 7 Boolean Y nil ; 8 Certificate N nil ; 9 Certificate List N nil ; 10 Certificate Pair N ldap-decode-string ; 11 Country String Y ldap-decode-string ; 12 DN Y nil ; 13 Data Quality Syntax Y nil ; 14 Delivery Method Y ldap-decode-string ; 15 Directory String Y nil ; 16 DIT Content Rule Description Y nil ; 17 DIT Structure Rule Description Y nil ; 18 DL Submit Permission Y nil ; 19 DSA Quality Syntax Y nil ; 20 DSE Type Y nil ; 21 Enhanced Guide Y nil ; 22 Facsimile Telephone Number Y nil ; 23 Fax N nil ; 24 Generalized Time Y nil ; 25 Guide Y nil ; 26 IA5 String Y string-to-number ; 27 INTEGER Y nil ; 28 JPEG N nil ; 29 Master And Shadow Access Points Y nil ; 30 Matching Rule Description Y nil ; 31 Matching Rule Use Description Y nil ; 32 Mail Preference Y nil ; 33 MHS OR Address Y nil ; 34 Name And Optional UID Y nil ; 35 Name Form Description Y nil ; 36 Numeric String Y nil ; 37 Object Class Description Y nil ; 38 OID Y nil ; 39 Other Mailbox Y nil ; 40 Octet String Y ldap-decode-address ; 41 Postal Address Y nil ; 42 Protocol Information Y nil ; 43 Presentation Address Y ldap-decode-string ; 44 Printable String Y nil ; 45 Subtree Specification Y nil ; 46 Supplier Information Y nil ; 47 Supplier Or Consumer Y nil ; 48 Supplier And Consumer Y nil ; 49 Supported Algorithm N nil ; 50 Telephone Number Y nil ; 51 Teletex Terminal Identifier Y nil ; 52 Telex Number Y nil ; 53 UTC Time Y nil ; 54 LDAP Syntax Description Y nil ; 55 Modify Rights Y nil ; 56 LDAP Schema Definition Y nil ; 57 LDAP Schema Description Y nil ; 58 Substring Assertion Y ] "A vector of functions used to decode LDAP attribute values. The sequence of functions corresponds to the sequence of LDAP attribute syntax object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in RFC2252 section 4.3.2") (defvar ldap-attribute-syntaxes-alist '((createtimestamp . 24) (modifytimestamp . 24) (creatorsname . 12) (modifiersname . 12) (subschemasubentry . 12) (attributetypes . 3) (objectclasses . 37) (matchingrules . 30) (matchingruleuse . 31) (namingcontexts . 12) (altserver . 26) (supportedextension . 38) (supportedcontrol . 38) (supportedsaslmechanisms . 15) (supportedldapversion . 27) (ldapsyntaxes . 16) (ditstructurerules . 17) (nameforms . 35) (ditcontentrules . 16) (objectclass . 38) (aliasedobjectname . 12) (cn . 15) (sn . 15) (serialnumber . 44) (c . 15) (l . 15) (st . 15) (street . 15) (o . 15) (ou . 15) (title . 15) (description . 15) (searchguide . 25) (businesscategory . 15) (postaladdress . 41) (postalcode . 15) (postofficebox . 15) (physicaldeliveryofficename . 15) (telephonenumber . 50) (telexnumber . 52) (telexterminalidentifier . 51) (facsimiletelephonenumber . 22) (x121address . 36) (internationalisdnnumber . 36) (registeredaddress . 41) (destinationindicator . 44) (preferreddeliverymethod . 14) (presentationaddress . 43) (supportedapplicationcontext . 38) (member . 12) (owner . 12) (roleoccupant . 12) (seealso . 12) (userpassword . 40) (usercertificate . 8) (cacertificate . 8) (authorityrevocationlist . 9) (certificaterevocationlist . 9) (crosscertificatepair . 10) (name . 15) (givenname . 15) (initials . 15) (generationqualifier . 15) (x500uniqueidentifier . 6) (dnqualifier . 44) (enhancedsearchguide . 21) (protocolinformation . 42) (distinguishedname . 12) (uniquemember . 34) (houseidentifier . 15) (supportedalgorithms . 49) (deltarevocationlist . 9) (dmdname . 15)) "A map of LDAP attribute names to their type object id minor number. This table is built from RFC2252 Section 5 and RFC2256 Section 5") ;; Coding/decoding functions (defun ldap-encode-boolean (bool) (if bool "TRUE" "FALSE")) (defun ldap-decode-boolean (str) (cond ((string-equal str "TRUE") t) ((string-equal str "FALSE") nil) (t (error "Wrong LDAP boolean string: %s" str)))) (defun ldap-encode-country-string (str) ;; We should do something useful here... (if (not (= 2 (length str))) (error "Invalid country string: %s" str))) (defun ldap-decode-string (str) (if (fboundp 'decode-coding-string) (decode-coding-string str ldap-coding-system))) (defun ldap-encode-string (str) (if (fboundp 'encode-coding-string) (encode-coding-string str ldap-coding-system))) (defun ldap-decode-address (str) (mapconcat 'ldap-decode-string (split-string str "\\$") "\n")) (defun ldap-encode-address (str) (mapconcat 'ldap-encode-string (split-string str "\n") "$")) ;; LDAP protocol functions (defun ldap-get-host-parameter (host parameter) "Get the value of PARAMETER for HOST in `ldap-host-parameters-alist'." (plist-get (cdr (assoc host ldap-host-parameters-alist)) parameter)) (defun ldap-decode-attribute (attr) "Decode the attribute/value pair ATTR according to LDAP rules. The attribute name is looked up in `ldap-attribute-syntaxes-alist' and the corresponding decoder is then retrieved from `ldap-attribute-syntax-decoders' and applied on the value(s)." (let* ((name (car attr)) (values (cdr attr)) (syntax-id (cdr (assq (intern (downcase name)) ldap-attribute-syntaxes-alist))) decoder) (if syntax-id (setq decoder (aref ldap-attribute-syntax-decoders (1- syntax-id))) (setq decoder ldap-default-attribute-decoder)) (if decoder (cons name (mapcar decoder values)) attr))) (defun ldap-decode-entry (entry) "Decode the attributes of ENTRY according to LDAP rules." (let (dn decoded) (setq dn (car entry)) (if (stringp dn) (setq entry (cdr entry)) (setq dn nil)) (setq decoded (mapcar 'ldap-decode-attribute entry)) (if dn (cons dn decoded) decoded))) (defun ldap-search (arg1 &rest args) "Perform an LDAP search." (apply (if (ldapp arg1) 'ldap-search-basic 'ldap-search-entries) arg1 args)) (make-obsolete 'ldap-search "Use `ldap-search-entries' instead or `ldap-search-basic' for the low-level search API.") (defun ldap-search-entries (filter &optional host attributes attrsonly withdn) "Perform an LDAP search. FILTER is the search filter in RFC1558 syntax, i.e., something that looks like \"(cn=John Smith)\". HOST is the LDAP host on which to perform the search. ATTRIBUTES is a list of attributes to retrieve; nil means retrieve all. If ATTRSONLY is non nil, the attributes will be retrieved without the associated values. If WITHDN is non-nil each entry in the result will be prepennded with its distinguished name DN. Additional search parameters can be specified through `ldap-host-parameters-alist' which see. The function returns a list of matching entries. Each entry is itself an alist of attribute/value pairs optionally preceded by the DN of the entry according to the value of WITHDN." (interactive "sFilter:") (or host (setq host ldap-default-host) (error "No LDAP host specified")) (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) ldap result) (if ldap-verbose (message "Opening LDAP connection to %s..." host)) (setq ldap (ldap-open host host-plist)) (if ldap-verbose (message "Searching with LDAP on %s..." host)) (setq result (ldap-search ldap filter (plist-get host-plist 'base) (plist-get host-plist 'scope) attributes attrsonly withdn ldap-verbose)) (ldap-close ldap) (if ldap-ignore-attribute-codings result (mapcar 'ldap-decode-entry result)))) (defun ldap-add-entries (entries &optional host binddn passwd) "Add entries to an LDAP directory. ENTRIES is a list of entry specifications of the form (DN (ATTR . VALUE) (ATTR . VALUE) ...) where DN is the distinguished name of an entry to add, the following are cons cells containing attribute/value string pairs. HOST is the LDAP host, defaulting to `ldap-default-host'. BINDDN is the DN to bind as to the server. PASSWD is the corresponding password." (or host (setq host ldap-default-host) (error "No LDAP host specified")) (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) ldap (i 1)) (if (or binddn passwd) (setq host-plist (copy-seq host-plist))) (if binddn (setq host-plist (plist-put host-plist 'binddn binddn))) (if passwd (setq host-plist (plist-put host-plist 'passwd passwd))) (if ldap-verbose (message "Opening LDAP connection to %s..." host)) (setq ldap (ldap-open host host-plist)) (if ldap-verbose (message "Adding LDAP entries...")) (mapc (function (lambda (thisentry) (ldap-add ldap (car thisentry) (cdr thisentry)) (if ldap-verbose (message "%d added" i)) (setq i (1+ i)))) entries) (ldap-close ldap))) (defun ldap-modify-entries (entry-mods &optional host binddn passwd) "Modify entries of an LDAP directory. ENTRY_MODS is a list of entry modifications of the form (DN MOD-SPEC1 MOD-SPEC2 ...) where DN is the distinguished name of the entry to modify, the following are modification specifications. A modification specification is itself a list of the form \(MOD-OP ATTR VALUE1 VALUE2 ...) MOD-OP and ATTR are mandatory, VALUEs are optional depending on MOD-OP. MOD-OP is the type of modification, one of the symbols `add', `delete' or `replace'. ATTR is the LDAP attribute type to modify. HOST is the LDAP host, defaulting to `ldap-default-host'. BINDDN is the DN to bind as to the server. PASSWD is the corresponding password." (or host (setq host ldap-default-host) (error "No LDAP host specified")) (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) ldap (i 1)) (if (or binddn passwd) (setq host-plist (copy-seq host-plist))) (if binddn (setq host-plist (plist-put host-plist 'binddn binddn))) (if passwd (setq host-plist (plist-put host-plist 'passwd passwd))) (if ldap-verbose (message "Opening LDAP connection to %s..." host)) (setq ldap (ldap-open host host-plist)) (if ldap-verbose (message "Modifying LDAP entries...")) (mapc (function (lambda (thisentry) (ldap-modify ldap (car thisentry) (cdr thisentry)) (if ldap-verbose (message "%d modified" i)) (setq i (1+ i)))) entry-mods) (ldap-close ldap))) (defun ldap-delete-entries (dn &optional host binddn passwd) "Delete an entry from an LDAP directory. DN is the distinguished name of an entry to delete or a list of those. HOST is the LDAP host, defaulting to `ldap-default-host'. BINDDN is the DN to bind as to the server. PASSWD is the corresponding password." (or host (setq host ldap-default-host) (error "No LDAP host specified")) (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) ldap) (if (or binddn passwd) (setq host-plist (copy-seq host-plist))) (if binddn (setq host-plist (plist-put host-plist 'binddn binddn))) (if passwd (setq host-plist (plist-put host-plist 'passwd passwd))) (if ldap-verbose (message "Opening LDAP connection to %s..." host)) (setq ldap (ldap-open host host-plist)) (if (consp dn) (let ((i 1)) (if ldap-verbose (message "Deleting LDAP entries...")) (mapc (function (lambda (thisdn) (ldap-delete ldap thisdn) (if ldap-verbose (message "%d deleted" i)) (setq i (1+ i)))) dn)) (if ldap-verbose (message "Deleting LDAP entry...")) (ldap-delete ldap dn)) (ldap-close ldap))) (provide 'ldap) ;;; ldap.el ends here