lisp/net/ldap.el

   1 ;;; ldap.el --- client interface to LDAP for Emacs
   2
   3 ;; Copyright (C) 1998-2017 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 (ldap-search-internal `(host ,host
 475                                          filter ,filter
 476                                          attributes ,attributes
 477                                          attrsonly ,attrsonly
 478                                          withdn ,withdn
 479                                          ,@host-plist))))
 480     (if ldap-ignore-attribute-codings
 481         result
 482       (mapcar (lambda (record)
 483                 (mapcar #'ldap-decode-attribute record))
 484               result))))
 485
 486 (defun ldap-password-read (host)
 487   "Read LDAP password for HOST.
 488 If the password is cached, it is read from the cache, otherwise the user
 489 is prompted for the password.  If `password-cache' is non-nil the password
 490 is verified and cached.  The `password-cache-expiry' variable
 491 controls for how long the password is cached.
 492
 493 This function can be specified for the `passwd' property in
 494 `ldap-host-parameters-alist' when interactive password prompting
 495 is desired for HOST."
 496   ;; Add ldap: namespace to allow empty string for default host.
 497   (let* ((host-key (concat "ldap:" host))
 498          (password (password-read
 499                     (format "Enter LDAP Password%s: "
 500                             (if (equal host "")
 501                                 ""
 502                               (format " for %s" host)))
 503                     host-key)))
 504     (when (and password-cache
 505                (not (password-in-cache-p host-key))
 506                ;; Confirm the password is valid before adding it to
 507                ;; the password cache.  ldap-search-internal will throw
 508                ;; an error if the password is invalid.
 509                (not (ldap-search-internal
 510                      `(host ,host
 511                             ;; Specify an arbitrary filter that should
 512                             ;; produce no results, since only
 513                             ;; authentication success is of interest.
 514                             filter "emacs-test-password="
 515                             attributes nil
 516                             attrsonly nil
 517                             withdn nil
 518                             ;; Preempt passwd ldap-password-read
 519                             ;; setting in ldap-host-parameters-alist.
 520                             passwd ,password
 521                             ,@(cdr
 522                                (assoc
 523                                 host
 524                                 ldap-host-parameters-alist))))))
 525       (password-cache-add host-key password))
 526     password))
 527
 528 (defun ldap-search-internal (search-plist)
 529   "Perform a search on a LDAP server.
 530 SEARCH-PLIST is a property list describing the search request.
 531 Valid keys in that list are:
 532
 533   `auth-source', if non-nil, will use `auth-source-search' and
 534 will grab the :host, :secret, :base, and (:user or :binddn)
 535 tokens into the `host', `passwd', `base', and `binddn' parameters
 536 respectively if they are not provided in SEARCH-PLIST.  So for
 537 instance *each* of these netrc lines has the same effect if you
 538 ask for the host \"ldapserver:2400\":
 539
 540   machine ldapserver:2400 login myDN secret myPassword base myBase
 541   machine ldapserver:2400 binddn myDN secret myPassword port ldap
 542   login myDN secret myPassword base myBase
 543
 544 but if you have more than one in your netrc file, only the first
 545 matching one will be used.  Note the \"port ldap\" part is NOT
 546 required.
 547
 548   `host' is a string naming one or more (blank-separated) LDAP servers
 549 to try to connect to.  Each host name may optionally be of the form HOST:PORT.
 550   `filter' is a filter string for the search as described in RFC 1558.
 551   `attributes' is a list of strings indicating which attributes to retrieve
 552 for each matching entry. If nil, return all available attributes.
 553   `attrsonly', if non-nil, indicates that only attributes are retrieved,
 554 not their associated values.
 555   `auth' is one of the symbols `simple', `krbv41' or `krbv42'.
 556   `base' is the base for the search as described in RFC 1779.
 557   `scope' is one of the three symbols `sub', `base' or `one'.
 558   `binddn' is the distinguished name of the user to bind as (in
 559 RFC 1779 syntax).
 560   `passwd' is the password to use for simple authentication.
 561   `deref' is one of the symbols `never', `always', `search' or `find'.
 562   `timelimit' is the timeout limit for the connection in seconds.
 563   `sizelimit' is the maximum number of matches to return.
 564   `withdn' if non-nil each entry in the result will be prepended with
 565 its distinguished name DN.
 566 The function returns a list of matching entries.  Each entry is itself
 567 an alist of attribute/value pairs."
 568   (let* ((buf (get-buffer-create " *ldap-search*"))
 569         (bufval (get-buffer-create " *ldap-value*"))
 570         (host (or (plist-get search-plist 'host)
 571                   ldap-default-host))
 572          ;; find entries with port "ldap" that match the requested host if any
 573          (asfound (when (plist-get search-plist 'auth-source)
 574                     (nth 0 (auth-source-search :host (or host t)
 575                                                :create t))))
 576          ;; if no host was requested, get it from the auth-source entry
 577          (host (or host (plist-get asfound :host)))
 578          ;; get the password from the auth-source
 579          (passwd (or (plist-get search-plist 'passwd)
 580                      (plist-get asfound :secret)))
 581          ;; convert the password from a function call if needed
 582          (passwd (if (functionp passwd)
 583                      (if (eq passwd 'ldap-password-read)
 584                          (funcall passwd host)
 585                        (funcall passwd))
 586                    passwd))
 587          ;; get the binddn from the search-list or from the
 588          ;; auth-source user or binddn tokens
 589          (binddn (or (plist-get search-plist 'binddn)
 590                      (plist-get asfound :user)
 591                      (plist-get asfound :binddn)))
 592          (base (or (plist-get search-plist 'base)
 593                    (plist-get asfound :base)
 594                    ldap-default-base))
 595         (filter (plist-get search-plist 'filter))
 596         (attributes (plist-get search-plist 'attributes))
 597         (attrsonly (plist-get search-plist 'attrsonly))
 598         (scope (plist-get search-plist 'scope))
 599         (auth (plist-get search-plist 'auth))
 600         (deref (plist-get search-plist 'deref))
 601         (timelimit (plist-get search-plist 'timelimit))
 602         (sizelimit (plist-get search-plist 'sizelimit))
 603         (withdn (plist-get search-plist 'withdn))
 604         (numres 0)
 605         arglist dn name value record result proc)
 606     (if (or (null filter)
 607             (equal "" filter))
 608         (error "No search filter"))
 609     (setq filter (cons filter attributes))
 610     (with-current-buffer buf
 611       (erase-buffer)
 612       (if (and host
 613                (not (equal "" host)))
 614           (setq arglist (nconc arglist
 615                                (list (format
 616                                       ;; Use -H if host is a new-style LDAP URI.
 617                                       (if (string-match "^[a-zA-Z]+://" host)
 618                                           "-H%s"
 619                                         "-h%s")
 620                                       host)))))
 621       (if (and attrsonly
 622                (not (equal "" attrsonly)))
 623           (setq arglist (nconc arglist (list "-A"))))
 624       (if (and base
 625                (not (equal "" base)))
 626           (setq arglist (nconc arglist (list (format "-b%s" base)))))
 627       (if (and scope
 628                (not (equal "" scope)))
 629           (setq arglist (nconc arglist (list (format "-s%s" scope)))))
 630       (if (and binddn
 631                (not (equal "" binddn)))
 632           (setq arglist (nconc arglist (list (format "-D%s" binddn)))))
 633       (if (and auth
 634                (equal 'simple auth))
 635           (setq arglist (nconc arglist (list "-x"))))
 636       ;; Allow passwd to be set to "", representing a blank password.
 637       (if passwd
 638           (setq arglist (nconc arglist (list "-W"))))
 639       (if (and deref
 640                (not (equal "" deref)))
 641           (setq arglist (nconc arglist (list (format "-a%s" deref)))))
 642       (if (and timelimit
 643                (not (equal "" timelimit)))
 644           (setq arglist (nconc arglist (list (format "-l%s" timelimit)))))
 645       (if (and sizelimit
 646                (not (equal "" sizelimit)))
 647           (setq arglist (nconc arglist (list (format "-z%s" sizelimit)))))
 648       (if passwd
 649           (let* ((process-connection-type nil)
 650                  (proc-args (append arglist ldap-ldapsearch-args
 651                                     filter))
 652                  (proc (apply #'start-process "ldapsearch" buf
 653                               ldap-ldapsearch-prog
 654                               proc-args)))
 655             (while (null (progn
 656                            (goto-char (point-min))
 657                            (re-search-forward
 658                             ldap-ldapsearch-password-prompt-regexp
 659                             (point-max) t)))
 660               (accept-process-output proc 1))
 661             (process-send-string proc passwd)
 662             (process-send-string proc "\n")
 663             (while (not (memq (process-status proc) '(exit signal)))
 664               (sit-for 0.1))
 665             (let ((status (process-exit-status proc)))
 666               (when (not (eq status 0))
 667                 ;; Handle invalid credentials exit status specially
 668                 ;; for ldap-password-read.
 669                 (if (eq status 49)
 670                     (error (concat "Incorrect LDAP password or"
 671                                    " bind distinguished name (binddn)"))
 672                   (error "Failed ldapsearch invocation: %s \"%s\""
 673                          ldap-ldapsearch-prog
 674                          (mapconcat 'identity proc-args "\" \""))))))
 675         (apply #'call-process ldap-ldapsearch-prog
 676                ;; Ignore stderr, which can corrupt results
 677                nil (list buf nil) nil
 678                (append arglist ldap-ldapsearch-args filter)))
 679       (insert "\n")
 680       (goto-char (point-min))
 681
 682       (while (re-search-forward (concat "[\t\n\f]+ \\|"
 683                                         ldap-ldapsearch-password-prompt-regexp)
 684                                 nil t)
 685         (replace-match "" nil nil))
 686       (goto-char (point-min))
 687
 688       (if (looking-at "usage")
 689           (error "Incorrect ldapsearch invocation")
 690         (message "Parsing results... ")
 691         ;; Skip error message when retrieving attribute list
 692         (if (looking-at "Size limit exceeded")
 693             (forward-line 1))
 694         (if (looking-at "version:") (forward-line 1)) ;bug#12724.
 695         (while (progn
 696                  (skip-chars-forward " \t\n")
 697                  (not (eobp)))
 698           (setq dn (buffer-substring (point) (point-at-eol)))
 699           (forward-line 1)
 700           (while (looking-at "^\\([A-Za-z][-A-Za-z0-9]*\
 701 \\|[0-9]+\\(?:\\.[0-9]+\\)*\\)\\(;[-A-Za-z0-9]+\\)*[=:\t ]+\
 702 \\(<[\t ]*file://\\)\\(.*\\)$")
 703             (setq name (match-string 1)
 704                   value (match-string 4))
 705             ;; Need to handle file:///D:/... as generated by OpenLDAP
 706             ;; on DOS/Windows as local files.
 707             (if (and (memq system-type '(windows-nt ms-dos))
 708                      (eq (string-match "/\\(.:.*\\)$" value) 0))
 709                 (setq value (match-string 1 value)))
 710             ;; Do not try to open non-existent files
 711             (if (equal value "")
 712                 (setq value " ")
 713               (with-current-buffer bufval
 714                 (erase-buffer)
 715                 (set-buffer-multibyte nil)
 716                 (insert-file-contents-literally value)
 717                 (delete-file value)
 718                 (setq value (buffer-string))))
 719             (setq record (cons (list name value)
 720                                record))
 721             (forward-line 1))
 722           (cond (withdn
 723                  (push (cons dn (nreverse record)) result))
 724                 (record
 725                  (push (nreverse record) result)))
 726           (setq record nil)
 727           (skip-chars-forward " \t\n")
 728           (message "Parsing results... %d" numres)
 729           (1+ numres))
 730         (message "Parsing results... done")
 731         (nreverse result)))))
 732
 733 (provide 'ldap)
 734
 735 ;;; ldap.el ends here