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.10 $
11 ;; This file is part of SXEmacs
13 ;; SXEmacs is free software: you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
18 ;; SXEmacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
27 ;; This file provides mid-level and user-level functions to access directory
28 ;; servers using the LDAP protocol (RFC 1777).
31 ;; LDAP support must have been built into XEmacs.
36 (globally-declare-fboundp '(ldapp ldap-open ldap-close ldap-add ldap-modify
40 (if (not (fboundp 'ldap-open))
41 (error "No LDAP support compiled in this XEmacs")))
44 "Lightweight Directory Access Protocol"
47 (defcustom ldap-default-host nil
48 "*Default LDAP server hostname.
49 A TCP port number can be appended to that name using a colon as
51 :type '(choice (string :tag "Host name")
52 (const :tag "Use library default" nil))
55 (defcustom ldap-default-port nil
56 "*Default TCP port for LDAP connections.
57 Initialized from the LDAP library at build time. Default value is 389."
58 :type '(choice (const :tag "Use library default" nil)
59 (integer :tag "Port number"))
62 (defcustom ldap-default-base nil
63 "*Default base for LDAP searches.
64 This is a string using the syntax of RFC 1779.
65 For instance, \"o=ACME, c=US\" limits the search to the
66 Acme organization in the United States."
67 :type '(choice (const :tag "Use library default" nil)
68 (string :tag "Search base"))
72 (defcustom ldap-host-parameters-alist nil
73 "*Alist of host-specific options for LDAP transactions.
74 The format of each list element is:
75 \(HOST PROP1 VAL1 PROP2 VAL2 ...)
76 HOST is the hostname of an LDAP server (with an optional TCP port number
77 appended to it using a colon as a separator).
78 PROPn and VALn are property/value pairs describing parameters for the server.
79 Valid properties include:
80 `binddn' is the distinguished name of the user to bind as
82 `passwd' is the password to use for simple authentication.
83 `auth' is the authentication method to use.
84 Possible values are: `simple', `krbv41' and `krbv42'.
85 `base' is the base for the search as described in RFC 1779.
86 `scope' is one of the three symbols `subtree', `base' or `onelevel'.
87 `deref' is one of the symbols `never', `always', `search' or `find'.
88 `timelimit' is the timeout limit for the connection in seconds.
89 `sizelimit' is the maximum number of matches to return."
90 :type '(repeat :menu-tag "Host parameters"
91 :tag "Host parameters"
92 (list :menu-tag "Host parameters"
93 :tag "Host parameters"
95 (string :tag "Host name")
101 (const :tag "Search Base" base)
106 (const :tag "Binding DN" binddn)
111 (const :tag "Password" passwd)
114 :tag "Authentication Method"
116 (const :tag "Authentication Method" auth)
118 (const :menu-tag "None" :tag "None" nil)
119 (const :menu-tag "Simple" :tag "Simple" simple)
120 (const :menu-tag "Kerberos 4.1" :tag "Kerberos 4.1" krbv41)
121 (const :menu-tag "Kerberos 4.2" :tag "Kerberos 4.2" krbv42)))
125 (const :tag "Search Scope" scope)
127 (const :menu-tag "Default" :tag "Default" nil)
128 (const :menu-tag "Subtree" :tag "Subtree" subtree)
129 (const :menu-tag "Base" :tag "Base" base)
130 (const :menu-tag "One Level" :tag "One Level" onelevel)))
134 (const :tag "Dereferencing" deref)
136 (const :menu-tag "Default" :tag "Default" nil)
137 (const :menu-tag "Never" :tag "Never" never)
138 (const :menu-tag "Always" :tag "Always" always)
139 (const :menu-tag "When searching" :tag "When searching" search)
140 (const :menu-tag "When locating base" :tag "When locating base" find)))
144 (const :tag "Time Limit" timelimit)
145 (integer :tag "(in seconds)"))
149 (const :tag "Size Limit" sizelimit)
150 (integer :tag "(number of records)")))))
153 (defcustom ldap-verbose nil
154 "*If non-nil, LDAP operations echo progress messages."
158 (defcustom ldap-ignore-attribute-codings nil
159 "*If non-nil, do not perform any encoding/decoding on LDAP attribute values."
163 (defcustom ldap-default-attribute-decoder nil
164 "*Decoder function to use for attributes whose syntax is unknown."
168 (defcustom ldap-coding-system nil
169 "*Coding system of LDAP string values.
170 LDAP v3 specifies the coding system of strings to be UTF-8.
171 Mule support is needed for this."
175 (defvar ldap-attribute-syntax-encoders
177 nil ; 2 Access Point Y
178 nil ; 3 Attribute Type Description Y
182 ldap-encode-boolean ; 7 Boolean Y
183 nil ; 8 Certificate N
184 nil ; 9 Certificate List N
185 nil ; 10 Certificate Pair N
186 ldap-encode-country-string ; 11 Country String Y
187 ldap-encode-string ; 12 DN Y
188 nil ; 13 Data Quality Syntax Y
189 nil ; 14 Delivery Method Y
190 ldap-encode-string ; 15 Directory String Y
191 nil ; 16 DIT Content Rule Description Y
192 nil ; 17 DIT Structure Rule Description Y
193 nil ; 18 DL Submit Permission Y
194 nil ; 19 DSA Quality Syntax Y
196 nil ; 21 Enhanced Guide Y
197 nil ; 22 Facsimile Telephone Number Y
199 nil ; 24 Generalized Time Y
201 nil ; 26 IA5 String Y
202 number-to-string ; 27 INTEGER Y
204 nil ; 29 Master And Shadow Access Points Y
205 nil ; 30 Matching Rule Description Y
206 nil ; 31 Matching Rule Use Description Y
207 nil ; 32 Mail Preference Y
208 nil ; 33 MHS OR Address Y
209 nil ; 34 Name And Optional UID Y
210 nil ; 35 Name Form Description Y
211 nil ; 36 Numeric String Y
212 nil ; 37 Object Class Description Y
214 nil ; 39 Other Mailbox Y
215 nil ; 40 Octet String Y
216 ldap-encode-address ; 41 Postal Address Y
217 nil ; 42 Protocol Information Y
218 nil ; 43 Presentation Address Y
219 ldap-encode-string ; 44 Printable String Y
220 nil ; 45 Subtree Specification Y
221 nil ; 46 Supplier Information Y
222 nil ; 47 Supplier Or Consumer Y
223 nil ; 48 Supplier And Consumer Y
224 nil ; 49 Supported Algorithm N
225 nil ; 50 Telephone Number Y
226 nil ; 51 Teletex Terminal Identifier Y
227 nil ; 52 Telex Number Y
229 nil ; 54 LDAP Syntax Description Y
230 nil ; 55 Modify Rights Y
231 nil ; 56 LDAP Schema Definition Y
232 nil ; 57 LDAP Schema Description Y
233 nil ; 58 Substring Assertion Y
235 "A vector of functions used to encode LDAP attribute values.
236 The sequence of functions corresponds to the sequence of LDAP attribute syntax
237 object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in
238 RFC2252 section 4.3.2")
240 (defvar ldap-attribute-syntax-decoders
242 nil ; 2 Access Point Y
243 nil ; 3 Attribute Type Description Y
247 ldap-decode-boolean ; 7 Boolean Y
248 nil ; 8 Certificate N
249 nil ; 9 Certificate List N
250 nil ; 10 Certificate Pair N
251 ldap-decode-string ; 11 Country String Y
252 ldap-decode-string ; 12 DN Y
253 nil ; 13 Data Quality Syntax Y
254 nil ; 14 Delivery Method Y
255 ldap-decode-string ; 15 Directory String Y
256 nil ; 16 DIT Content Rule Description Y
257 nil ; 17 DIT Structure Rule Description Y
258 nil ; 18 DL Submit Permission Y
259 nil ; 19 DSA Quality Syntax Y
261 nil ; 21 Enhanced Guide Y
262 nil ; 22 Facsimile Telephone Number Y
264 nil ; 24 Generalized Time Y
266 nil ; 26 IA5 String Y
267 string-to-number ; 27 INTEGER Y
269 nil ; 29 Master And Shadow Access Points Y
270 nil ; 30 Matching Rule Description Y
271 nil ; 31 Matching Rule Use Description Y
272 nil ; 32 Mail Preference Y
273 nil ; 33 MHS OR Address Y
274 nil ; 34 Name And Optional UID Y
275 nil ; 35 Name Form Description Y
276 nil ; 36 Numeric String Y
277 nil ; 37 Object Class Description Y
279 nil ; 39 Other Mailbox Y
280 nil ; 40 Octet String Y
281 ldap-decode-address ; 41 Postal Address Y
282 nil ; 42 Protocol Information Y
283 nil ; 43 Presentation Address Y
284 ldap-decode-string ; 44 Printable String Y
285 nil ; 45 Subtree Specification Y
286 nil ; 46 Supplier Information Y
287 nil ; 47 Supplier Or Consumer Y
288 nil ; 48 Supplier And Consumer Y
289 nil ; 49 Supported Algorithm N
290 nil ; 50 Telephone Number Y
291 nil ; 51 Teletex Terminal Identifier Y
292 nil ; 52 Telex Number Y
294 nil ; 54 LDAP Syntax Description Y
295 nil ; 55 Modify Rights Y
296 nil ; 56 LDAP Schema Definition Y
297 nil ; 57 LDAP Schema Description Y
298 nil ; 58 Substring Assertion Y
300 "A vector of functions used to decode LDAP attribute values.
301 The sequence of functions corresponds to the sequence of LDAP attribute syntax
302 object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in
303 RFC2252 section 4.3.2")
306 (defvar ldap-attribute-syntaxes-alist
307 '((createtimestamp . 24)
308 (modifytimestamp . 24)
311 (subschemasubentry . 12)
315 (matchingruleuse . 31)
316 (namingcontexts . 12)
318 (supportedextension . 38)
319 (supportedcontrol . 38)
320 (supportedsaslmechanisms . 15)
321 (supportedldapversion . 27)
323 (ditstructurerules . 17)
325 (ditcontentrules . 16)
327 (aliasedobjectname . 12)
340 (businesscategory . 15)
344 (physicaldeliveryofficename . 15)
345 (telephonenumber . 50)
347 (telexterminalidentifier . 51)
348 (facsimiletelephonenumber . 22)
350 (internationalisdnnumber . 36)
351 (registeredaddress . 41)
352 (destinationindicator . 44)
353 (preferreddeliverymethod . 14)
354 (presentationaddress . 43)
355 (supportedapplicationcontext . 38)
361 (usercertificate . 8)
363 (authorityrevocationlist . 9)
364 (certificaterevocationlist . 9)
365 (crosscertificatepair . 10)
369 (generationqualifier . 15)
370 (x500uniqueidentifier . 6)
372 (enhancedsearchguide . 21)
373 (protocolinformation . 42)
374 (distinguishedname . 12)
376 (houseidentifier . 15)
377 (supportedalgorithms . 49)
378 (deltarevocationlist . 9)
380 "A map of LDAP attribute names to their type object id minor number.
381 This table is built from RFC2252 Section 5 and RFC2256 Section 5")
384 ;; Coding/decoding functions
386 (defun ldap-encode-boolean (bool)
391 (defun ldap-decode-boolean (str)
393 ((string-equal str "TRUE")
395 ((string-equal str "FALSE")
398 (error "Wrong LDAP boolean string: %s" str))))
400 (defun ldap-encode-country-string (str)
401 ;; We should do something useful here...
402 (if (not (= 2 (length str)))
403 (error "Invalid country string: %s" str)))
405 (defun ldap-decode-string (str)
406 (if (fboundp 'decode-coding-string)
407 (decode-coding-string str ldap-coding-system)))
409 (defun ldap-encode-string (str)
410 (if (fboundp 'encode-coding-string)
411 (encode-coding-string str ldap-coding-system)))
413 (defun ldap-decode-address (str)
414 (mapconcat 'ldap-decode-string
415 (split-string str "\\$")
418 (defun ldap-encode-address (str)
419 (mapconcat 'ldap-encode-string
420 (split-string str "\n")
424 ;; LDAP protocol functions
426 (defun ldap-get-host-parameter (host parameter)
427 "Get the value of PARAMETER for HOST in `ldap-host-parameters-alist'."
428 (plist-get (cdr (assoc host ldap-host-parameters-alist))
431 (defun ldap-decode-attribute (attr)
432 "Decode the attribute/value pair ATTR according to LDAP rules.
433 The attribute name is looked up in `ldap-attribute-syntaxes-alist'
434 and the corresponding decoder is then retrieved from
435 `ldap-attribute-syntax-decoders' and applied on the value(s)."
436 (let* ((name (car attr))
438 (syntax-id (cdr (assq (intern (downcase name))
439 ldap-attribute-syntaxes-alist)))
442 (setq decoder (aref ldap-attribute-syntax-decoders
444 (setq decoder ldap-default-attribute-decoder))
446 (cons name (mapcar decoder values))
449 (defun ldap-decode-entry (entry)
450 "Decode the attributes of ENTRY according to LDAP rules."
452 (setq dn (car entry))
454 (setq entry (cdr entry))
456 (setq decoded (mapcar 'ldap-decode-attribute entry))
461 (defun ldap-search (arg1 &rest args)
462 "Perform an LDAP search."
463 (apply (if (ldapp arg1)
465 'ldap-search-entries) arg1 args))
467 (make-obsolete 'ldap-search
468 "Use `ldap-search-entries' instead or
469 `ldap-search-basic' for the low-level search API.")
471 (defun ldap-search-entries (filter &optional host attributes attrsonly withdn)
472 "Perform an LDAP search.
473 FILTER is the search filter in RFC1558 syntax, i.e., something that
474 looks like \"(cn=John Smith)\".
475 HOST is the LDAP host on which to perform the search.
476 ATTRIBUTES is a list of attributes to retrieve; nil means retrieve all.
477 If ATTRSONLY is non nil, the attributes will be retrieved without
478 the associated values.
479 If WITHDN is non-nil each entry in the result will be prepennded with
480 its distinguished name DN.
481 Additional search parameters can be specified through
482 `ldap-host-parameters-alist' which see.
483 The function returns a list of matching entries. Each entry is itself
484 an alist of attribute/value pairs optionally preceded by the DN of the
485 entry according to the value of WITHDN."
486 (interactive "sFilter:")
488 (setq host ldap-default-host)
489 (error "No LDAP host specified"))
490 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
494 (message "Opening LDAP connection to %s..." host))
495 (setq ldap (ldap-open host host-plist))
497 (message "Searching with LDAP on %s..." host))
498 (setq result (with-obsolete-function 'ldap-search ldap filter
499 (plist-get host-plist 'base)
500 (plist-get host-plist 'scope)
501 attributes attrsonly withdn
504 (if ldap-ignore-attribute-codings
506 (mapcar 'ldap-decode-entry result))))
508 (defun ldap-add-entries (entries &optional host binddn passwd)
509 "Add entries to an LDAP directory.
510 ENTRIES is a list of entry specifications of
511 the form (DN (ATTR . VALUE) (ATTR . VALUE) ...) where
512 DN is the distinguished name of an entry to add, the following
513 are cons cells containing attribute/value string pairs.
514 HOST is the LDAP host, defaulting to `ldap-default-host'.
515 BINDDN is the DN to bind as to the server.
516 PASSWD is the corresponding password."
518 (setq host ldap-default-host)
519 (error "No LDAP host specified"))
520 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
523 (if (or binddn passwd)
524 (setq host-plist (copy-seq host-plist)))
526 (setq host-plist (plist-put host-plist 'binddn binddn)))
528 (setq host-plist (plist-put host-plist 'passwd passwd)))
530 (message "Opening LDAP connection to %s..." host))
531 (setq ldap (ldap-open host host-plist))
533 (message "Adding LDAP entries..."))
536 (ldap-add ldap (car thisentry) (cdr thisentry))
538 (message "%d added" i))
544 (defun ldap-modify-entries (entry-mods &optional host binddn passwd)
545 "Modify entries of an LDAP directory.
546 ENTRY_MODS is a list of entry modifications of the form
547 (DN MOD-SPEC1 MOD-SPEC2 ...) where DN is the distinguished name of
548 the entry to modify, the following are modification specifications.
549 A modification specification is itself a list of the form
550 (MOD-OP ATTR VALUE1 VALUE2 ...) MOD-OP and ATTR are mandatory,
551 VALUEs are optional depending on MOD-OP.
552 MOD-OP is the type of modification, one of the symbols `add', `delete'
553 or `replace'. ATTR is the LDAP attribute type to modify.
554 HOST is the LDAP host, defaulting to `ldap-default-host'.
555 BINDDN is the DN to bind as to the server.
556 PASSWD is the corresponding password."
558 (setq host ldap-default-host)
559 (error "No LDAP host specified"))
560 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
563 (if (or binddn passwd)
564 (setq host-plist (copy-seq host-plist)))
566 (setq host-plist (plist-put host-plist 'binddn binddn)))
568 (setq host-plist (plist-put host-plist 'passwd passwd)))
570 (message "Opening LDAP connection to %s..." host))
571 (setq ldap (ldap-open host host-plist))
573 (message "Modifying LDAP entries..."))
576 (ldap-modify ldap (car thisentry) (cdr thisentry))
578 (message "%d modified" i))
584 (defun ldap-delete-entries (dn &optional host binddn passwd)
585 "Delete an entry from an LDAP directory.
586 DN is the distinguished name of an entry to delete or
588 HOST is the LDAP host, defaulting to `ldap-default-host'.
589 BINDDN is the DN to bind as to the server.
590 PASSWD is the corresponding password."
592 (setq host ldap-default-host)
593 (error "No LDAP host specified"))
594 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
596 (if (or binddn passwd)
597 (setq host-plist (copy-seq host-plist)))
599 (setq host-plist (plist-put host-plist 'binddn binddn)))
601 (setq host-plist (plist-put host-plist 'passwd passwd)))
603 (message "Opening LDAP connection to %s..." host))
604 (setq ldap (ldap-open host host-plist))
608 (message "Deleting LDAP entries..."))
611 (ldap-delete ldap thisdn)
613 (message "%d deleted" i))
617 (message "Deleting LDAP entry..."))
618 (ldap-delete ldap dn))
624 ;;; ldap.el ends here