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     (carlicense . 15)
 381     (departmentnumber . 15)
 382     (displayname . 15)
 383     (employeenumber . 15)
 384     (employeetype . 15)
 385     (jpegphoto . 28)
 386     (preferredlanguage . 15)
 387     (usersmimecertificate . 5)
 388     (userpkcs12 . 5))
 389   "A map of LDAP attribute names to their type object id minor number.
 390 This table is built from RFC2252 Section 5, RFC2256 Section 5 and
 391 RFC2798 Section 9.1.1")
 392
 393
 394 ;; Coding/decoding functions
 395
 396 (defun ldap-encode-boolean (bool)
 397   (if bool
 398       "TRUE"
 399     "FALSE"))
 400
 401 (defun ldap-decode-boolean (str)
 402   (cond
 403    ((string-equal str "TRUE")
 404     t)
 405    ((string-equal str "FALSE")
 406     nil)
 407    (t
 408     (error "Wrong LDAP boolean string: %s" str))))
 409
 410 (defun ldap-encode-country-string (str)
 411   ;; We should do something useful here...
 412   (if (not (= 2 (length str)))
 413       (error "Invalid country string: %s" str)))
 414
 415 (defun ldap-decode-string (str)
 416   (decode-coding-string str ldap-coding-system))
 417
 418 (defun ldap-encode-string (str)
 419   (encode-coding-string str ldap-coding-system))
 420
 421 (defun ldap-decode-address (str)
 422   (mapconcat 'ldap-decode-string
 423              (split-string str "\\$")
 424              "\n"))
 425
 426 (defun ldap-encode-address (str)
 427   (mapconcat 'ldap-encode-string
 428              (split-string str "\n")
 429              "$"))
 430
 431
 432 ;; LDAP protocol functions
 433
 434 (defun ldap-get-host-parameter (host parameter)
 435   "Get the value of PARAMETER for HOST in `ldap-host-parameters-alist'."
 436   (plist-get (cdr (assoc host ldap-host-parameters-alist))
 437              parameter))
 438
 439 (defun ldap-decode-attribute (attr)
 440   "Decode the attribute/value pair ATTR according to LDAP rules.
 441 The attribute name is looked up in `ldap-attribute-syntaxes-alist'
 442 and the corresponding decoder is then retrieved from
 443 `ldap-attribute-syntax-decoders' and applied on the value(s)."
 444   (let* ((name (car attr))
 445          (values (cdr attr))
 446          (syntax-id (cdr (assq (intern (downcase name))
 447                                ldap-attribute-syntaxes-alist)))
 448          decoder)
 449     (if syntax-id
 450         (setq decoder (aref ldap-attribute-syntax-decoders
 451                             (1- syntax-id)))
 452       (setq decoder ldap-default-attribute-decoder))
 453     (if decoder
 454         (cons name (mapcar decoder values))
 455       attr)))
 456
 457 (defun ldap-search (filter &optional host attributes attrsonly withdn)
 458   "Perform an LDAP search.
 459 FILTER is the search filter in RFC1558 syntax.
 460 HOST is the LDAP host on which to perform the search.
 461 ATTRIBUTES are the specific attributes to retrieve, nil means
 462 retrieve all.
 463 ATTRSONLY, if non-nil, retrieves the attributes only, without
 464 the associated values.
 465 If WITHDN is non-nil, each entry in the result will be prepended with
 466 its distinguished name WITHDN.
 467 Additional search parameters can be specified through
 468 `ldap-host-parameters-alist', which see."
 469   (interactive "sFilter:")
 470   (or host
 471       (setq host ldap-default-host)
 472       (error "No LDAP host specified"))
 473   (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
 474         result)
 475     (setq result (ldap-search-internal `(host ,host
 476                                          filter ,filter
 477                                          attributes ,attributes
 478                                          attrsonly ,attrsonly
 479                                          withdn ,withdn
 480                                          ,@host-plist)))
 481     (if ldap-ignore-attribute-codings
 482         result
 483       (mapcar (lambda (record)
 484                 (mapcar 'ldap-decode-attribute record))
 485               result))))
 486
 487 (defun ldap-password-read (host)
 488   "Read LDAP password for HOST.
 489 If the password is cached, it is read from the cache, otherwise the user
 490 is prompted for the password.  If `password-cache' is non-nil the password
 491 is verified and cached.  The `password-cache-expiry' variable
 492 controls for how long the password is cached.
 493
 494 This function can be specified for the `passwd' property in
 495 `ldap-host-parameters-alist' when interactive password prompting
 496 is desired for HOST."
 497   ;; Add ldap: namespace to allow empty string for default host.
 498   (let* ((host-key (concat "ldap:" host))
 499          (password (password-read
 500                     (format "Enter LDAP Password%s: "
 501                             (if (equal host "")
 502                                 ""
 503                               (format " for %s" host)))
 504                     host-key)))
 505     (when (and password-cache
 506                (not (password-in-cache-p host-key))
 507                ;; Confirm the password is valid before adding it to
 508                ;; the password cache.  ldap-search-internal will throw
 509                ;; an error if the password is invalid.
 510                (not (ldap-search-internal
 511                      `(host ,host
 512                             ;; Specify an arbitrary filter that should
 513                             ;; produce no results, since only
 514                             ;; authentication success is of interest.
 515                             filter "emacs-test-password="
 516                             attributes nil
 517                             attrsonly nil
 518                             withdn nil
 519                             ;; Preempt passwd ldap-password-read
 520                             ;; setting in ldap-host-parameters-alist.
 521                             passwd ,password
 522                             ,@(cdr
 523                                (assoc
 524                                 host
 525                                 ldap-host-parameters-alist))))))
 526       (password-cache-add host-key password))
 527     password))
 528
 529 (defun ldap-search-internal (search-plist)
 530   "Perform a search on a LDAP server.
 531 SEARCH-PLIST is a property list describing the search request.
 532 Valid keys in that list are:
 533
 534   `auth-source', if non-nil, will use `auth-source-search' and
 535 will grab the :host, :secret, :base, and (:user or :binddn)
 536 tokens into the `host', `passwd', `base', and `binddn' parameters
 537 respectively if they are not provided in SEARCH-PLIST.  So for
 538 instance *each* of these netrc lines has the same effect if you
 539 ask for the host \"ldapserver:2400\":
 540
 541   machine ldapserver:2400 login myDN secret myPassword base myBase
 542   machine ldapserver:2400 binddn myDN secret myPassword port ldap
 543   login myDN secret myPassword base myBase
 544
 545 but if you have more than one in your netrc file, only the first
 546 matching one will be used.  Note the \"port ldap\" part is NOT
 547 required.
 548
 549   `host' is a string naming one or more (blank-separated) LDAP servers
 550 to try to connect to.  Each host name may optionally be of the form HOST:PORT.
 551   `filter' is a filter string for the search as described in RFC 1558.
 552   `attributes' is a list of strings indicating which attributes to retrieve
 553 for each matching entry. If nil, return all available attributes.
 554   `attrsonly', if non-nil, indicates that only attributes are retrieved,
 555 not their associated values.
 556   `auth' is one of the symbols `simple', `krbv41' or `krbv42'.
 557   `base' is the base for the search as described in RFC 1779.
 558   `scope' is one of the three symbols `sub', `base' or `one'.
 559   `binddn' is the distinguished name of the user to bind as (in
 560 RFC 1779 syntax).
 561   `passwd' is the password to use for simple authentication.
 562   `deref' is one of the symbols `never', `always', `search' or `find'.
 563   `timelimit' is the timeout limit for the connection in seconds.
 564   `sizelimit' is the maximum number of matches to return.
 565   `withdn' if non-nil each entry in the result will be prepended with
 566 its distinguished name DN.
 567 The function returns a list of matching entries.  Each entry is itself
 568 an alist of attribute/value pairs."
 569   (let* ((buf (get-buffer-create " *ldap-search*"))
 570         (bufval (get-buffer-create " *ldap-value*"))
 571         (host (or (plist-get search-plist 'host)
 572                   ldap-default-host))
 573          ;; find entries with port "ldap" that match the requested host if any
 574          (asfound (when (plist-get search-plist 'auth-source)
 575                     (nth 0 (auth-source-search :host (or host t)
 576                                                :create t))))
 577          ;; if no host was requested, get it from the auth-source entry
 578          (host (or host (plist-get asfound :host)))
 579          ;; get the password from the auth-source
 580          (passwd (or (plist-get search-plist 'passwd)
 581                      (plist-get asfound :secret)))
 582          ;; convert the password from a function call if needed
 583          (passwd (if (functionp passwd)
 584                      (if (eq passwd 'ldap-password-read)
 585                          (funcall passwd host)
 586                        (funcall passwd))
 587                    passwd))
 588          ;; get the binddn from the search-list or from the
 589          ;; auth-source user or binddn tokens
 590          (binddn (or (plist-get search-plist 'binddn)
 591                      (plist-get asfound :user)
 592                      (plist-get asfound :binddn)))
 593          (base (or (plist-get search-plist 'base)
 594                    (plist-get asfound :base)
 595                    ldap-default-base))
 596         (filter (plist-get search-plist 'filter))
 597         (attributes (plist-get search-plist 'attributes))
 598         (attrsonly (plist-get search-plist 'attrsonly))
 599         (scope (plist-get search-plist 'scope))
 600         (auth (plist-get search-plist 'auth))
 601         (deref (plist-get search-plist 'deref))
 602         (timelimit (plist-get search-plist 'timelimit))
 603         (sizelimit (plist-get search-plist 'sizelimit))
 604         (withdn (plist-get search-plist 'withdn))
 605         (numres 0)
 606         arglist dn name value record result proc)
 607     (if (or (null filter)
 608             (equal "" filter))
 609         (error "No search filter"))
 610     (setq filter (cons filter attributes))
 611     (with-current-buffer buf
 612       (erase-buffer)
 613       (if (and host
 614                (not (equal "" host)))
 615           (setq arglist (nconc arglist
 616                                (list (format
 617                                       ;; Use -H if host is a new-style LDAP URI.
 618                                       (if (string-match "^[a-zA-Z]+://" host)
 619                                           "-H%s"
 620                                         "-h%s")
 621                                       host)))))
 622       (if (and attrsonly
 623                (not (equal "" attrsonly)))
 624           (setq arglist (nconc arglist (list "-A"))))
 625       (if (and base
 626                (not (equal "" base)))
 627           (setq arglist (nconc arglist (list (format "-b%s" base)))))
 628       (if (and scope
 629                (not (equal "" scope)))
 630           (setq arglist (nconc arglist (list (format "-s%s" scope)))))
 631       (if (and binddn
 632                (not (equal "" binddn)))
 633           (setq arglist (nconc arglist (list (format "-D%s" binddn)))))
 634       (if (and auth
 635                (equal 'simple auth))
 636           (setq arglist (nconc arglist (list "-x"))))
 637       ;; Allow passwd to be set to "", representing a blank password.
 638       (if passwd
 639           (setq arglist (nconc arglist (list "-W"))))
 640       (if (and deref
 641                (not (equal "" deref)))
 642           (setq arglist (nconc arglist (list (format "-a%s" deref)))))
 643       (if (and timelimit
 644                (not (equal "" timelimit)))
 645           (setq arglist (nconc arglist (list (format "-l%s" timelimit)))))
 646       (if (and sizelimit
 647                (not (equal "" sizelimit)))
 648           (setq arglist (nconc arglist (list (format "-z%s" sizelimit)))))
 649       (if passwd
 650           (let* ((process-connection-type nil)
 651                  (proc-args (append arglist ldap-ldapsearch-args
 652                                     filter))
 653                  (proc (apply #'start-process "ldapsearch" buf
 654                               ldap-ldapsearch-prog
 655                               proc-args)))
 656             (while (null (progn
 657                            (goto-char (point-min))
 658                            (re-search-forward
 659                             ldap-ldapsearch-password-prompt-regexp
 660                             (point-max) t)))
 661               (accept-process-output proc 1))
 662             (process-send-string proc passwd)
 663             (process-send-string proc "\n")
 664             (while (not (memq (process-status proc) '(exit signal)))
 665               (sit-for 0.1))
 666             (let ((status (process-exit-status proc)))
 667               (when (not (eq status 0))
 668                 ;; Handle invalid credentials exit status specially
 669                 ;; for ldap-password-read.
 670                 (if (eq status 49)
 671                     (error (concat "Incorrect LDAP password or"
 672                                    " bind distinguished name (binddn)"))
 673                   (error "Failed ldapsearch invocation: %s \"%s\""
 674                          ldap-ldapsearch-prog
 675                          (mapconcat 'identity proc-args "\" \""))))))
 676         (apply #'call-process ldap-ldapsearch-prog
 677                ;; Ignore stderr, which can corrupt results
 678                nil (list buf nil) nil
 679                (append arglist ldap-ldapsearch-args filter)))
 680       (insert "\n")
 681       (goto-char (point-min))
 682
 683       (while (re-search-forward (concat "[\t\n\f]+ \\|"
 684                                         ldap-ldapsearch-password-prompt-regexp)
 685                                 nil t)
 686         (replace-match "" nil nil))
 687       (goto-char (point-min))
 688
 689       (if (looking-at "usage")
 690           (error "Incorrect ldapsearch invocation")
 691         (message "Parsing results... ")
 692         ;; Skip error message when retrieving attribute list
 693         (if (looking-at "Size limit exceeded")
 694             (forward-line 1))
 695         (if (looking-at "version:") (forward-line 1)) ;bug#12724.
 696         (while (progn
 697                  (skip-chars-forward " \t\n")
 698                  (not (eobp)))
 699           (setq dn (buffer-substring (point) (point-at-eol)))
 700           (forward-line 1)
 701           (while (looking-at "^\\([A-Za-z][-A-Za-z0-9]*\
 702 \\|[0-9]+\\(?:\\.[0-9]+\\)*\\)\\(;[-A-Za-z0-9]+\\)*[=:\t ]+\
 703 \\(<[\t ]*file://\\)\\(.*\\)$")
 704             (setq name (match-string 1)
 705                   value (match-string 4))
 706             ;; Need to handle file:///D:/... as generated by OpenLDAP
 707             ;; on DOS/Windows as local files.
 708             (if (and (memq system-type '(windows-nt ms-dos))
 709                      (eq (string-match "/\\(.:.*\\)$" value) 0))
 710                 (setq value (match-string 1 value)))
 711             ;; Do not try to open non-existent files
 712             (if (equal value "")
 713                 (setq value " ")
 714               (with-current-buffer bufval
 715                 (erase-buffer)
 716                 (set-buffer-multibyte nil)
 717                 (insert-file-contents-literally value)
 718                 (delete-file value)
 719                 (setq value (buffer-string))))
 720             (setq record (cons (list name value)
 721                                record))
 722             (forward-line 1))
 723           (cond (withdn
 724                  (push (cons dn (nreverse record)) result))
 725                 (record
 726                  (push (nreverse record) result)))
 727           (setq record nil)
 728           (skip-chars-forward " \t\n")
 729           (message "Parsing results... %d" numres)
 730           (1+ numres))
 731         (message "Parsing results... done")
 732         (nreverse result)))))
 733
 734 (provide 'ldap)
 735
 736 ;;; ldap.el ends here