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.5 $
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 (if (featurep 'mule)
161 "*Coding system of LDAP string values.
162 LDAP v3 specifies the coding system of strings to be UTF-8.
163 Mule support is needed for this."
167 (defvar ldap-attribute-syntax-encoders
169 nil ; 2 Access Point Y
170 nil ; 3 Attribute Type Description Y
174 ldap-encode-boolean ; 7 Boolean Y
175 nil ; 8 Certificate N
176 nil ; 9 Certificate List N
177 nil ; 10 Certificate Pair N
178 ldap-encode-country-string ; 11 Country String Y
179 ldap-encode-string ; 12 DN Y
180 nil ; 13 Data Quality Syntax Y
181 nil ; 14 Delivery Method Y
182 ldap-encode-string ; 15 Directory String Y
183 nil ; 16 DIT Content Rule Description Y
184 nil ; 17 DIT Structure Rule Description Y
185 nil ; 18 DL Submit Permission Y
186 nil ; 19 DSA Quality Syntax Y
188 nil ; 21 Enhanced Guide Y
189 nil ; 22 Facsimile Telephone Number Y
191 nil ; 24 Generalized Time Y
193 nil ; 26 IA5 String Y
194 number-to-string ; 27 INTEGER Y
196 nil ; 29 Master And Shadow Access Points Y
197 nil ; 30 Matching Rule Description Y
198 nil ; 31 Matching Rule Use Description Y
199 nil ; 32 Mail Preference Y
200 nil ; 33 MHS OR Address Y
201 nil ; 34 Name And Optional UID Y
202 nil ; 35 Name Form Description Y
203 nil ; 36 Numeric String Y
204 nil ; 37 Object Class Description Y
206 nil ; 39 Other Mailbox Y
207 nil ; 40 Octet String Y
208 ldap-encode-address ; 41 Postal Address Y
209 nil ; 42 Protocol Information Y
210 nil ; 43 Presentation Address Y
211 ldap-encode-string ; 44 Printable String Y
212 nil ; 45 Subtree Specification Y
213 nil ; 46 Supplier Information Y
214 nil ; 47 Supplier Or Consumer Y
215 nil ; 48 Supplier And Consumer Y
216 nil ; 49 Supported Algorithm N
217 nil ; 50 Telephone Number Y
218 nil ; 51 Teletex Terminal Identifier Y
219 nil ; 52 Telex Number Y
221 nil ; 54 LDAP Syntax Description Y
222 nil ; 55 Modify Rights Y
223 nil ; 56 LDAP Schema Definition Y
224 nil ; 57 LDAP Schema Description Y
225 nil ; 58 Substring Assertion Y
227 "A vector of functions used to encode LDAP attribute values.
228 The sequence of functions corresponds to the sequence of LDAP attribute syntax
229 object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in
230 RFC2252 section 4.3.2")
232 (defvar ldap-attribute-syntax-decoders
234 nil ; 2 Access Point Y
235 nil ; 3 Attribute Type Description Y
239 ldap-decode-boolean ; 7 Boolean Y
240 nil ; 8 Certificate N
241 nil ; 9 Certificate List N
242 nil ; 10 Certificate Pair N
243 ldap-decode-string ; 11 Country String Y
244 ldap-decode-string ; 12 DN Y
245 nil ; 13 Data Quality Syntax Y
246 nil ; 14 Delivery Method Y
247 ldap-decode-string ; 15 Directory String Y
248 nil ; 16 DIT Content Rule Description Y
249 nil ; 17 DIT Structure Rule Description Y
250 nil ; 18 DL Submit Permission Y
251 nil ; 19 DSA Quality Syntax Y
253 nil ; 21 Enhanced Guide Y
254 nil ; 22 Facsimile Telephone Number Y
256 nil ; 24 Generalized Time Y
258 nil ; 26 IA5 String Y
259 string-to-number ; 27 INTEGER Y
261 nil ; 29 Master And Shadow Access Points Y
262 nil ; 30 Matching Rule Description Y
263 nil ; 31 Matching Rule Use Description Y
264 nil ; 32 Mail Preference Y
265 nil ; 33 MHS OR Address Y
266 nil ; 34 Name And Optional UID Y
267 nil ; 35 Name Form Description Y
268 nil ; 36 Numeric String Y
269 nil ; 37 Object Class Description Y
271 nil ; 39 Other Mailbox Y
272 nil ; 40 Octet String Y
273 ldap-decode-address ; 41 Postal Address Y
274 nil ; 42 Protocol Information Y
275 nil ; 43 Presentation Address Y
276 ldap-decode-string ; 44 Printable String Y
277 nil ; 45 Subtree Specification Y
278 nil ; 46 Supplier Information Y
279 nil ; 47 Supplier Or Consumer Y
280 nil ; 48 Supplier And Consumer Y
281 nil ; 49 Supported Algorithm N
282 nil ; 50 Telephone Number Y
283 nil ; 51 Teletex Terminal Identifier Y
284 nil ; 52 Telex Number Y
286 nil ; 54 LDAP Syntax Description Y
287 nil ; 55 Modify Rights Y
288 nil ; 56 LDAP Schema Definition Y
289 nil ; 57 LDAP Schema Description Y
290 nil ; 58 Substring Assertion Y
292 "A vector of functions used to decode LDAP attribute values.
293 The sequence of functions corresponds to the sequence of LDAP attribute syntax
294 object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in
295 RFC2252 section 4.3.2")
298 (defvar ldap-attribute-syntaxes-alist
299 '((createtimestamp . 24)
300 (modifytimestamp . 24)
303 (subschemasubentry . 12)
307 (matchingruleuse . 31)
308 (namingcontexts . 12)
310 (supportedextension . 38)
311 (supportedcontrol . 38)
312 (supportedsaslmechanisms . 15)
313 (supportedldapversion . 27)
315 (ditstructurerules . 17)
317 (ditcontentrules . 16)
319 (aliasedobjectname . 12)
332 (businesscategory . 15)
336 (physicaldeliveryofficename . 15)
337 (telephonenumber . 50)
339 (telexterminalidentifier . 51)
340 (facsimiletelephonenumber . 22)
342 (internationalisdnnumber . 36)
343 (registeredaddress . 41)
344 (destinationindicator . 44)
345 (preferreddeliverymethod . 14)
346 (presentationaddress . 43)
347 (supportedapplicationcontext . 38)
353 (usercertificate . 8)
355 (authorityrevocationlist . 9)
356 (certificaterevocationlist . 9)
357 (crosscertificatepair . 10)
361 (generationqualifier . 15)
362 (x500uniqueidentifier . 6)
364 (enhancedsearchguide . 21)
365 (protocolinformation . 42)
366 (distinguishedname . 12)
368 (houseidentifier . 15)
369 (supportedalgorithms . 49)
370 (deltarevocationlist . 9)
372 "A map of LDAP attribute names to their type object id minor number.
373 This table is built from RFC2252 Section 5 and RFC2256 Section 5")
376 ;; Coding/decoding functions
378 (defun ldap-encode-boolean (bool)
383 (defun ldap-decode-boolean (str)
385 ((string-equal str "TRUE")
387 ((string-equal str "FALSE")
390 (error "Wrong LDAP boolean string: %s" str))))
392 (defun ldap-encode-country-string (str)
393 ;; We should do something useful here...
394 (if (not (= 2 (length str)))
395 (error "Invalid country string: %s" str)))
397 (defun ldap-decode-string (str)
398 (decode-coding-string str ldap-coding-system))
400 (defun ldap-encode-string (str)
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