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