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

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