Mercurial > hg > xemacs-beta

comparison lisp/ldap.el @ 428:3ecd8885ac67 r21-2-22

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-22
author cvs
date Mon, 13 Aug 2007 11:28:15 +0200
parents
children abe6d1db359e
comparison
equal deleted inserted replaced
427:0a0253eac470 428:3ecd8885ac67
1 ;;; ldap.el --- LDAP support for Emacs
2
3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
4
5 ;; Author: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
6 ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
7 ;; Created: Jan 1998
8 ;; Version: $Revision: 1.7.2.6 $
9 ;; Keywords: help comm
10
11 ;; This file is part of XEmacs
12
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)
16 ;; any later version.
17
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.
22
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.
27
28 ;;; Commentary:
29 ;; This file provides mid-level and user-level functions to access directory
30 ;; servers using the LDAP protocol (RFC 1777).
31
32 ;;; Installation:
33 ;; LDAP support must have been built into XEmacs.
34
35
36 ;;; Code:
37
38 (defgroup ldap nil
39 "Lightweight Directory Access Protocol"
40 :group 'comm)
41
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
45 a separator."
46 :type '(choice (string :tag "Host name")
47 (const :tag "Use library default" nil))
48 :group 'ldap)
49
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"))
55 :group 'ldap)
56
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"))
64 :group 'ldap)
65
66
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
76 (in RFC 1779 syntax).
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"
89 :value nil
90 (string :tag "Host name")
91 (checklist :inline t
92 :greedy t
93 (list
94 :tag "Search Base"
95 :inline t
96 (const :tag "Search Base" base)
97 string)
98 (list
99 :tag "Binding DN"
100 :inline t
101 (const :tag "Binding DN" binddn)
102 string)
103 (list
104 :tag "Password"
105 :inline t
106 (const :tag "Password" passwd)
107 string)
108 (list
109 :tag "Authentication Method"
110 :inline t
111 (const :tag "Authentication Method" auth)
112 (choice
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)))
117 (list
118 :tag "Search Scope"
119 :inline t
120 (const :tag "Search Scope" scope)
121 (choice
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)))
126 (list
127 :tag "Dereferencing"
128 :inline t
129 (const :tag "Dereferencing" deref)
130 (choice
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)))
136 (list
137 :tag "Time Limit"
138 :inline t
139 (const :tag "Time Limit" timelimit)
140 (integer :tag "(in seconds)"))
141 (list
142 :tag "Size Limit"
143 :inline t
144 (const :tag "Size Limit" sizelimit)
145 (integer :tag "(number of records)")))))
146 :group 'ldap)
147
148 (defcustom ldap-ignore-attribute-codings nil
149 "*If non-nil, do not perform any encoding/decoding on LDAP attribute values."
150 :type 'boolean
151 :group 'ldap)
152
153 (defcustom ldap-default-attribute-decoder nil
154 "*Decoder function to use for attributes whose syntax is unknown."
155 :type 'symbol
156 :group 'ldap)
157
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."
162 :type 'symbol
163 :group 'ldap)
164
165 (defvar ldap-attribute-syntax-encoders
166 [nil ; 1 ACI Item N
167 nil ; 2 Access Point Y
168 nil ; 3 Attribute Type Description Y
169 nil ; 4 Audio N
170 nil ; 5 Binary N
171 nil ; 6 Bit String 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
185 nil ; 20 DSE Type Y
186 nil ; 21 Enhanced Guide Y
187 nil ; 22 Facsimile Telephone Number Y
188 nil ; 23 Fax N
189 nil ; 24 Generalized Time Y
190 nil ; 25 Guide Y
191 nil ; 26 IA5 String Y
192 number-to-string ; 27 INTEGER Y
193 nil ; 28 JPEG N
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
203 nil ; 38 OID 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
218 nil ; 53 UTC Time 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
224 ]
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")
229
230 (defvar ldap-attribute-syntax-decoders
231 [nil ; 1 ACI Item N
232 nil ; 2 Access Point Y
233 nil ; 3 Attribute Type Description Y
234 nil ; 4 Audio N
235 nil ; 5 Binary N
236 nil ; 6 Bit String 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
250 nil ; 20 DSE Type Y
251 nil ; 21 Enhanced Guide Y
252 nil ; 22 Facsimile Telephone Number Y
253 nil ; 23 Fax N
254 nil ; 24 Generalized Time Y
255 nil ; 25 Guide Y
256 nil ; 26 IA5 String Y
257 string-to-number ; 27 INTEGER Y
258 nil ; 28 JPEG N
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
268 nil ; 38 OID 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
283 nil ; 53 UTC Time 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
289 ]
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")
294
295
296 (defvar ldap-attribute-syntaxes-alist
297 '((createtimestamp . 24)
298 (modifytimestamp . 24)
299 (creatorsname . 12)
300 (modifiersname . 12)
301 (subschemasubentry . 12)
302 (attributetypes . 3)
303 (objectclasses . 37)
304 (matchingrules . 30)
305 (matchingruleuse . 31)
306 (namingcontexts . 12)
307 (altserver . 26)
308 (supportedextension . 38)
309 (supportedcontrol . 38)
310 (supportedsaslmechanisms . 15)
311 (supportedldapversion . 27)
312 (ldapsyntaxes . 16)
313 (ditstructurerules . 17)
314 (nameforms . 35)
315 (ditcontentrules . 16)
316 (objectclass . 38)
317 (aliasedobjectname . 12)
318 (cn . 15)
319 (sn . 15)
320 (serialnumber . 44)
321 (c . 15)
322 (l . 15)
323 (st . 15)
324 (street . 15)
325 (o . 15)
326 (ou . 15)
327 (title . 15)
328 (description . 15)
329 (searchguide . 25)
330 (businesscategory . 15)
331 (postaladdress . 41)
332 (postalcode . 15)
333 (postofficebox . 15)
334 (physicaldeliveryofficename . 15)
335 (telephonenumber . 50)
336 (telexnumber . 52)
337 (telexterminalidentifier . 51)
338 (facsimiletelephonenumber . 22)
339 (x121address . 36)
340 (internationalisdnnumber . 36)
341 (registeredaddress . 41)
342 (destinationindicator . 44)
343 (preferreddeliverymethod . 14)
344 (presentationaddress . 43)
345 (supportedapplicationcontext . 38)
346 (member . 12)
347 (owner . 12)
348 (roleoccupant . 12)
349 (seealso . 12)
350 (userpassword . 40)
351 (usercertificate . 8)
352 (cacertificate . 8)
353 (authorityrevocationlist . 9)
354 (certificaterevocationlist . 9)
355 (crosscertificatepair . 10)
356 (name . 15)
357 (givenname . 15)
358 (initials . 15)
359 (generationqualifier . 15)
360 (x500uniqueidentifier . 6)
361 (dnqualifier . 44)
362 (enhancedsearchguide . 21)
363 (protocolinformation . 42)
364 (distinguishedname . 12)
365 (uniquemember . 34)
366 (houseidentifier . 15)
367 (supportedalgorithms . 49)
368 (deltarevocationlist . 9)
369 (dmdname . 15))
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")
372
373
374 ;; Coding/decoding functions
375
376 (defun ldap-encode-boolean (bool)
377 (if bool
378 "TRUE"
379 "FALSE"))
380
381 (defun ldap-decode-boolean (str)
382 (cond
383 ((string-equal str "TRUE")
384 t)
385 ((string-equal str "FALSE")
386 nil)
387 (t
388 (error "Wrong LDAP boolean string: %s" str))))
389
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)))
394
395 (defun ldap-decode-string (str)
396 (if (fboundp 'decode-coding-string)
397 (decode-coding-string str ldap-coding-system)))
398
399 (defun ldap-encode-string (str)
400 (if (fboundp 'encode-coding-string)
401 (encode-coding-string str ldap-coding-system)))
402
403 (defun ldap-decode-address (str)
404 (mapconcat 'ldap-decode-string
405 (split-string str "\\$")
406 "\n"))
407
408 (defun ldap-encode-address (str)
409 (mapconcat 'ldap-encode-string
410 (split-string str "\n")
411 "$"))
412
413
414 ;; LDAP protocol functions
415
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))
419 parameter))
420
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))
427 (values (cdr attr))
428 (syntax-id (cdr (assq (intern (downcase name))
429 ldap-attribute-syntaxes-alist)))
430 decoder)
431 (if syntax-id
432 (setq decoder (aref ldap-attribute-syntax-decoders
433 (1- syntax-id)))
434 (setq decoder ldap-default-attribute-decoder))
435 (if decoder
436 (cons name (mapcar decoder values))
437 attr)))
438
439
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:")
456 (or host
457 (setq host ldap-default-host)
458 (error "No LDAP host specified"))
459 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
460 ldap
461 result)
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))
469 (ldap-close ldap)
470 (if ldap-ignore-attribute-codings
471 result
472 (mapcar (function
473 (lambda (record)
474 (mapcar 'ldap-decode-attribute record)))
475 result))))
476
477 (provide 'ldap)
478
479 ;;; ldap.el ends here