Mercurial > hg > xemacs-beta

comparison lisp/ldap.el @ 398:74fd4e045ea6 r21-2-29

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents aabb7f5b1c81
children a86b2b5e0111
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
3 ;; Copyright (C) 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
4 4
5 ;; Author: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> 5 ;; Author: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
6 ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> 6 ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
7 ;; Created: Jan 1998 7 ;; Created: Jan 1998
8 ;; Version: $Revision: 1.7.2.3 $ 8 ;; Version: $Revision: 1.7.2.6 $
9 ;; Keywords: help comm 9 ;; Keywords: help comm
10 10
11 ;; This file is part of XEmacs 11 ;; This file is part of XEmacs
12 12
13 ;; XEmacs is free software; you can redistribute it and/or modify it 13 ;; XEmacs is free software; you can redistribute it and/or modify it
38 (defgroup ldap nil 38 (defgroup ldap nil
39 "Lightweight Directory Access Protocol" 39 "Lightweight Directory Access Protocol"
40 :group 'comm) 40 :group 'comm)
41 41
42 (defcustom ldap-default-host nil 42 (defcustom ldap-default-host nil
43 "*Default LDAP server." 43 "*Default LDAP server hostname.
44 A TCP port number can be appended to that name using a colon as
45 a separator."
44 :type '(choice (string :tag "Host name") 46 :type '(choice (string :tag "Host name")
45 (const :tag "Use library default" nil)) 47 (const :tag "Use library default" nil))
46 :group 'ldap) 48 :group 'ldap)
47 49
48 (defcustom ldap-default-port nil 50 (defcustom ldap-default-port nil
64 66
65 (defcustom ldap-host-parameters-alist nil 67 (defcustom ldap-host-parameters-alist nil
66 "*Alist of host-specific options for LDAP transactions. 68 "*Alist of host-specific options for LDAP transactions.
67 The format of each list element is: 69 The format of each list element is:
68 \(HOST PROP1 VAL1 PROP2 VAL2 ...) 70 \(HOST PROP1 VAL1 PROP2 VAL2 ...)
69 HOST is the name of an LDAP server. PROPn and VALn are property/value 71 HOST is the hostname of an LDAP server (with an optional TCP port number
70 pairs describing parameters for the server. Valid properties include: 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:
71 `binddn' is the distinguished name of the user to bind as 75 `binddn' is the distinguished name of the user to bind as
72 (in RFC 1779 syntax). 76 (in RFC 1779 syntax).
73 `passwd' is the password to use for simple authentication. 77 `passwd' is the password to use for simple authentication.
74 `auth' is the authentication method to use. 78 `auth' is the authentication method to use.
75 Possible values are: `simple', `krbv41' and `krbv42'. 79 Possible values are: `simple', `krbv41' and `krbv42'.
85 :value nil 89 :value nil
86 (string :tag "Host name") 90 (string :tag "Host name")
87 (checklist :inline t 91 (checklist :inline t
88 :greedy t 92 :greedy t
89 (list 93 (list
94 :tag "Search Base"
95 :inline t
96 (const :tag "Search Base" base)
97 string)
98 (list
90 :tag "Binding DN" 99 :tag "Binding DN"
91 :inline t 100 :inline t
92 (const :tag "Binding DN" binddn) 101 (const :tag "Binding DN" binddn)
93 string) 102 string)
94 (list 103 (list
103 (choice 112 (choice
104 (const :menu-tag "None" :tag "None" nil) 113 (const :menu-tag "None" :tag "None" nil)
105 (const :menu-tag "Simple" :tag "Simple" simple) 114 (const :menu-tag "Simple" :tag "Simple" simple)
106 (const :menu-tag "Kerberos 4.1" :tag "Kerberos 4.1" krbv41) 115 (const :menu-tag "Kerberos 4.1" :tag "Kerberos 4.1" krbv41)
107 (const :menu-tag "Kerberos 4.2" :tag "Kerberos 4.2" krbv42))) 116 (const :menu-tag "Kerberos 4.2" :tag "Kerberos 4.2" krbv42)))
108 (list
109 :tag "Search Base"
110 :inline t
111 (const :tag "Search Base" base)
112 string)
113 (list 117 (list
114 :tag "Search Scope" 118 :tag "Search Scope"
115 :inline t 119 :inline t
116 (const :tag "Search Scope" scope) 120 (const :tag "Search Scope" scope)
117 (choice 121 (choice
139 :inline t 143 :inline t
140 (const :tag "Size Limit" sizelimit) 144 (const :tag "Size Limit" sizelimit)
141 (integer :tag "(number of records)"))))) 145 (integer :tag "(number of records)")))))
142 :group 'ldap) 146 :group 'ldap)
143 147
144 148 (defcustom ldap-ignore-attribute-codings nil
145 (defun ldap-search (filter &optional host attributes attrsonly) 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)
146 "Perform an LDAP search. 441 "Perform an LDAP search.
147 FILTER is the search filter in RFC1558 syntax, i.e. something that 442 FILTER is the search filter in RFC1558 syntax, i.e., something that
148 looks like \"(cn=John Smith)\". 443 looks like \"(cn=John Smith)\".
149 HOST is the LDAP host on which to perform the search. 444 HOST is the LDAP host on which to perform the search.
150 ATTRIBUTES is a list of attributes to retrieve; nil means retrieve all. 445 ATTRIBUTES is a list of attributes to retrieve; nil means retrieve all.
151 If ATTRSONLY is non nil, the attributes will be retrieved without 446 If ATTRSONLY is non nil, the attributes will be retrieved without
152 the associated values. 447 the associated values.
448 If WITHDN is non-nil each entry in the result will be prepennded with
449 its distinguished name DN.
153 Additional search parameters can be specified through 450 Additional search parameters can be specified through
154 `ldap-host-parameters-alist' which see." 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."
155 (interactive "sFilter:") 455 (interactive "sFilter:")
156 (or host 456 (or host
157 (setq host ldap-default-host)) 457 (setq host ldap-default-host)
158 (or host
159 (error "No LDAP host specified")) 458 (error "No LDAP host specified"))
160 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) 459 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
161 ldap) 460 ldap
461 result)
162 (message "Opening LDAP connection to %s..." host) 462 (message "Opening LDAP connection to %s..." host)
163 (setq ldap (ldap-open host host-plist)) 463 (setq ldap (ldap-open host host-plist))
164 (message "Searching with LDAP on %s..." host) 464 (message "Searching with LDAP on %s..." host)
165 (prog1 (ldap-search-internal ldap filter 465 (setq result (ldap-search-internal ldap filter
166 (plist-get host-plist 'base) 466 (plist-get host-plist 'base)
167 (plist-get host-plist 'scope) 467 (plist-get host-plist 'scope)
168 attributes attrsonly) 468 attributes attrsonly withdn))
169 (ldap-close ldap)))) 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))))
170 476
171 (provide 'ldap) 477 (provide 'ldap)
172 478
173 ;;; ldap.el ends here 479 ;;; ldap.el ends here