1 ;;; ldap.el --- LDAP support for Emacs
3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
5 ;; Author: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
6 ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
8 ;; Version: $Revision: 1.7.2.6 $
11 ;; This file is part of XEmacs
13 ;; XEmacs is free software; you can redistribute it and/or modify it
14 ;; under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation; either version 2, or (at your option)
18 ;; XEmacs is distributed in the hope that it will be useful, but
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 ;; General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with XEmacs; see the file COPYING. If not, write to
25 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;; Boston, MA 02111-1307, USA.
29 ;; This file provides mid-level and user-level functions to access directory
30 ;; servers using the LDAP protocol (RFC 1777).
33 ;; LDAP support must have been built into XEmacs.
39 "Lightweight Directory Access Protocol"
42 (defcustom ldap-default-host nil
43 "*Default LDAP server hostname.
44 A TCP port number can be appended to that name using a colon as
46 :type '(choice (string :tag "Host name")
47 (const :tag "Use library default" nil))
50 (defcustom ldap-default-port nil
51 "*Default TCP port for LDAP connections.
52 Initialized from the LDAP library at build time. Default value is 389."
53 :type '(choice (const :tag "Use library default" nil)
54 (integer :tag "Port number"))
57 (defcustom ldap-default-base nil
58 "*Default base for LDAP searches.
59 This is a string using the syntax of RFC 1779.
60 For instance, \"o=ACME, c=US\" limits the search to the
61 Acme organization in the United States."
62 :type '(choice (const :tag "Use library default" nil)
63 (string :tag "Search base"))
67 (defcustom ldap-host-parameters-alist nil
68 "*Alist of host-specific options for LDAP transactions.
69 The format of each list element is:
70 \(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
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"
90 (string :tag "Host name")
96 (const :tag "Search Base" base)
101 (const :tag "Binding DN" binddn)
106 (const :tag "Password" passwd)
109 :tag "Authentication Method"
111 (const :tag "Authentication Method" auth)
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)))
120 (const :tag "Search Scope" scope)
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)))
129 (const :tag "Dereferencing" deref)
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)))
139 (const :tag "Time Limit" timelimit)
140 (integer :tag "(in seconds)"))
144 (const :tag "Size Limit" sizelimit)
145 (integer :tag "(number of records)")))))
148 (defcustom ldap-ignore-attribute-codings nil
149 "*If non-nil, do not perform any encoding/decoding on LDAP attribute values."
153 (defcustom ldap-default-attribute-decoder nil
154 "*Decoder function to use for attributes whose syntax is unknown."
158 (defcustom ldap-coding-system nil
159 "*Coding system of LDAP string values.
160 LDAP v3 specifies the coding system of strings to be UTF-8.
161 Mule support is needed for this."
165 (defvar ldap-attribute-syntax-encoders
167 nil ; 2 Access Point Y
168 nil ; 3 Attribute Type Description Y
172 ldap-encode-boolean ; 7 Boolean Y
173 nil ; 8 Certificate N
174 nil ; 9 Certificate List N
175 nil ; 10 Certificate Pair N
176 ldap-encode-country-string ; 11 Country String Y
177 ldap-encode-string ; 12 DN Y
178 nil ; 13 Data Quality Syntax Y
179 nil ; 14 Delivery Method Y
180 ldap-encode-string ; 15 Directory String Y
181 nil ; 16 DIT Content Rule Description Y
182 nil ; 17 DIT Structure Rule Description Y
183 nil ; 18 DL Submit Permission Y
184 nil ; 19 DSA Quality Syntax Y
186 nil ; 21 Enhanced Guide Y
187 nil ; 22 Facsimile Telephone Number Y
189 nil ; 24 Generalized Time Y
191 nil ; 26 IA5 String Y
192 number-to-string ; 27 INTEGER Y
194 nil ; 29 Master And Shadow Access Points Y
195 nil ; 30 Matching Rule Description Y
196 nil ; 31 Matching Rule Use Description Y
197 nil ; 32 Mail Preference Y
198 nil ; 33 MHS OR Address Y
199 nil ; 34 Name And Optional UID Y
200 nil ; 35 Name Form Description Y
201 nil ; 36 Numeric String Y
202 nil ; 37 Object Class Description Y
204 nil ; 39 Other Mailbox Y
205 nil ; 40 Octet String Y
206 ldap-encode-address ; 41 Postal Address Y
207 nil ; 42 Protocol Information Y
208 nil ; 43 Presentation Address Y
209 ldap-encode-string ; 44 Printable String Y
210 nil ; 45 Subtree Specification Y
211 nil ; 46 Supplier Information Y
212 nil ; 47 Supplier Or Consumer Y
213 nil ; 48 Supplier And Consumer Y
214 nil ; 49 Supported Algorithm N
215 nil ; 50 Telephone Number Y
216 nil ; 51 Teletex Terminal Identifier Y
217 nil ; 52 Telex Number Y
219 nil ; 54 LDAP Syntax Description Y
220 nil ; 55 Modify Rights Y
221 nil ; 56 LDAP Schema Definition Y
222 nil ; 57 LDAP Schema Description Y
223 nil ; 58 Substring Assertion Y
225 "A vector of functions used to encode LDAP attribute values.
226 The sequence of functions corresponds to the sequence of LDAP attribute syntax
227 object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in
228 RFC2252 section 4.3.2")
230 (defvar ldap-attribute-syntax-decoders
232 nil ; 2 Access Point Y
233 nil ; 3 Attribute Type Description Y
237 ldap-decode-boolean ; 7 Boolean Y
238 nil ; 8 Certificate N
239 nil ; 9 Certificate List N
240 nil ; 10 Certificate Pair N
241 ldap-decode-string ; 11 Country String Y
242 ldap-decode-string ; 12 DN Y
243 nil ; 13 Data Quality Syntax Y
244 nil ; 14 Delivery Method Y
245 ldap-decode-string ; 15 Directory String Y
246 nil ; 16 DIT Content Rule Description Y
247 nil ; 17 DIT Structure Rule Description Y
248 nil ; 18 DL Submit Permission Y
249 nil ; 19 DSA Quality Syntax Y
251 nil ; 21 Enhanced Guide Y
252 nil ; 22 Facsimile Telephone Number Y
254 nil ; 24 Generalized Time Y
256 nil ; 26 IA5 String Y
257 string-to-number ; 27 INTEGER Y
259 nil ; 29 Master And Shadow Access Points Y
260 nil ; 30 Matching Rule Description Y
261 nil ; 31 Matching Rule Use Description Y
262 nil ; 32 Mail Preference Y
263 nil ; 33 MHS OR Address Y
264 nil ; 34 Name And Optional UID Y
265 nil ; 35 Name Form Description Y
266 nil ; 36 Numeric String Y
267 nil ; 37 Object Class Description Y
269 nil ; 39 Other Mailbox Y
270 nil ; 40 Octet String Y
271 ldap-decode-address ; 41 Postal Address Y
272 nil ; 42 Protocol Information Y
273 nil ; 43 Presentation Address Y
274 ldap-decode-string ; 44 Printable String Y
275 nil ; 45 Subtree Specification Y
276 nil ; 46 Supplier Information Y
277 nil ; 47 Supplier Or Consumer Y
278 nil ; 48 Supplier And Consumer Y
279 nil ; 49 Supported Algorithm N
280 nil ; 50 Telephone Number Y
281 nil ; 51 Teletex Terminal Identifier Y
282 nil ; 52 Telex Number Y
284 nil ; 54 LDAP Syntax Description Y
285 nil ; 55 Modify Rights Y
286 nil ; 56 LDAP Schema Definition Y
287 nil ; 57 LDAP Schema Description Y
288 nil ; 58 Substring Assertion Y
290 "A vector of functions used to decode LDAP attribute values.
291 The sequence of functions corresponds to the sequence of LDAP attribute syntax
292 object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in
293 RFC2252 section 4.3.2")
296 (defvar ldap-attribute-syntaxes-alist
297 '((createtimestamp . 24)
298 (modifytimestamp . 24)
301 (subschemasubentry . 12)
305 (matchingruleuse . 31)
306 (namingcontexts . 12)
308 (supportedextension . 38)
309 (supportedcontrol . 38)
310 (supportedsaslmechanisms . 15)
311 (supportedldapversion . 27)
313 (ditstructurerules . 17)
315 (ditcontentrules . 16)
317 (aliasedobjectname . 12)
330 (businesscategory . 15)
334 (physicaldeliveryofficename . 15)
335 (telephonenumber . 50)
337 (telexterminalidentifier . 51)
338 (facsimiletelephonenumber . 22)
340 (internationalisdnnumber . 36)
341 (registeredaddress . 41)
342 (destinationindicator . 44)
343 (preferreddeliverymethod . 14)
344 (presentationaddress . 43)
345 (supportedapplicationcontext . 38)
351 (usercertificate . 8)
353 (authorityrevocationlist . 9)
354 (certificaterevocationlist . 9)
355 (crosscertificatepair . 10)
359 (generationqualifier . 15)
360 (x500uniqueidentifier . 6)
362 (enhancedsearchguide . 21)
363 (protocolinformation . 42)
364 (distinguishedname . 12)
366 (houseidentifier . 15)
367 (supportedalgorithms . 49)
368 (deltarevocationlist . 9)
370 "A map of LDAP attribute names to their type object id minor number.
371 This table is built from RFC2252 Section 5 and RFC2256 Section 5")
374 ;; Coding/decoding functions
376 (defun ldap-encode-boolean (bool)
381 (defun ldap-decode-boolean (str)
383 ((string-equal str "TRUE")
385 ((string-equal str "FALSE")
388 (error "Wrong LDAP boolean string: %s" str))))
390 (defun ldap-encode-country-string (str)
391 ;; We should do something useful here...
392 (if (not (= 2 (length str)))
393 (error "Invalid country string: %s" str)))
395 (defun ldap-decode-string (str)
396 (if (fboundp 'decode-coding-string)
397 (decode-coding-string str ldap-coding-system)))
399 (defun ldap-encode-string (str)
400 (if (fboundp 'encode-coding-string)
401 (encode-coding-string str ldap-coding-system)))
403 (defun ldap-decode-address (str)
404 (mapconcat 'ldap-decode-string
405 (split-string str "\\$")
408 (defun ldap-encode-address (str)
409 (mapconcat 'ldap-encode-string
410 (split-string str "\n")
414 ;; LDAP protocol functions
416 (defun ldap-get-host-parameter (host parameter)
417 "Get the value of PARAMETER for HOST in `ldap-host-parameters-alist'."
418 (plist-get (cdr (assoc host ldap-host-parameters-alist))
421 (defun ldap-decode-attribute (attr)
422 "Decode the attribute/value pair ATTR according to LDAP rules.
423 The attribute name is looked up in `ldap-attribute-syntaxes-alist'
424 and the corresponding decoder is then retrieved from
425 `ldap-attribute-syntax-decoders' and applied on the value(s)."
426 (let* ((name (car attr))
428 (syntax-id (cdr (assq (intern (downcase name))
429 ldap-attribute-syntaxes-alist)))
432 (setq decoder (aref ldap-attribute-syntax-decoders
434 (setq decoder ldap-default-attribute-decoder))
436 (cons name (mapcar decoder values))
440 (defun ldap-search (filter &optional host attributes attrsonly withdn)
441 "Perform an LDAP search.
442 FILTER is the search filter in RFC1558 syntax, i.e., something that
443 looks like \"(cn=John Smith)\".
444 HOST is the LDAP host on which to perform the search.
445 ATTRIBUTES is a list of attributes to retrieve; nil means retrieve all.
446 If ATTRSONLY is non nil, the attributes will be retrieved without
447 the associated values.
448 If WITHDN is non-nil each entry in the result will be prepennded with
449 its distinguished name DN.
450 Additional search parameters can be specified through
451 `ldap-host-parameters-alist' which see.
452 The function returns a list of matching entries. Each entry is itself
453 an alist of attribute/value pairs optionally preceded by the DN of the
454 entry according to the value of WITHDN."
455 (interactive "sFilter:")
457 (setq host ldap-default-host)
458 (error "No LDAP host specified"))
459 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
462 (message "Opening LDAP connection to %s..." host)
463 (setq ldap (ldap-open host host-plist))
464 (message "Searching with LDAP on %s..." host)
465 (setq result (ldap-search-internal ldap filter
466 (plist-get host-plist 'base)
467 (plist-get host-plist 'scope)
468 attributes attrsonly withdn))
470 (if ldap-ignore-attribute-codings
474 (mapcar 'ldap-decode-attribute record)))
479 ;;; ldap.el ends here