lisp/net/ldap.el

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