git.chise.org Git - chise/xemacs-chise.git-/blob - lisp/ldap.el

   1 ;;; ldap.el --- LDAP support for Emacs
   2
   3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
   4
   5 ;; Author: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
   6 ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
   7 ;; Created: Jan 1998
   8 ;; Version: $Revision: 1.7.2.11 $
   9 ;; Keywords: help comm
  10
  11 ;; This file is part of XEmacs
  12
  13 ;; XEmacs is free software; you can redistribute it and/or modify it
  14 ;; under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; XEmacs is distributed in the hope that it will be useful, but
  19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 ;; General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with XEmacs; see the file COPYING.  If not, write to
  25 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Commentary:
  29 ;;    This file provides mid-level and user-level functions to access directory
  30 ;;    servers using the LDAP protocol (RFC 1777).
  31
  32 ;;; Installation:
  33 ;;    LDAP support must have been built into XEmacs.
  34
  35
  36 ;;; Code:
  37
  38 (eval-when '(load)
  39   (if (not (fboundp 'ldap-open))
  40       (error "No LDAP support compiled in this XEmacs")))
  41
  42 (defgroup ldap nil
  43   "Lightweight Directory Access Protocol"
  44   :group 'comm)
  45
  46 (defcustom ldap-default-host nil
  47   "*Default LDAP server hostname.
  48 A TCP port number can be appended to that name using a colon as
  49 a separator."
  50   :type '(choice (string :tag "Host name")
  51                  (const :tag "Use library default" nil))
  52   :group 'ldap)
  53
  54 (defcustom ldap-default-port nil
  55   "*Default TCP port for LDAP connections.
  56 Initialized from the LDAP library at build time. Default value is 389."
  57   :type '(choice (const :tag "Use library default" nil)
  58                  (integer :tag "Port number"))
  59   :group 'ldap)
  60
  61 (defcustom ldap-default-base nil
  62   "*Default base for LDAP searches.
  63 This is a string using the syntax of RFC 1779.
  64 For instance, \"o=ACME, c=US\" limits the search to the
  65 Acme organization in the United States."
  66   :type '(choice (const :tag "Use library default" nil)
  67                  (string :tag "Search base"))
  68   :group 'ldap)
  69
  70
  71 (defcustom ldap-host-parameters-alist nil
  72   "*Alist of host-specific options for LDAP transactions.
  73 The format of each list element is:
  74 \(HOST PROP1 VAL1 PROP2 VAL2 ...)
  75 HOST is the hostname of an LDAP server (with an optional TCP port number
  76 appended to it  using a colon as a separator).
  77 PROPn and VALn are property/value pairs describing parameters for the server.
  78 Valid properties include:
  79   `binddn' is the distinguished name of the user to bind as
  80     (in RFC 1779 syntax).
  81   `passwd' is the password to use for simple authentication.
  82   `auth' is the authentication method to use.
  83     Possible values are: `simple', `krbv41' and `krbv42'.
  84   `base' is the base for the search as described in RFC 1779.
  85   `scope' is one of the three symbols `subtree', `base' or `onelevel'.
  86   `deref' is one of the symbols `never', `always', `search' or `find'.
  87   `timelimit' is the timeout limit for the connection in seconds.
  88   `sizelimit' is the maximum number of matches to return."
  89   :type '(repeat :menu-tag "Host parameters"
  90                  :tag "Host parameters"
  91                  (list :menu-tag "Host parameters"
  92                        :tag "Host parameters"
  93                        :value nil
  94                        (string :tag "Host name")
  95                        (checklist :inline t
  96                                   :greedy t
  97                                   (list
  98                                    :tag "Search Base"
  99                                    :inline t
 100                                    (const :tag "Search Base" base)
 101                                    string)
 102                                   (list
 103                                    :tag "Binding DN"
 104                                    :inline t
 105                                    (const :tag "Binding DN" binddn)
 106                                    string)
 107                                   (list
 108                                    :tag "Password"
 109                                    :inline t
 110                                    (const :tag "Password" passwd)
 111                                    string)
 112                                   (list
 113                                    :tag "Authentication Method"
 114                                    :inline t
 115                                    (const :tag "Authentication Method" auth)
 116                                    (choice
 117                                     (const :menu-tag "None" :tag "None" nil)
 118                                     (const :menu-tag "Simple" :tag "Simple" simple)
 119                                     (const :menu-tag "Kerberos 4.1" :tag "Kerberos 4.1" krbv41)
 120                                     (const :menu-tag "Kerberos 4.2" :tag "Kerberos 4.2" krbv42)))
 121                                   (list
 122                                    :tag "Search Scope"
 123                                    :inline t
 124                                    (const :tag "Search Scope" scope)
 125                                    (choice
 126                                     (const :menu-tag "Default" :tag "Default" nil)
 127                                     (const :menu-tag "Subtree" :tag "Subtree" subtree)
 128                                     (const :menu-tag "Base" :tag "Base" base)
 129                                     (const :menu-tag "One Level" :tag "One Level" onelevel)))
 130                                   (list
 131                                    :tag "Dereferencing"
 132                                    :inline t
 133                                    (const :tag "Dereferencing" deref)
 134                                    (choice
 135                                     (const :menu-tag "Default" :tag "Default" nil)
 136                                     (const :menu-tag "Never" :tag "Never" never)
 137                                     (const :menu-tag "Always" :tag "Always" always)
 138                                     (const :menu-tag "When searching" :tag "When searching" search)
 139                                     (const :menu-tag "When locating base" :tag "When locating base" find)))
 140                                   (list
 141                                    :tag "Time Limit"
 142                                    :inline t
 143                                    (const :tag "Time Limit" timelimit)
 144                                    (integer :tag "(in seconds)"))
 145                                   (list
 146                                    :tag "Size Limit"
 147                                    :inline t
 148                                    (const :tag "Size Limit" sizelimit)
 149                                    (integer :tag "(number of records)")))))
 150 :group 'ldap)
 151
 152 (defcustom ldap-verbose nil
 153   "*If non-nil, LDAP operations echo progress messages."
 154   :type 'boolean
 155   :group 'ldap)
 156
 157 (defcustom ldap-ignore-attribute-codings nil
 158   "*If non-nil, do not perform any encoding/decoding on LDAP attribute values."
 159   :type 'boolean
 160   :group 'ldap)
 161
 162 (defcustom ldap-default-attribute-decoder nil
 163   "*Decoder function to use for attributes whose syntax is unknown."
 164   :type 'symbol
 165   :group 'ldap)
 166
 167 (defcustom ldap-coding-system nil
 168   "*Coding system of LDAP string values.
 169 LDAP v3 specifies the coding system of strings to be UTF-8.
 170 Mule support is needed for this."
 171   :type 'symbol
 172   :group 'ldap)
 173
 174 (defvar ldap-attribute-syntax-encoders
 175   [nil                                  ; 1  ACI Item                        N
 176    nil                                  ; 2  Access Point                    Y
 177    nil                                  ; 3  Attribute Type Description      Y
 178    nil                                  ; 4  Audio                           N
 179    nil                                  ; 5  Binary                          N
 180    nil                                  ; 6  Bit String                      Y
 181    ldap-encode-boolean                  ; 7  Boolean                         Y
 182    nil                                  ; 8  Certificate                     N
 183    nil                                  ; 9  Certificate List                N
 184    nil                                  ; 10 Certificate Pair                N
 185    ldap-encode-country-string           ; 11 Country String                  Y
 186    ldap-encode-string                   ; 12 DN                              Y
 187    nil                                  ; 13 Data Quality Syntax             Y
 188    nil                                  ; 14 Delivery Method                 Y
 189    ldap-encode-string                   ; 15 Directory String                Y
 190    nil                                  ; 16 DIT Content Rule Description    Y
 191    nil                                  ; 17 DIT Structure Rule Description  Y
 192    nil                                  ; 18 DL Submit Permission            Y
 193    nil                                  ; 19 DSA Quality Syntax              Y
 194    nil                                  ; 20 DSE Type                        Y
 195    nil                                  ; 21 Enhanced Guide                  Y
 196    nil                                  ; 22 Facsimile Telephone Number      Y
 197    nil                                  ; 23 Fax                             N
 198    nil                                  ; 24 Generalized Time                Y
 199    nil                                  ; 25 Guide                           Y
 200    nil                                  ; 26 IA5 String                      Y
 201    number-to-string                     ; 27 INTEGER                         Y
 202    nil                                  ; 28 JPEG                            N
 203    nil                                  ; 29 Master And Shadow Access Points Y
 204    nil                                  ; 30 Matching Rule Description       Y
 205    nil                                  ; 31 Matching Rule Use Description   Y
 206    nil                                  ; 32 Mail Preference                 Y
 207    nil                                  ; 33 MHS OR Address                  Y
 208    nil                                  ; 34 Name And Optional UID           Y
 209    nil                                  ; 35 Name Form Description           Y
 210    nil                                  ; 36 Numeric String                  Y
 211    nil                                  ; 37 Object Class Description        Y
 212    nil                                  ; 38 OID                             Y
 213    nil                                  ; 39 Other Mailbox                   Y
 214    nil                                  ; 40 Octet String                    Y
 215    ldap-encode-address                  ; 41 Postal Address                  Y
 216    nil                                  ; 42 Protocol Information            Y
 217    nil                                  ; 43 Presentation Address            Y
 218    ldap-encode-string                   ; 44 Printable String                Y
 219    nil                                  ; 45 Subtree Specification           Y
 220    nil                                  ; 46 Supplier Information            Y
 221    nil                                  ; 47 Supplier Or Consumer            Y
 222    nil                                  ; 48 Supplier And Consumer           Y
 223    nil                                  ; 49 Supported Algorithm             N
 224    nil                                  ; 50 Telephone Number                Y
 225    nil                                  ; 51 Teletex Terminal Identifier     Y
 226    nil                                  ; 52 Telex Number                    Y
 227    nil                                  ; 53 UTC Time                        Y
 228    nil                                  ; 54 LDAP Syntax Description         Y
 229    nil                                  ; 55 Modify Rights                   Y
 230    nil                                  ; 56 LDAP Schema Definition          Y
 231    nil                                  ; 57 LDAP Schema Description         Y
 232    nil                                  ; 58 Substring Assertion             Y
 233    ]
 234   "A vector of functions used to encode LDAP attribute values.
 235 The sequence of functions corresponds to the sequence of LDAP attribute syntax
 236 object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in
 237 RFC2252 section 4.3.2")
 238
 239 (defvar ldap-attribute-syntax-decoders
 240   [nil                                  ; 1  ACI Item                        N
 241    nil                                  ; 2  Access Point                    Y
 242    nil                                  ; 3  Attribute Type Description      Y
 243    nil                                  ; 4  Audio                           N
 244    nil                                  ; 5  Binary                          N
 245    nil                                  ; 6  Bit String                      Y
 246    ldap-decode-boolean                  ; 7  Boolean                         Y
 247    nil                                  ; 8  Certificate                     N
 248    nil                                  ; 9  Certificate List                N
 249    nil                                  ; 10 Certificate Pair                N
 250    ldap-decode-string                   ; 11 Country String                  Y
 251    ldap-decode-string                   ; 12 DN                              Y
 252    nil                                  ; 13 Data Quality Syntax             Y
 253    nil                                  ; 14 Delivery Method                 Y
 254    ldap-decode-string                   ; 15 Directory String                Y
 255    nil                                  ; 16 DIT Content Rule Description    Y
 256    nil                                  ; 17 DIT Structure Rule Description  Y
 257    nil                                  ; 18 DL Submit Permission            Y
 258    nil                                  ; 19 DSA Quality Syntax              Y
 259    nil                                  ; 20 DSE Type                        Y
 260    nil                                  ; 21 Enhanced Guide                  Y
 261    nil                                  ; 22 Facsimile Telephone Number      Y
 262    nil                                  ; 23 Fax                             N
 263    nil                                  ; 24 Generalized Time                Y
 264    nil                                  ; 25 Guide                           Y
 265    nil                                  ; 26 IA5 String                      Y
 266    string-to-number                     ; 27 INTEGER                         Y
 267    nil                                  ; 28 JPEG                            N
 268    nil                                  ; 29 Master And Shadow Access Points Y
 269    nil                                  ; 30 Matching Rule Description       Y
 270    nil                                  ; 31 Matching Rule Use Description   Y
 271    nil                                  ; 32 Mail Preference                 Y
 272    nil                                  ; 33 MHS OR Address                  Y
 273    nil                                  ; 34 Name And Optional UID           Y
 274    nil                                  ; 35 Name Form Description           Y
 275    nil                                  ; 36 Numeric String                  Y
 276    nil                                  ; 37 Object Class Description        Y
 277    nil                                  ; 38 OID                             Y
 278    nil                                  ; 39 Other Mailbox                   Y
 279    nil                                  ; 40 Octet String                    Y
 280    ldap-decode-address                  ; 41 Postal Address                  Y
 281    nil                                  ; 42 Protocol Information            Y
 282    nil                                  ; 43 Presentation Address            Y
 283    ldap-decode-string                   ; 44 Printable String                Y
 284    nil                                  ; 45 Subtree Specification           Y
 285    nil                                  ; 46 Supplier Information            Y
 286    nil                                  ; 47 Supplier Or Consumer            Y
 287    nil                                  ; 48 Supplier And Consumer           Y
 288    nil                                  ; 49 Supported Algorithm             N
 289    nil                                  ; 50 Telephone Number                Y
 290    nil                                  ; 51 Teletex Terminal Identifier     Y
 291    nil                                  ; 52 Telex Number                    Y
 292    nil                                  ; 53 UTC Time                        Y
 293    nil                                  ; 54 LDAP Syntax Description         Y
 294    nil                                  ; 55 Modify Rights                   Y
 295    nil                                  ; 56 LDAP Schema Definition          Y
 296    nil                                  ; 57 LDAP Schema Description         Y
 297    nil                                  ; 58 Substring Assertion             Y
 298    ]
 299   "A vector of functions used to decode LDAP attribute values.
 300 The sequence of functions corresponds to the sequence of LDAP attribute syntax
 301 object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in
 302 RFC2252 section 4.3.2")
 303
 304
 305 (defvar ldap-attribute-syntaxes-alist
 306   '((createtimestamp . 24)
 307     (modifytimestamp . 24)
 308     (creatorsname . 12)
 309     (modifiersname . 12)
 310     (subschemasubentry . 12)
 311     (attributetypes . 3)
 312     (objectclasses . 37)
 313     (matchingrules . 30)
 314     (matchingruleuse . 31)
 315     (namingcontexts . 12)
 316     (altserver . 26)
 317     (supportedextension . 38)
 318     (supportedcontrol . 38)
 319     (supportedsaslmechanisms . 15)
 320     (supportedldapversion . 27)
 321     (ldapsyntaxes . 16)
 322     (ditstructurerules . 17)
 323     (nameforms . 35)
 324     (ditcontentrules . 16)
 325     (objectclass . 38)
 326     (aliasedobjectname . 12)
 327     (cn . 15)
 328     (sn . 15)
 329     (serialnumber . 44)
 330     (c . 15)
 331     (l . 15)
 332     (st . 15)
 333     (street . 15)
 334     (o . 15)
 335     (ou . 15)
 336     (title . 15)
 337     (description . 15)
 338     (searchguide . 25)
 339     (businesscategory . 15)
 340     (postaladdress . 41)
 341     (postalcode . 15)
 342     (postofficebox . 15)
 343     (physicaldeliveryofficename . 15)
 344     (telephonenumber . 50)
 345     (telexnumber . 52)
 346     (telexterminalidentifier . 51)
 347     (facsimiletelephonenumber . 22)
 348     (x121address . 36)
 349     (internationalisdnnumber . 36)
 350     (registeredaddress . 41)
 351     (destinationindicator . 44)
 352     (preferreddeliverymethod . 14)
 353     (presentationaddress . 43)
 354     (supportedapplicationcontext . 38)
 355     (member . 12)
 356     (owner . 12)
 357     (roleoccupant . 12)
 358     (seealso . 12)
 359     (userpassword . 40)
 360     (usercertificate . 8)
 361     (cacertificate . 8)
 362     (authorityrevocationlist . 9)
 363     (certificaterevocationlist . 9)
 364     (crosscertificatepair . 10)
 365     (name . 15)
 366     (givenname . 15)
 367     (initials . 15)
 368     (generationqualifier . 15)
 369     (x500uniqueidentifier . 6)
 370     (dnqualifier . 44)
 371     (enhancedsearchguide . 21)
 372     (protocolinformation . 42)
 373     (distinguishedname . 12)
 374     (uniquemember . 34)
 375     (houseidentifier . 15)
 376     (supportedalgorithms . 49)
 377     (deltarevocationlist . 9)
 378     (dmdname . 15))
 379   "A map of LDAP attribute names to their type object id minor number.
 380 This table is built from RFC2252 Section 5 and RFC2256 Section 5")
 381
 382
 383 ;; Coding/decoding functions
 384
 385 (defun ldap-encode-boolean (bool)
 386   (if bool
 387       "TRUE"
 388     "FALSE"))
 389
 390 (defun ldap-decode-boolean (str)
 391   (cond
 392    ((string-equal str "TRUE")
 393     t)
 394    ((string-equal str "FALSE")
 395     nil)
 396    (t
 397     (error "Wrong LDAP boolean string: %s" str))))
 398
 399 (defun ldap-encode-country-string (str)
 400   ;; We should do something useful here...
 401   (if (not (= 2 (length str)))
 402       (error "Invalid country string: %s" str)))
 403
 404 (defun ldap-decode-string (str)
 405   (if (fboundp 'decode-coding-string)
 406       (decode-coding-string str ldap-coding-system)))
 407
 408 (defun ldap-encode-string (str)
 409    (if (fboundp 'encode-coding-string)
 410        (encode-coding-string str ldap-coding-system)))
 411
 412 (defun ldap-decode-address (str)
 413   (mapconcat 'ldap-decode-string
 414              (split-string str "\\$")
 415              "\n"))
 416
 417 (defun ldap-encode-address (str)
 418   (mapconcat 'ldap-encode-string
 419              (split-string str "\n")
 420              "$"))
 421
 422
 423 ;; LDAP protocol functions
 424
 425 (defun ldap-get-host-parameter (host parameter)
 426   "Get the value of PARAMETER for HOST in `ldap-host-parameters-alist'."
 427   (plist-get (cdr (assoc host ldap-host-parameters-alist))
 428              parameter))
 429
 430 (defun ldap-decode-attribute (attr)
 431   "Decode the attribute/value pair ATTR according to LDAP rules.
 432 The attribute name is looked up in `ldap-attribute-syntaxes-alist'
 433 and the corresponding decoder is then retrieved from
 434 `ldap-attribute-syntax-decoders' and applied on the value(s)."
 435   (let* ((name (car attr))
 436          (values (cdr attr))
 437          (syntax-id (cdr (assq (intern (downcase name))
 438                                ldap-attribute-syntaxes-alist)))
 439          decoder)
 440     (if syntax-id
 441         (setq decoder (aref ldap-attribute-syntax-decoders
 442                             (1- syntax-id)))
 443       (setq decoder ldap-default-attribute-decoder))
 444     (if decoder
 445         (cons name (mapcar decoder values))
 446       attr)))
 447
 448 (defun ldap-decode-entry (entry)
 449   "Decode the attributes of ENTRY according to LDAP rules."
 450   (let (dn decoded)
 451     (setq dn (car entry))
 452     (if (stringp dn)
 453         (setq entry (cdr entry))
 454       (setq dn nil))
 455     (setq decoded (mapcar 'ldap-decode-attribute entry))
 456     (if dn
 457         (cons dn decoded)
 458       decoded)))
 459
 460 (defun ldap-search (arg1 &rest args)
 461   "Perform an LDAP search."
 462       (apply (if (ldapp arg1)
 463                  'ldap-search-basic
 464                'ldap-search-entries) arg1 args))
 465
 466 (make-obsolete 'ldap-search
 467                "Use `ldap-search-entries' instead or
 468 `ldap-search-basic' for the low-level search API.")
 469
 470 (defun ldap-search-entries (filter &optional host attributes attrsonly withdn)
 471   "Perform an LDAP search.
 472 FILTER is the search filter in RFC1558 syntax, i.e., something that
 473 looks like \"(cn=John Smith)\".
 474 HOST is the LDAP host on which to perform the search.
 475 ATTRIBUTES is a list of attributes to retrieve; nil means retrieve all.
 476 If ATTRSONLY is non nil, the attributes will be retrieved without
 477 the associated values.
 478 If WITHDN is non-nil each entry in the result will be prepennded with
 479 its distinguished name DN.
 480 Additional search parameters can be specified through
 481 `ldap-host-parameters-alist' which see.
 482 The function returns a list of matching entries.  Each entry is itself
 483 an alist of attribute/value pairs optionally preceded by the DN of the
 484 entry according to the value of WITHDN."
 485   (interactive "sFilter:")
 486   (or host
 487       (setq host ldap-default-host)
 488       (error "No LDAP host specified"))
 489   (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
 490         ldap
 491         result)
 492     (if ldap-verbose
 493         (message "Opening LDAP connection to %s..." host))
 494     (setq ldap (ldap-open host host-plist))
 495     (if ldap-verbose
 496         (message "Searching with LDAP on %s..." host))
 497     (setq result (ldap-search ldap filter
 498                               (plist-get host-plist 'base)
 499                               (plist-get host-plist 'scope)
 500                               attributes attrsonly withdn
 501                               ldap-verbose))
 502     (ldap-close ldap)
 503     (if ldap-ignore-attribute-codings
 504         result
 505       (mapcar 'ldap-decode-entry result))))
 506
 507 (defun ldap-add-entries (entries &optional host binddn passwd)
 508   "Add entries to an LDAP directory.
 509 ENTRIES is a list of entry specifications of
 510 the form (DN (ATTR . VALUE) (ATTR . VALUE) ...) where
 511 DN is the distinguished name of an entry to add, the following
 512 are cons cells containing attribute/value string pairs.
 513 HOST is the LDAP host, defaulting to `ldap-default-host'.
 514 BINDDN is the DN to bind as to the server.
 515 PASSWD is the corresponding password."
 516   (or host
 517       (setq host ldap-default-host)
 518       (error "No LDAP host specified"))
 519   (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
 520         ldap
 521         (i 1))
 522     (if (or binddn passwd)
 523         (setq host-plist (copy-seq host-plist)))
 524     (if binddn
 525         (setq host-plist (plist-put host-plist 'binddn binddn)))
 526     (if passwd
 527         (setq host-plist (plist-put host-plist 'passwd passwd)))
 528     (if ldap-verbose
 529         (message "Opening LDAP connection to %s..." host))
 530     (setq ldap (ldap-open host host-plist))
 531     (if ldap-verbose
 532         (message "Adding LDAP entries..."))
 533     (mapcar (function
 534              (lambda (thisentry)
 535                (ldap-add ldap (car thisentry) (cdr thisentry))
 536                (if ldap-verbose
 537                    (message "%d added" i))
 538                (setq i (1+ i))))
 539             entries)
 540     (ldap-close ldap)))
 541
 542
 543 (defun ldap-modify-entries (entry-mods &optional host binddn passwd)
 544   "Modify entries of an LDAP directory.
 545 ENTRY_MODS is a list of entry modifications of the form
 546   (DN MOD-SPEC1 MOD-SPEC2 ...) where DN is the distinguished name of
 547 the entry to modify, the following are modification specifications.
 548 A modification specification is itself a list of the form
 549 (MOD-OP ATTR VALUE1 VALUE2 ...) MOD-OP and ATTR are mandatory,
 550 VALUEs are optional depending on MOD-OP.
 551 MOD-OP is the type of modification, one of the symbols `add', `delete'
 552 or `replace'. ATTR is the LDAP attribute type to modify.
 553 HOST is the LDAP host, defaulting to `ldap-default-host'.
 554 BINDDN is the DN to bind as to the server.
 555 PASSWD is the corresponding password."
 556   (or host
 557       (setq host ldap-default-host)
 558       (error "No LDAP host specified"))
 559   (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
 560         ldap
 561         (i 1))
 562     (if (or binddn passwd)
 563         (setq host-plist (copy-seq host-plist)))
 564     (if binddn
 565         (setq host-plist (plist-put host-plist 'binddn binddn)))
 566     (if passwd
 567         (setq host-plist (plist-put host-plist 'passwd passwd)))
 568     (if ldap-verbose
 569         (message "Opening LDAP connection to %s..." host))
 570     (setq ldap (ldap-open host host-plist))
 571     (if ldap-verbose
 572         (message "Modifying LDAP entries..."))
 573     (mapcar (function
 574              (lambda (thisentry)
 575                (ldap-modify ldap (car thisentry) (cdr thisentry))
 576                (if ldap-verbose
 577                    (message "%d modified" i))
 578                (setq i (1+ i))))
 579             entry-mods)
 580     (ldap-close ldap)))
 581
 582
 583 (defun ldap-delete-entries (dn &optional host binddn passwd)
 584   "Delete an entry from an LDAP directory.
 585 DN is the distinguished name of an entry to delete or
 586 a list of those.
 587 HOST is the LDAP host, defaulting to `ldap-default-host'.
 588 BINDDN is the DN to bind as to the server.
 589 PASSWD is the corresponding password."
 590   (or host
 591       (setq host ldap-default-host)
 592       (error "No LDAP host specified"))
 593   (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
 594         ldap)
 595     (if (or binddn passwd)
 596         (setq host-plist (copy-seq host-plist)))
 597     (if binddn
 598         (setq host-plist (plist-put host-plist 'binddn binddn)))
 599     (if passwd
 600         (setq host-plist (plist-put host-plist 'passwd passwd)))
 601     (if ldap-verbose
 602         (message "Opening LDAP connection to %s..." host))
 603     (setq ldap (ldap-open host host-plist))
 604     (if (consp dn)
 605         (let ((i 1))
 606           (if ldap-verbose
 607               (message "Deleting LDAP entries..."))
 608           (mapcar (function
 609                    (lambda (thisdn)
 610                      (ldap-delete ldap thisdn)
 611                      (if ldap-verbose
 612                          (message "%d deleted" i))
 613                      (setq i (1+ i))))
 614                   dn))
 615       (if ldap-verbose
 616           (message "Deleting LDAP entry..."))
 617       (ldap-delete ldap dn))
 618     (ldap-close ldap)))
 619
 620
 621 (provide 'ldap)
 622
 623 ;;; ldap.el ends here