code.delx.au - gnu-emacs/blob - lisp/net/ldap.el

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