lisp/net/ldap.el

   1 ;;; ldap.el --- client interface to LDAP for Emacs
   2
   3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
   5
   6 ;; Author: Oscar Figueiredo <oscar@cpe.fr>
   7 ;; Maintainer: FSF
   8 ;; Created: April 1998
   9 ;; Keywords: comm
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs 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, or (at your option)
  16 ;; any later version.
  17
  18 ;; GNU Emacs 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 GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  26 ;; Boston, MA 02110-1301, USA.
  27
  28 ;;; Commentary:
  29
  30 ;;    This package provides basic functionality to perform searches on LDAP
  31 ;;    servers.  It requires a command line utility generally named
  32 ;;    `ldapsearch' to actually perform the searches.  That program can be
  33 ;;    found in all LDAP developer kits such as:
  34 ;;      - UM-LDAP 3.3 (http://www.umich.edu/~dirsvcs/ldap/)
  35 ;;      - OpenLDAP (http://www.openldap.org/)
  36
  37 ;;; Code:
  38
  39 (require 'custom)
  40 (eval-when-compile (require 'cl))
  41
  42 (defgroup ldap nil
  43   "Lightweight Directory Access Protocol."
  44   :version "21.1"
  45   :group 'comm)
  46
  47 (defcustom ldap-default-host nil
  48   "*Default LDAP server.
  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 (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-ldapsearch-prog "ldapsearch"
 153   "*The name of the ldapsearch command line program."
 154   :type '(string :tag "`ldapsearch' Program")
 155   :group 'ldap)
 156
 157 (defcustom ldap-ldapsearch-args '("-LL" "-tt")
 158   "*A list of additional arguments to pass to `ldapsearch'."
 159   :type '(repeat :tag "`ldapsearch' Arguments"
 160                  (string :tag "Argument"))
 161   :group 'ldap)
 162
 163 (defcustom ldap-ignore-attribute-codings nil
 164   "*If non-nil, do not encode/decode LDAP attribute values."
 165   :type 'boolean
 166   :group 'ldap)
 167
 168 (defcustom ldap-default-attribute-decoder nil
 169   "*Decoder function to use for attributes whose syntax is unknown."
 170   :type 'symbol
 171   :group 'ldap)
 172
 173 (defcustom ldap-coding-system 'utf-8
 174   "*Coding system of LDAP string values.
 175 LDAP v3 specifies the coding system of strings to be UTF-8."
 176   :type 'symbol
 177   :group 'ldap)
 178
 179 (defvar ldap-attribute-syntax-encoders
 180   [nil                                  ; 1  ACI Item                        N
 181    nil                                  ; 2  Access Point                    Y
 182    nil                                  ; 3  Attribute Type Description      Y
 183    nil                                  ; 4  Audio                           N
 184    nil                                  ; 5  Binary                          N
 185    nil                                  ; 6  Bit String                      Y
 186    ldap-encode-boolean                  ; 7  Boolean                         Y
 187    nil                                  ; 8  Certificate                     N
 188    nil                                  ; 9  Certificate List                N
 189    nil                                  ; 10 Certificate Pair                N
 190    ldap-encode-country-string           ; 11 Country String                  Y
 191    ldap-encode-string                   ; 12 DN                              Y
 192    nil                                  ; 13 Data Quality Syntax             Y
 193    nil                                  ; 14 Delivery Method                 Y
 194    ldap-encode-string                   ; 15 Directory String                Y
 195    nil                                  ; 16 DIT Content Rule Description    Y
 196    nil                                  ; 17 DIT Structure Rule Description  Y
 197    nil                                  ; 18 DL Submit Permission            Y
 198    nil                                  ; 19 DSA Quality Syntax              Y
 199    nil                                  ; 20 DSE Type                        Y
 200    nil                                  ; 21 Enhanced Guide                  Y
 201    nil                                  ; 22 Facsimile Telephone Number      Y
 202    nil                                  ; 23 Fax                             N
 203    nil                                  ; 24 Generalized Time                Y
 204    nil                                  ; 25 Guide                           Y
 205    nil                                  ; 26 IA5 String                      Y
 206    number-to-string                     ; 27 INTEGER                         Y
 207    nil                                  ; 28 JPEG                            N
 208    nil                                  ; 29 Master And Shadow Access Points Y
 209    nil                                  ; 30 Matching Rule Description       Y
 210    nil                                  ; 31 Matching Rule Use Description   Y
 211    nil                                  ; 32 Mail Preference                 Y
 212    nil                                  ; 33 MHS OR Address                  Y
 213    nil                                  ; 34 Name And Optional UID           Y
 214    nil                                  ; 35 Name Form Description           Y
 215    nil                                  ; 36 Numeric String                  Y
 216    nil                                  ; 37 Object Class Description        Y
 217    nil                                  ; 38 OID                             Y
 218    nil                                  ; 39 Other Mailbox                   Y
 219    nil                                  ; 40 Octet String                    Y
 220    ldap-encode-address                  ; 41 Postal Address                  Y
 221    nil                                  ; 42 Protocol Information            Y
 222    nil                                  ; 43 Presentation Address            Y
 223    ldap-encode-string                   ; 44 Printable String                Y
 224    nil                                  ; 45 Subtree Specification           Y
 225    nil                                  ; 46 Supplier Information            Y
 226    nil                                  ; 47 Supplier Or Consumer            Y
 227    nil                                  ; 48 Supplier And Consumer           Y
 228    nil                                  ; 49 Supported Algorithm             N
 229    nil                                  ; 50 Telephone Number                Y
 230    nil                                  ; 51 Teletex Terminal Identifier     Y
 231    nil                                  ; 52 Telex Number                    Y
 232    nil                                  ; 53 UTC Time                        Y
 233    nil                                  ; 54 LDAP Syntax Description         Y
 234    nil                                  ; 55 Modify Rights                   Y
 235    nil                                  ; 56 LDAP Schema Definition          Y
 236    nil                                  ; 57 LDAP Schema Description         Y
 237    nil                                  ; 58 Substring Assertion             Y
 238    ]
 239   "A vector of functions used to encode LDAP attribute values.
 240 The sequence of functions corresponds to the sequence of LDAP attribute syntax
 241 object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in
 242 RFC2252 section 4.3.2")
 243
 244 (defvar ldap-attribute-syntax-decoders
 245   [nil                                  ; 1  ACI Item                        N
 246    nil                                  ; 2  Access Point                    Y
 247    nil                                  ; 3  Attribute Type Description      Y
 248    nil                                  ; 4  Audio                           N
 249    nil                                  ; 5  Binary                          N
 250    nil                                  ; 6  Bit String                      Y
 251    ldap-decode-boolean                  ; 7  Boolean                         Y
 252    nil                                  ; 8  Certificate                     N
 253    nil                                  ; 9  Certificate List                N
 254    nil                                  ; 10 Certificate Pair                N
 255    ldap-decode-string                   ; 11 Country String                  Y
 256    ldap-decode-string                   ; 12 DN                              Y
 257    nil                                  ; 13 Data Quality Syntax             Y
 258    nil                                  ; 14 Delivery Method                 Y
 259    ldap-decode-string                   ; 15 Directory String                Y
 260    nil                                  ; 16 DIT Content Rule Description    Y
 261    nil                                  ; 17 DIT Structure Rule Description  Y
 262    nil                                  ; 18 DL Submit Permission            Y
 263    nil                                  ; 19 DSA Quality Syntax              Y
 264    nil                                  ; 20 DSE Type                        Y
 265    nil                                  ; 21 Enhanced Guide                  Y
 266    nil                                  ; 22 Facsimile Telephone Number      Y
 267    nil                                  ; 23 Fax                             N
 268    nil                                  ; 24 Generalized Time                Y
 269    nil                                  ; 25 Guide                           Y
 270    nil                                  ; 26 IA5 String                      Y
 271    string-to-number                     ; 27 INTEGER                         Y
 272    nil                                  ; 28 JPEG                            N
 273    nil                                  ; 29 Master And Shadow Access Points Y
 274    nil                                  ; 30 Matching Rule Description       Y
 275    nil                                  ; 31 Matching Rule Use Description   Y
 276    nil                                  ; 32 Mail Preference                 Y
 277    nil                                  ; 33 MHS OR Address                  Y
 278    nil                                  ; 34 Name And Optional UID           Y
 279    nil                                  ; 35 Name Form Description           Y
 280    nil                                  ; 36 Numeric String                  Y
 281    nil                                  ; 37 Object Class Description        Y
 282    nil                                  ; 38 OID                             Y
 283    nil                                  ; 39 Other Mailbox                   Y
 284    nil                                  ; 40 Octet String                    Y
 285    ldap-decode-address                  ; 41 Postal Address                  Y
 286    nil                                  ; 42 Protocol Information            Y
 287    nil                                  ; 43 Presentation Address            Y
 288    ldap-decode-string                   ; 44 Printable String                Y
 289    nil                                  ; 45 Subtree Specification           Y
 290    nil                                  ; 46 Supplier Information            Y
 291    nil                                  ; 47 Supplier Or Consumer            Y
 292    nil                                  ; 48 Supplier And Consumer           Y
 293    nil                                  ; 49 Supported Algorithm             N
 294    nil                                  ; 50 Telephone Number                Y
 295    nil                                  ; 51 Teletex Terminal Identifier     Y
 296    nil                                  ; 52 Telex Number                    Y
 297    nil                                  ; 53 UTC Time                        Y
 298    nil                                  ; 54 LDAP Syntax Description         Y
 299    nil                                  ; 55 Modify Rights                   Y
 300    nil                                  ; 56 LDAP Schema Definition          Y
 301    nil                                  ; 57 LDAP Schema Description         Y
 302    nil                                  ; 58 Substring Assertion             Y
 303    ]
 304   "A vector of functions used to decode LDAP attribute values.
 305 The sequence of functions corresponds to the sequence of LDAP attribute syntax
 306 object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in
 307 RFC2252 section 4.3.2")
 308
 309
 310 (defvar ldap-attribute-syntaxes-alist
 311   '((createtimestamp . 24)
 312     (modifytimestamp . 24)
 313     (creatorsname . 12)
 314     (modifiersname . 12)
 315     (subschemasubentry . 12)
 316     (attributetypes . 3)
 317     (objectclasses . 37)
 318     (matchingrules . 30)
 319     (matchingruleuse . 31)
 320     (namingcontexts . 12)
 321     (altserver . 26)
 322     (supportedextension . 38)
 323     (supportedcontrol . 38)
 324     (supportedsaslmechanisms . 15)
 325     (supportedldapversion . 27)
 326     (ldapsyntaxes . 16)
 327     (ditstructurerules . 17)
 328     (nameforms . 35)
 329     (ditcontentrules . 16)
 330     (objectclass . 38)
 331     (aliasedobjectname . 12)
 332     (cn . 15)
 333     (sn . 15)
 334     (serialnumber . 44)
 335     (c . 15)
 336     (l . 15)
 337     (st . 15)
 338     (street . 15)
 339     (o . 15)
 340     (ou . 15)
 341     (title . 15)
 342     (description . 15)
 343     (searchguide . 25)
 344     (businesscategory . 15)
 345     (postaladdress . 41)
 346     (postalcode . 15)
 347     (postofficebox . 15)
 348     (physicaldeliveryofficename . 15)
 349     (telephonenumber . 50)
 350     (telexnumber . 52)
 351     (telexterminalidentifier . 51)
 352     (facsimiletelephonenumber . 22)
 353     (x121address . 36)
 354     (internationalisdnnumber . 36)
 355     (registeredaddress . 41)
 356     (destinationindicator . 44)
 357     (preferreddeliverymethod . 14)
 358     (presentationaddress . 43)
 359     (supportedapplicationcontext . 38)
 360     (member . 12)
 361     (owner . 12)
 362     (roleoccupant . 12)
 363     (seealso . 12)
 364     (userpassword . 40)
 365     (usercertificate . 8)
 366     (cacertificate . 8)
 367     (authorityrevocationlist . 9)
 368     (certificaterevocationlist . 9)
 369     (crosscertificatepair . 10)
 370     (name . 15)
 371     (givenname . 15)
 372     (initials . 15)
 373     (generationqualifier . 15)
 374     (x500uniqueidentifier . 6)
 375     (dnqualifier . 44)
 376     (enhancedsearchguide . 21)
 377     (protocolinformation . 42)
 378     (distinguishedname . 12)
 379     (uniquemember . 34)
 380     (houseidentifier . 15)
 381     (supportedalgorithms . 49)
 382     (deltarevocationlist . 9)
 383     (dmdname . 15))
 384   "A map of LDAP attribute names to their type object id minor number.
 385 This table is built from RFC2252 Section 5 and RFC2256 Section 5")
 386
 387
 388 ;; Coding/decoding functions
 389
 390 (defun ldap-encode-boolean (bool)
 391   (if bool
 392       "TRUE"
 393     "FALSE"))
 394
 395 (defun ldap-decode-boolean (str)
 396   (cond
 397    ((string-equal str "TRUE")
 398     t)
 399    ((string-equal str "FALSE")
 400     nil)
 401    (t
 402     (error "Wrong LDAP boolean string: %s" str))))
 403
 404 (defun ldap-encode-country-string (str)
 405   ;; We should do something useful here...
 406   (if (not (= 2 (length str)))
 407       (error "Invalid country string: %s" str)))
 408
 409 (defun ldap-decode-string (str)
 410   (decode-coding-string str ldap-coding-system))
 411
 412 (defun ldap-encode-string (str)
 413   (encode-coding-string str ldap-coding-system))
 414
 415 (defun ldap-decode-address (str)
 416   (mapconcat 'ldap-decode-string
 417              (split-string str "\\$")
 418              "\n"))
 419
 420 (defun ldap-encode-address (str)
 421   (mapconcat 'ldap-encode-string
 422              (split-string str "\n")
 423              "$"))
 424
 425
 426 ;; LDAP protocol functions
 427
 428 (defun ldap-get-host-parameter (host parameter)
 429   "Get the value of PARAMETER for HOST in `ldap-host-parameters-alist'."
 430   (plist-get (cdr (assoc host ldap-host-parameters-alist))
 431              parameter))
 432
 433 (defun ldap-decode-attribute (attr)
 434   "Decode the attribute/value pair ATTR according to LDAP rules.
 435 The attribute name is looked up in `ldap-attribute-syntaxes-alist'
 436 and the corresponding decoder is then retrieved from
 437 `ldap-attribute-syntax-decoders' and applied on the value(s)."
 438   (let* ((name (car attr))
 439          (values (cdr attr))
 440          (syntax-id (cdr (assq (intern (downcase name))
 441                                ldap-attribute-syntaxes-alist)))
 442          decoder)
 443     (if syntax-id
 444         (setq decoder (aref ldap-attribute-syntax-decoders
 445                             (1- syntax-id)))
 446       (setq decoder ldap-default-attribute-decoder))
 447     (if decoder
 448         (cons name (mapcar decoder values))
 449       attr)))
 450
 451 (defun ldap-search (filter &optional host attributes attrsonly withdn)
 452   "Perform an LDAP search.
 453 FILTER is the search filter in RFC1558 syntax.
 454 HOST is the LDAP host on which to perform the search.
 455 ATTRIBUTES are the specific attributes to retrieve, nil means
 456 retrieve all.
 457 ATTRSONLY, if non-nil, retrieves the attributes only, without
 458 the associated values.
 459 If WITHDN is non-nil, each entry in the result will be prepended with
 460 its distinguished name WITHDN.
 461 Additional search parameters can be specified through
 462 `ldap-host-parameters-alist', which see."
 463   (interactive "sFilter:")
 464   (or host
 465       (setq host ldap-default-host)
 466       (error "No LDAP host specified"))
 467   (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
 468         result)
 469     (setq result (ldap-search-internal (list* 'host host
 470                                               'filter filter
 471                                               'attributes attributes
 472                                               'attrsonly attrsonly
 473                                               'withdn withdn
 474                                               host-plist)))
 475     (if ldap-ignore-attribute-codings
 476         result
 477       (mapcar (lambda (record)
 478                 (mapcar 'ldap-decode-attribute record))
 479               result))))
 480
 481
 482 (defun ldap-search-internal (search-plist)
 483   "Perform a search on a LDAP server.
 484 SEARCH-PLIST is a property list describing the search request.
 485 Valid keys in that list are:
 486   `host' is a string naming one or more (blank-separated) LDAP servers to
 487 to try to connect to.  Each host name may optionally be of the form HOST:PORT.
 488   `filter' is a filter string for the search as described in RFC 1558.
 489   `attributes' is a list of strings indicating which attributes to retrieve
 490 for each matching entry. If nil, return all available attributes.
 491   `attrsonly', if non-nil, indicates that only attributes are retrieved,
 492 not their associated values.
 493   `auth' is one of the symbols `simple', `krbv41' or `krbv42'.
 494   `base' is the base for the search as described in RFC 1779.
 495   `scope' is one of the three symbols `sub', `base' or `one'.
 496   `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax).
 497   `auth' is one of the symbols `simple', `krbv41' or `krbv42'
 498   `passwd' is the password to use for simple authentication.
 499   `deref' is one of the symbols `never', `always', `search' or `find'.
 500   `timelimit' is the timeout limit for the connection in seconds.
 501   `sizelimit' is the maximum number of matches to return.
 502   `withdn' if non-nil each entry in the result will be prepended with
 503 its distinguished name DN.
 504 The function returns a list of matching entries.  Each entry is itself
 505 an alist of attribute/value pairs."
 506   (let ((buf (get-buffer-create " *ldap-search*"))
 507         (bufval (get-buffer-create " *ldap-value*"))
 508         (host (or (plist-get search-plist 'host)
 509                   ldap-default-host))
 510         (filter (plist-get search-plist 'filter))
 511         (attributes (plist-get search-plist 'attributes))
 512         (attrsonly (plist-get search-plist 'attrsonly))
 513         (base (or (plist-get search-plist 'base)
 514                   ldap-default-base))
 515         (scope (plist-get search-plist 'scope))
 516         (binddn (plist-get search-plist 'binddn))
 517         (auth (plist-get search-plist 'auth))
 518         (passwd (plist-get search-plist 'passwd))
 519         (deref (plist-get search-plist 'deref))
 520         (timelimit (plist-get search-plist 'timelimit))
 521         (sizelimit (plist-get search-plist 'sizelimit))
 522         (withdn (plist-get search-plist 'withdn))
 523         (numres 0)
 524         arglist dn name value record result)
 525     (if (or (null filter)
 526             (equal "" filter))
 527         (error "No search filter"))
 528     (setq filter (cons filter attributes))
 529     (save-excursion
 530       (set-buffer buf)
 531       (erase-buffer)
 532       (if (and host
 533                (not (equal "" host)))
 534           (setq arglist (nconc arglist (list (format "-h%s" host)))))
 535       (if (and attrsonly
 536                (not (equal "" attrsonly)))
 537           (setq arglist (nconc arglist (list "-A"))))
 538       (if (and base
 539                (not (equal "" base)))
 540           (setq arglist (nconc arglist (list (format "-b%s" base)))))
 541       (if (and scope
 542                (not (equal "" scope)))
 543           (setq arglist (nconc arglist (list (format "-s%s" scope)))))
 544       (if (and binddn
 545                (not (equal "" binddn)))
 546           (setq arglist (nconc arglist (list (format "-D%s" binddn)))))
 547       (if (and auth
 548                (equal 'simple auth))
 549           (setq arglist (nconc arglist (list "-x"))))
 550       (if (and passwd
 551                (not (equal "" passwd)))
 552           (setq arglist (nconc arglist (list (format "-w%s" passwd)))))
 553       (if (and deref
 554                (not (equal "" deref)))
 555           (setq arglist (nconc arglist (list (format "-a%s" deref)))))
 556       (if (and timelimit
 557                (not (equal "" timelimit)))
 558           (setq arglist (nconc arglist (list (format "-l%s" timelimit)))))
 559       (if (and sizelimit
 560                (not (equal "" sizelimit)))
 561           (setq arglist (nconc arglist (list (format "-z%s" sizelimit)))))
 562       (eval `(call-process ldap-ldapsearch-prog
 563                            nil
 564                            buf
 565                            nil
 566                            ,@arglist
 567                            ,@ldap-ldapsearch-args
 568                            ,@filter))
 569       (insert "\n")
 570       (goto-char (point-min))
 571
 572       (while (re-search-forward "[\t\n\f]+ " nil t)
 573         (replace-match "" nil nil))
 574       (goto-char (point-min))
 575
 576       (if (looking-at "usage")
 577           (error "Incorrect ldapsearch invocation")
 578         (message "Parsing results... ")
 579         ;; Skip error message when retrieving attribute list
 580         (if (looking-at "Size limit exceeded")
 581             (forward-line 1))
 582         (while (progn
 583                  (skip-chars-forward " \t\n")
 584                  (not (eobp)))
 585           (setq dn (buffer-substring (point) (save-excursion
 586                                                (end-of-line)
 587                                                (point))))
 588           (forward-line 1)
 589           (while (looking-at "^\\(\\w*\\)\\(;\\w*\\)?[=:\t ]+\\(<[\t ]*file://\\)\\(.*\\)$")
 590             (setq name (match-string 1)
 591                   value (match-string 4))
 592             ;; Need to handle file:///D:/... as generated by OpenLDAP
 593             ;; on DOS/Windows as local files.
 594             (if (and (memq system-type '(windows-nt ms-dos))
 595                      (eq (string-match "/\\(.:.*\\)$" value) 0))
 596                 (setq value (match-string 1 value)))
 597             ;; Do not try to open non-existent files
 598             (if (equal value "")
 599                 (setq value " ")
 600               (save-excursion
 601                 (set-buffer bufval)
 602                 (erase-buffer)
 603                 (set-buffer-multibyte nil)
 604                 (insert-file-contents-literally value)
 605                 (delete-file value)
 606                 (setq value (buffer-string))))
 607             (setq record (cons (list name value)
 608                                record))
 609             (forward-line 1))
 610           (setq result (cons (if withdn
 611                                  (cons dn (nreverse record))
 612                                (nreverse record)) result))
 613           (setq record nil)
 614           (skip-chars-forward " \t\n")
 615           (message "Parsing results... %d" numres)
 616           (1+ numres))
 617         (message "Parsing results... done")
 618         (nreverse result)))))
 619
 620 (provide 'ldap)
 621
 622 ;; arch-tag: 47913a76-6155-42e6-ac58-6d28b5d50eb0
 623 ;;; ldap.el ends here