git.chise.org Git - chise/xemacs-chise.git.1/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.7 $
   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-search (arg1 &rest args)
 449   "Perform an LDAP search."
 450       (apply (if (ldapp arg1)
 451                  'ldap-search-basic
 452                'ldap-search-entries) arg1 args))
 453
 454 (make-obsolete 'ldap-search
 455                "Use `ldap-search-entries' instead or
 456 `ldap-search-basic' for the low-level search API.")
 457
 458 (defun ldap-search-entries (filter &optional host attributes attrsonly withdn)
 459   "Perform an LDAP search.
 460 FILTER is the search filter in RFC1558 syntax, i.e., something that
 461 looks like \"(cn=John Smith)\".
 462 HOST is the LDAP host on which to perform the search.
 463 ATTRIBUTES is a list of attributes to retrieve; nil means retrieve all.
 464 If ATTRSONLY is non nil, the attributes will be retrieved without
 465 the associated values.
 466 If WITHDN is non-nil each entry in the result will be prepennded with
 467 its distinguished name DN.
 468 Additional search parameters can be specified through
 469 `ldap-host-parameters-alist' which see.
 470 The function returns a list of matching entries.  Each entry is itself
 471 an alist of attribute/value pairs optionally preceded by the DN of the
 472 entry according to the value of WITHDN."
 473   (interactive "sFilter:")
 474   (or host
 475       (setq host ldap-default-host)
 476       (error "No LDAP host specified"))
 477   (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
 478         ldap
 479         result)
 480     (if ldap-verbose
 481         (message "Opening LDAP connection to %s..." host))
 482     (setq ldap (ldap-open host host-plist))
 483     (if ldap-verbose
 484         (message "Searching with LDAP on %s..." host))
 485     (setq result (ldap-search ldap filter
 486                               (plist-get host-plist 'base)
 487                               (plist-get host-plist 'scope)
 488                               attributes attrsonly withdn
 489                               ldap-verbose))
 490     (ldap-close ldap)
 491     (if ldap-ignore-attribute-codings
 492         result
 493       (mapcar (function
 494                (lambda (record)
 495                  (mapcar 'ldap-decode-attribute record)))
 496               result))))
 497
 498 (defun ldap-add-entries (entries &optional host binddn passwd)
 499   "Add entries to an LDAP directory.
 500 ENTRIES is a list of entry specifications of
 501 the form (DN (ATTR . VALUE) (ATTR . VALUE) ...) where
 502 DN is the distinguished name of an entry to add, the following
 503 are cons cells containing attribute/value string pairs.
 504 HOST is the LDAP host, defaulting to `ldap-default-host'
 505 BINDDN is the DN to bind as to the server
 506 PASSWD is the corresponding password"
 507   (or host
 508       (setq host ldap-default-host)
 509       (error "No LDAP host specified"))
 510   (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
 511         ldap
 512         (i 1))
 513     (if (or binddn passwd)
 514         (setq host-plist (copy-seq host-plist)))
 515     (if binddn
 516         (setq host-plist (plist-put host-plist 'binddn binddn)))
 517     (if passwd
 518         (setq host-plist (plist-put host-plist 'passwd passwd)))
 519     (if ldap-verbose
 520         (message "Opening LDAP connection to %s..." host))
 521     (setq ldap (ldap-open host host-plist))
 522     (if ldap-verbose
 523         (message "Adding LDAP entries..."))
 524     (mapcar (function
 525              (lambda (thisentry)
 526                (ldap-add ldap (car thisentry) (cdr thisentry))
 527                (if ldap-verbose
 528                    (message "%d added" i))
 529                (setq i (1+ i))))
 530             entries)
 531     (ldap-close ldap)))
 532
 533
 534 (defun ldap-modify-entries (entry-mods &optional host binddn passwd)
 535   "Modify entries of an LDAP directory.
 536 ENTRY_MODS is a list of entry modifications of the form
 537   (DN MOD-SPEC1 MOD-SPEC2 ...) where DN is the distinguished name of
 538 the entry to modify, the following are modification specifications.
 539 A modification specification is itself a list of the form
 540 (MOD-OP ATTR VALUE1 VALUE2 ...) MOD-OP and ATTR are mandatory,
 541 VALUEs are optional depending on MOD-OP.
 542 MOD-OP is the type of modification, one of the symbols `add', `delete'
 543 or `replace'. ATTR is the LDAP attribute type to modify.
 544 HOST is the LDAP host, defaulting to `ldap-default-host'
 545 BINDDN is the DN to bind as to the server
 546 PASSWD is the corresponding password"
 547   (or host
 548       (setq host ldap-default-host)
 549       (error "No LDAP host specified"))
 550   (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
 551         ldap
 552         (i 1))
 553     (if (or binddn passwd)
 554         (setq host-plist (copy-seq host-plist)))
 555     (if binddn
 556         (setq host-plist (plist-put host-plist 'binddn binddn)))
 557     (if passwd
 558         (setq host-plist (plist-put host-plist 'passwd passwd)))
 559     (if ldap-verbose
 560         (message "Opening LDAP connection to %s..." host))
 561     (setq ldap (ldap-open host host-plist))
 562     (if ldap-verbose
 563         (message "Modifying LDAP entries..."))
 564     (mapcar (function
 565              (lambda (thisentry)
 566                (ldap-modify ldap (car thisentry) (cdr thisentry))
 567                (if ldap-verbose
 568                    (message "%d modified" i))
 569                (setq i (1+ i))))
 570             entry-mods)
 571     (ldap-close ldap)))
 572
 573
 574 (defun ldap-delete-entries (dn &optional host binddn passwd)
 575   "Delete an entry from an LDAP directory.
 576 DN is the distinguished name of an entry to delete or
 577 a list of those.
 578 HOST is the LDAP host, defaulting to `ldap-default-host'
 579 BINDDN is the DN to bind as to the server
 580 PASSWD is the corresponding password."
 581   (or host
 582       (setq host ldap-default-host)
 583       (error "No LDAP host specified"))
 584   (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
 585         ldap)
 586     (if (or binddn passwd)
 587         (setq host-plist (copy-seq host-plist)))
 588     (if binddn
 589         (setq host-plist (plist-put host-plist 'binddn binddn)))
 590     (if passwd
 591         (setq host-plist (plist-put host-plist 'passwd passwd)))
 592     (if ldap-verbose
 593         (message "Opening LDAP connection to %s..." host))
 594     (setq ldap (ldap-open host host-plist))
 595     (if (consp dn)
 596         (let ((i 1))
 597           (if ldap-verbose
 598               (message "Deleting LDAP entries..."))
 599           (mapcar (function
 600                    (lambda (thisdn)
 601                      (ldap-delete ldap thisdn)
 602                      (if ldap-verbose
 603                          (message "%d deleted" i))
 604                      (setq i (1+ i))))
 605                   dn))
 606       (if ldap-verbose
 607           (message "Deleting LDAP entry..."))
 608       (ldap-delete ldap dn))
 609     (ldap-close ldap)))
 610
 611
 612 (provide 'ldap)
 613
 614 ;;; ldap.el ends here