Mercurial > hg > xemacs-beta

comparison lisp/ldap.el @ 414:da8ed4261e83 r21-2-15

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-15
author cvs
date Mon, 13 Aug 2007 11:21:38 +0200
parents 697ef44129c6
children 11054d720c21
comparison
equal deleted inserted replaced
413:901169e5ca31 414:da8ed4261e83
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.4 $ 8 ;; Version: $Revision: 1.7.2.5 $
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
143 :inline t 143 :inline t
144 (const :tag "Size Limit" sizelimit) 144 (const :tag "Size Limit" sizelimit)
145 (integer :tag "(number of records)"))))) 145 (integer :tag "(number of records)")))))
146 :group 'ldap) 146 :group 'ldap)
147 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 (if (featurep 'mule)
159 'utf-8
160 nil)
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."
164 :type 'symbol
165 :group 'ldap)
166
167 (defvar ldap-attribute-syntax-encoders
168 [nil ; 1 ACI Item N
169 nil ; 2 Access Point Y
170 nil ; 3 Attribute Type Description Y
171 nil ; 4 Audio N
172 nil ; 5 Binary N
173 nil ; 6 Bit String 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
187 nil ; 20 DSE Type Y
188 nil ; 21 Enhanced Guide Y
189 nil ; 22 Facsimile Telephone Number Y
190 nil ; 23 Fax N
191 nil ; 24 Generalized Time Y
192 nil ; 25 Guide Y
193 nil ; 26 IA5 String Y
194 number-to-string ; 27 INTEGER Y
195 nil ; 28 JPEG N
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
205 nil ; 38 OID 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
220 nil ; 53 UTC Time 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
226 ]
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")
231
232 (defvar ldap-attribute-syntax-decoders
233 [nil ; 1 ACI Item N
234 nil ; 2 Access Point Y
235 nil ; 3 Attribute Type Description Y
236 nil ; 4 Audio N
237 nil ; 5 Binary N
238 nil ; 6 Bit String 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
252 nil ; 20 DSE Type Y
253 nil ; 21 Enhanced Guide Y
254 nil ; 22 Facsimile Telephone Number Y
255 nil ; 23 Fax N
256 nil ; 24 Generalized Time Y
257 nil ; 25 Guide Y
258 nil ; 26 IA5 String Y
259 string-to-number ; 27 INTEGER Y
260 nil ; 28 JPEG N
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
270 nil ; 38 OID 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
285 nil ; 53 UTC Time 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
291 ]
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")
296
297
298 (defvar ldap-attribute-syntaxes-alist
299 '((createtimestamp . 24)
300 (modifytimestamp . 24)
301 (creatorsname . 12)
302 (modifiersname . 12)
303 (subschemasubentry . 12)
304 (attributetypes . 3)
305 (objectclasses . 37)
306 (matchingrules . 30)
307 (matchingruleuse . 31)
308 (namingcontexts . 12)
309 (altserver . 26)
310 (supportedextension . 38)
311 (supportedcontrol . 38)
312 (supportedsaslmechanisms . 15)
313 (supportedldapversion . 27)
314 (ldapsyntaxes . 16)
315 (ditstructurerules . 17)
316 (nameforms . 35)
317 (ditcontentrules . 16)
318 (objectclass . 38)
319 (aliasedobjectname . 12)
320 (cn . 15)
321 (sn . 15)
322 (serialnumber . 44)
323 (c . 15)
324 (l . 15)
325 (st . 15)
326 (street . 15)
327 (o . 15)
328 (ou . 15)
329 (title . 15)
330 (description . 15)
331 (searchguide . 25)
332 (businesscategory . 15)
333 (postaladdress . 41)
334 (postalcode . 15)
335 (postofficebox . 15)
336 (physicaldeliveryofficename . 15)
337 (telephonenumber . 50)
338 (telexnumber . 52)
339 (telexterminalidentifier . 51)
340 (facsimiletelephonenumber . 22)
341 (x121address . 36)
342 (internationalisdnnumber . 36)
343 (registeredaddress . 41)
344 (destinationindicator . 44)
345 (preferreddeliverymethod . 14)
346 (presentationaddress . 43)
347 (supportedapplicationcontext . 38)
348 (member . 12)
349 (owner . 12)
350 (roleoccupant . 12)
351 (seealso . 12)
352 (userpassword . 40)
353 (usercertificate . 8)
354 (cacertificate . 8)
355 (authorityrevocationlist . 9)
356 (certificaterevocationlist . 9)
357 (crosscertificatepair . 10)
358 (name . 15)
359 (givenname . 15)
360 (initials . 15)
361 (generationqualifier . 15)
362 (x500uniqueidentifier . 6)
363 (dnqualifier . 44)
364 (enhancedsearchguide . 21)
365 (protocolinformation . 42)
366 (distinguishedname . 12)
367 (uniquemember . 34)
368 (houseidentifier . 15)
369 (supportedalgorithms . 49)
370 (deltarevocationlist . 9)
371 (dmdname . 15))
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")
374
375
376 ;; Coding/decoding functions
377
378 (defun ldap-encode-boolean (bool)
379 (if bool
380 "TRUE"
381 "FALSE"))
382
383 (defun ldap-decode-boolean (str)
384 (cond
385 ((string-equal str "TRUE")
386 t)
387 ((string-equal str "FALSE")
388 nil)
389 (t
390 (error "Wrong LDAP boolean string: %s" str))))
391
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)))
396
397 (defun ldap-decode-string (str)
398 (decode-coding-string str ldap-coding-system))
399
400 (defun ldap-encode-string (str)
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
148 (defun ldap-get-host-parameter (host parameter) 416 (defun ldap-get-host-parameter (host parameter)
149 "Get the value of PARAMETER for HOST in `ldap-host-parameters-alist'." 417 "Get the value of PARAMETER for HOST in `ldap-host-parameters-alist'."
150 (plist-get (cdr (assoc host ldap-host-parameters-alist)) 418 (plist-get (cdr (assoc host ldap-host-parameters-alist))
151 parameter)) 419 parameter))
152 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
153 (defun ldap-search (filter &optional host attributes attrsonly withdn) 440 (defun ldap-search (filter &optional host attributes attrsonly withdn)
154 "Perform an LDAP search. 441 "Perform an LDAP search.
155 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
156 looks like \"(cn=John Smith)\". 443 looks like \"(cn=John Smith)\".
157 HOST is the LDAP host on which to perform the search. 444 HOST is the LDAP host on which to perform the search.
158 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.
159 If ATTRSONLY is non nil, the attributes will be retrieved without 446 If ATTRSONLY is non nil, the attributes will be retrieved without
160 the associated values. 447 the associated values.
165 The function returns a list of matching entries. Each entry is itself 452 The function returns a list of matching entries. Each entry is itself
166 an alist of attribute/value pairs optionally preceded by the DN of the 453 an alist of attribute/value pairs optionally preceded by the DN of the
167 entry according to the value of WITHDN." 454 entry according to the value of WITHDN."
168 (interactive "sFilter:") 455 (interactive "sFilter:")
169 (or host 456 (or host
170 (setq host ldap-default-host)) 457 (setq host ldap-default-host)
171 (or host
172 (error "No LDAP host specified")) 458 (error "No LDAP host specified"))
173 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) 459 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
174 ldap) 460 ldap
461 result)
175 (message "Opening LDAP connection to %s..." host) 462 (message "Opening LDAP connection to %s..." host)
176 (setq ldap (ldap-open host host-plist)) 463 (setq ldap (ldap-open host host-plist))
177 (message "Searching with LDAP on %s..." host) 464 (message "Searching with LDAP on %s..." host)
178 (prog1 (ldap-search-internal ldap filter 465 (setq result (ldap-search-internal ldap filter
179 (plist-get host-plist 'base) 466 (plist-get host-plist 'base)
180 (plist-get host-plist 'scope) 467 (plist-get host-plist 'scope)
181 attributes attrsonly withdn) 468 attributes attrsonly withdn))
182 (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))))
183 476
184 (provide 'ldap) 477 (provide 'ldap)
185 478
186 ;;; ldap.el ends here 479 ;;; ldap.el ends here