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