ldap.el 24 KB

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