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

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