X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/cf3b69c44ce3f19c87ba4fa500b788a66b2b5965..65e86587ab836aaa86b12ce30b219bcb4fcbaa06:/lisp/net/ldap.el diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index ee8b3ba457..7f936ed0bd 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -1,9 +1,10 @@ ;;; ldap.el --- client interface to LDAP for Emacs -;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006 Free Software Foundation, Inc. -;; Author: Oscar Figueiredo -;; Maintainer: Oscar Figueiredo +;; Author: Oscar Figueiredo +;; Maintainer: FSF ;; Created: April 1998 ;; Keywords: comm @@ -21,14 +22,14 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; This package provides basic functionality to perform searches on LDAP -;; servers. It requires a command line utility generally named -;; `ldapsearch' to actually perform the searches. That program can be +;; servers. It requires a command line utility generally named +;; `ldapsearch' to actually perform the searches. That program can be ;; found in all LDAP developer kits such as: ;; - UM-LDAP 3.3 (http://www.umich.edu/~dirsvcs/ldap/) ;; - OpenLDAP (http://www.openldap.org/) @@ -36,6 +37,7 @@ ;;; Code: (require 'custom) +(eval-when-compile (require 'cl)) (defgroup ldap nil "Lightweight Directory Access Protocol." @@ -44,7 +46,7 @@ (defcustom ldap-default-host nil "*Default LDAP server. -A TCP port number can be appended to that name using a colon as +A TCP port number can be appended to that name using a colon as a separator." :type '(choice (string :tag "Host name") (const :tag "Use library default" nil)) @@ -70,14 +72,14 @@ Acme organization in the United States." (defcustom ldap-host-parameters-alist nil "*Alist of host-specific options for LDAP transactions. The format of each list element is (HOST PROP1 VAL1 PROP2 VAL2 ...). -HOST is the hostname of an LDAP server(with an optional TCP port number -appended to it using a colon as a separator). +HOST is the hostname of an LDAP server (with an optional TCP port number +appended to it using a colon as a separator). PROPn and VALn are property/value pairs describing parameters for the server. -Valid properties include: - `binddn' is the distinguished name of the user to bind as +Valid properties include: + `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax). `passwd' is the password to use for simple authentication. - `auth' is the authentication method to use. + `auth' is the authentication method to use. Possible values are: `simple', `krbv41' and `krbv42'. `base' is the base for the search as described in RFC 1779. `scope' is one of the three symbols `subtree', `base' or `onelevel'. @@ -93,7 +95,7 @@ Valid properties include: (checklist :inline t :greedy t (list - :tag "Search Base" + :tag "Search Base" :inline t (const :tag "Search Base" base) string) @@ -117,12 +119,7 @@ Valid properties include: (const :menu-tag "Kerberos 4.1" :tag "Kerberos 4.1" krbv41) (const :menu-tag "Kerberos 4.2" :tag "Kerberos 4.2" krbv42))) (list - :tag "Search Base" - :inline t - (const :tag "Search Base" base) - string) - (list - :tag "Search Scope" + :tag "Search Scope" :inline t (const :tag "Search Scope" scope) (choice @@ -157,17 +154,13 @@ Valid properties include: :type '(string :tag "`ldapsearch' Program") :group 'ldap) -(defcustom ldap-ldapsearch-args '("-B") - "*A list of additional arguments to pass to `ldapsearch'. -It is recommended to use the `-T' switch with Netscape's -implementation to avoid line wrapping. -The `-B' switch should be used to enable the retrieval of -binary values." +(defcustom ldap-ldapsearch-args '("-LL" "-tt") + "*A list of additional arguments to pass to `ldapsearch'." :type '(repeat :tag "`ldapsearch' Arguments" (string :tag "Argument")) :group 'ldap) -(defcustom ldap-ignore-attribute-codings t +(defcustom ldap-ignore-attribute-codings nil "*If non-nil, do not encode/decode LDAP attribute values." :type 'boolean :group 'ldap) @@ -177,141 +170,140 @@ binary values." :type 'symbol :group 'ldap) -(defcustom ldap-coding-system nil +(defcustom ldap-coding-system 'utf-8 "*Coding system of LDAP string values. -LDAP v3 specifies the coding system of strings to be UTF-8 but -Emacs still does not have reasonable support for that." +LDAP v3 specifies the coding system of strings to be UTF-8." :type 'symbol :group 'ldap) (defvar ldap-attribute-syntax-encoders - [nil ; 1 ACI Item N - nil ; 2 Access Point Y - nil ; 3 Attribute Type Description Y - nil ; 4 Audio N - nil ; 5 Binary N - nil ; 6 Bit String Y - ldap-encode-boolean ; 7 Boolean Y - nil ; 8 Certificate N - nil ; 9 Certificate List N - nil ; 10 Certificate Pair N - ldap-encode-country-string ; 11 Country String Y - ldap-encode-string ; 12 DN Y - nil ; 13 Data Quality Syntax Y - nil ; 14 Delivery Method Y - ldap-encode-string ; 15 Directory String Y - nil ; 16 DIT Content Rule Description Y - nil ; 17 DIT Structure Rule Description Y - nil ; 18 DL Submit Permission Y - nil ; 19 DSA Quality Syntax Y - nil ; 20 DSE Type Y - nil ; 21 Enhanced Guide Y - nil ; 22 Facsimile Telephone Number Y - nil ; 23 Fax N - nil ; 24 Generalized Time Y - nil ; 25 Guide Y - nil ; 26 IA5 String Y - number-to-string ; 27 INTEGER Y - nil ; 28 JPEG N - nil ; 29 Master And Shadow Access Points Y - nil ; 30 Matching Rule Description Y - nil ; 31 Matching Rule Use Description Y - nil ; 32 Mail Preference Y - nil ; 33 MHS OR Address Y - nil ; 34 Name And Optional UID Y - nil ; 35 Name Form Description Y - nil ; 36 Numeric String Y - nil ; 37 Object Class Description Y - nil ; 38 OID Y - nil ; 39 Other Mailbox Y - nil ; 40 Octet String Y - ldap-encode-address ; 41 Postal Address Y - nil ; 42 Protocol Information Y - nil ; 43 Presentation Address Y - ldap-encode-string ; 44 Printable String Y - nil ; 45 Subtree Specification Y - nil ; 46 Supplier Information Y - nil ; 47 Supplier Or Consumer Y - nil ; 48 Supplier And Consumer Y - nil ; 49 Supported Algorithm N - nil ; 50 Telephone Number Y - nil ; 51 Teletex Terminal Identifier Y - nil ; 52 Telex Number Y - nil ; 53 UTC Time Y - nil ; 54 LDAP Syntax Description Y - nil ; 55 Modify Rights Y - nil ; 56 LDAP Schema Definition Y - nil ; 57 LDAP Schema Description Y - nil ; 58 Substring Assertion Y - ] + [nil ; 1 ACI Item N + nil ; 2 Access Point Y + nil ; 3 Attribute Type Description Y + nil ; 4 Audio N + nil ; 5 Binary N + nil ; 6 Bit String Y + ldap-encode-boolean ; 7 Boolean Y + nil ; 8 Certificate N + nil ; 9 Certificate List N + nil ; 10 Certificate Pair N + ldap-encode-country-string ; 11 Country String Y + ldap-encode-string ; 12 DN Y + nil ; 13 Data Quality Syntax Y + nil ; 14 Delivery Method Y + ldap-encode-string ; 15 Directory String Y + nil ; 16 DIT Content Rule Description Y + nil ; 17 DIT Structure Rule Description Y + nil ; 18 DL Submit Permission Y + nil ; 19 DSA Quality Syntax Y + nil ; 20 DSE Type Y + nil ; 21 Enhanced Guide Y + nil ; 22 Facsimile Telephone Number Y + nil ; 23 Fax N + nil ; 24 Generalized Time Y + nil ; 25 Guide Y + nil ; 26 IA5 String Y + number-to-string ; 27 INTEGER Y + nil ; 28 JPEG N + nil ; 29 Master And Shadow Access Points Y + nil ; 30 Matching Rule Description Y + nil ; 31 Matching Rule Use Description Y + nil ; 32 Mail Preference Y + nil ; 33 MHS OR Address Y + nil ; 34 Name And Optional UID Y + nil ; 35 Name Form Description Y + nil ; 36 Numeric String Y + nil ; 37 Object Class Description Y + nil ; 38 OID Y + nil ; 39 Other Mailbox Y + nil ; 40 Octet String Y + ldap-encode-address ; 41 Postal Address Y + nil ; 42 Protocol Information Y + nil ; 43 Presentation Address Y + ldap-encode-string ; 44 Printable String Y + nil ; 45 Subtree Specification Y + nil ; 46 Supplier Information Y + nil ; 47 Supplier Or Consumer Y + nil ; 48 Supplier And Consumer Y + nil ; 49 Supported Algorithm N + nil ; 50 Telephone Number Y + nil ; 51 Teletex Terminal Identifier Y + nil ; 52 Telex Number Y + nil ; 53 UTC Time Y + nil ; 54 LDAP Syntax Description Y + nil ; 55 Modify Rights Y + nil ; 56 LDAP Schema Definition Y + nil ; 57 LDAP Schema Description Y + nil ; 58 Substring Assertion Y + ] "A vector of functions used to encode LDAP attribute values. The sequence of functions corresponds to the sequence of LDAP attribute syntax -object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in +object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in RFC2252 section 4.3.2") (defvar ldap-attribute-syntax-decoders - [nil ; 1 ACI Item N - nil ; 2 Access Point Y - nil ; 3 Attribute Type Description Y - nil ; 4 Audio N - nil ; 5 Binary N - nil ; 6 Bit String Y - ldap-decode-boolean ; 7 Boolean Y - nil ; 8 Certificate N - nil ; 9 Certificate List N - nil ; 10 Certificate Pair N - ldap-decode-string ; 11 Country String Y - ldap-decode-string ; 12 DN Y - nil ; 13 Data Quality Syntax Y - nil ; 14 Delivery Method Y - ldap-decode-string ; 15 Directory String Y - nil ; 16 DIT Content Rule Description Y - nil ; 17 DIT Structure Rule Description Y - nil ; 18 DL Submit Permission Y - nil ; 19 DSA Quality Syntax Y - nil ; 20 DSE Type Y - nil ; 21 Enhanced Guide Y - nil ; 22 Facsimile Telephone Number Y - nil ; 23 Fax N - nil ; 24 Generalized Time Y - nil ; 25 Guide Y - nil ; 26 IA5 String Y - string-to-number ; 27 INTEGER Y - nil ; 28 JPEG N - nil ; 29 Master And Shadow Access Points Y - nil ; 30 Matching Rule Description Y - nil ; 31 Matching Rule Use Description Y - nil ; 32 Mail Preference Y - nil ; 33 MHS OR Address Y - nil ; 34 Name And Optional UID Y - nil ; 35 Name Form Description Y - nil ; 36 Numeric String Y - nil ; 37 Object Class Description Y - nil ; 38 OID Y - nil ; 39 Other Mailbox Y - nil ; 40 Octet String Y - ldap-decode-address ; 41 Postal Address Y - nil ; 42 Protocol Information Y - nil ; 43 Presentation Address Y - ldap-decode-string ; 44 Printable String Y - nil ; 45 Subtree Specification Y - nil ; 46 Supplier Information Y - nil ; 47 Supplier Or Consumer Y - nil ; 48 Supplier And Consumer Y - nil ; 49 Supported Algorithm N - nil ; 50 Telephone Number Y - nil ; 51 Teletex Terminal Identifier Y - nil ; 52 Telex Number Y - nil ; 53 UTC Time Y - nil ; 54 LDAP Syntax Description Y - nil ; 55 Modify Rights Y - nil ; 56 LDAP Schema Definition Y - nil ; 57 LDAP Schema Description Y - nil ; 58 Substring Assertion Y - ] + [nil ; 1 ACI Item N + nil ; 2 Access Point Y + nil ; 3 Attribute Type Description Y + nil ; 4 Audio N + nil ; 5 Binary N + nil ; 6 Bit String Y + ldap-decode-boolean ; 7 Boolean Y + nil ; 8 Certificate N + nil ; 9 Certificate List N + nil ; 10 Certificate Pair N + ldap-decode-string ; 11 Country String Y + ldap-decode-string ; 12 DN Y + nil ; 13 Data Quality Syntax Y + nil ; 14 Delivery Method Y + ldap-decode-string ; 15 Directory String Y + nil ; 16 DIT Content Rule Description Y + nil ; 17 DIT Structure Rule Description Y + nil ; 18 DL Submit Permission Y + nil ; 19 DSA Quality Syntax Y + nil ; 20 DSE Type Y + nil ; 21 Enhanced Guide Y + nil ; 22 Facsimile Telephone Number Y + nil ; 23 Fax N + nil ; 24 Generalized Time Y + nil ; 25 Guide Y + nil ; 26 IA5 String Y + string-to-number ; 27 INTEGER Y + nil ; 28 JPEG N + nil ; 29 Master And Shadow Access Points Y + nil ; 30 Matching Rule Description Y + nil ; 31 Matching Rule Use Description Y + nil ; 32 Mail Preference Y + nil ; 33 MHS OR Address Y + nil ; 34 Name And Optional UID Y + nil ; 35 Name Form Description Y + nil ; 36 Numeric String Y + nil ; 37 Object Class Description Y + nil ; 38 OID Y + nil ; 39 Other Mailbox Y + nil ; 40 Octet String Y + ldap-decode-address ; 41 Postal Address Y + nil ; 42 Protocol Information Y + nil ; 43 Presentation Address Y + ldap-decode-string ; 44 Printable String Y + nil ; 45 Subtree Specification Y + nil ; 46 Supplier Information Y + nil ; 47 Supplier Or Consumer Y + nil ; 48 Supplier And Consumer Y + nil ; 49 Supported Algorithm N + nil ; 50 Telephone Number Y + nil ; 51 Teletex Terminal Identifier Y + nil ; 52 Telex Number Y + nil ; 53 UTC Time Y + nil ; 54 LDAP Syntax Description Y + nil ; 55 Modify Rights Y + nil ; 56 LDAP Schema Definition Y + nil ; 57 LDAP Schema Description Y + nil ; 58 Substring Assertion Y + ] "A vector of functions used to decode LDAP attribute values. The sequence of functions corresponds to the sequence of LDAP attribute syntax -object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in +object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in RFC2252 section 4.3.2") @@ -408,7 +400,7 @@ This table is built from RFC2252 Section 5 and RFC2256 Section 5") nil) (t (error "Wrong LDAP boolean string: %s" str)))) - + (defun ldap-encode-country-string (str) ;; We should do something useful here... (if (not (= 2 (length str))) @@ -432,16 +424,16 @@ This table is built from RFC2252 Section 5 and RFC2256 Section 5") ;; LDAP protocol functions - + (defun ldap-get-host-parameter (host parameter) "Get the value of PARAMETER for HOST in `ldap-host-parameters-alist'." (plist-get (cdr (assoc host ldap-host-parameters-alist)) parameter)) - + (defun ldap-decode-attribute (attr) "Decode the attribute/value pair ATTR according to LDAP rules. -The attribute name is looked up in `ldap-attribute-syntaxes-alist' -and the corresponding decoder is then retrieved from +The attribute name is looked up in `ldap-attribute-syntaxes-alist' +and the corresponding decoder is then retrieved from `ldap-attribute-syntax-decoders' and applied on the value(s)." (let* ((name (car attr)) (values (cdr attr)) @@ -455,19 +447,18 @@ and the corresponding decoder is then retrieved from (if decoder (cons name (mapcar decoder values)) attr))) - (defun ldap-search (filter &optional host attributes attrsonly withdn) "Perform an LDAP search. FILTER is the search filter in RFC1558 syntax. HOST is the LDAP host on which to perform the search. -ATTRIBUTES are the specific attributes to retrieve, nil means +ATTRIBUTES are the specific attributes to retrieve, nil means retrieve all. -ATTRSONLY, if non-nil, retrieves the attributes only, without +ATTRSONLY, if non-nil, retrieves the attributes only, without the associated values. If WITHDN is non-nil, each entry in the result will be prepended with its distinguished name WITHDN. -Additional search parameters can be specified through +Additional search parameters can be specified through `ldap-host-parameters-alist', which see." (interactive "sFilter:") (or host @@ -475,17 +466,16 @@ Additional search parameters can be specified through (error "No LDAP host specified")) (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) result) - (setq result (ldap-search-internal (append host-plist - (list 'host host - 'filter filter - 'attributes attributes - 'attrsonly attrsonly - 'withdn withdn)))) + (setq result (ldap-search-internal (list* 'host host + 'filter filter + 'attributes attributes + 'attrsonly attrsonly + 'withdn withdn + host-plist))) (if ldap-ignore-attribute-codings result - (mapcar (function - (lambda (record) - (mapcar 'ldap-decode-attribute record))) + (mapcar (lambda (record) + (mapcar 'ldap-decode-attribute record)) result)))) @@ -500,9 +490,11 @@ to try to connect to. Each host name may optionally be of the form HOST:PORT. for each matching entry. If nil, return all available attributes. `attrsonly', if non-nil, indicates that only attributes are retrieved, not their associated values. + `auth' is one of the symbols `simple', `krbv41' or `krbv42'. `base' is the base for the search as described in RFC 1779. `scope' is one of the three symbols `sub', `base' or `one'. `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax). + `auth' is one of the symbols `simple', `krbv41' or `krbv42' `passwd' is the password to use for simple authentication. `deref' is one of the symbols `never', `always', `search' or `find'. `timelimit' is the timeout limit for the connection in seconds. @@ -522,6 +514,7 @@ an alist of attribute/value pairs." ldap-default-base)) (scope (plist-get search-plist 'scope)) (binddn (plist-get search-plist 'binddn)) + (auth (plist-get search-plist 'auth)) (passwd (plist-get search-plist 'passwd)) (deref (plist-get search-plist 'deref)) (timelimit (plist-get search-plist 'timelimit)) @@ -551,6 +544,9 @@ an alist of attribute/value pairs." (if (and binddn (not (equal "" binddn))) (setq arglist (nconc arglist (list (format "-D%s" binddn))))) + (if (and auth + (equal 'simple auth)) + (setq arglist (nconc arglist (list "-x")))) (if (and passwd (not (equal "" passwd))) (setq arglist (nconc arglist (list (format "-w%s" passwd))))) @@ -566,47 +562,62 @@ an alist of attribute/value pairs." (eval `(call-process ldap-ldapsearch-prog nil buf - nil + nil ,@arglist - "-t" ; Write values to temp files ,@ldap-ldapsearch-args ,@filter)) (insert "\n") (goto-char (point-min)) - + + (while (re-search-forward "[\t\n\f]+ " nil t) + (replace-match "" nil nil)) + (goto-char (point-min)) + (if (looking-at "usage") (error "Incorrect ldapsearch invocation") (message "Parsing results... ") - (while (progn + ;; Skip error message when retrieving attribute list + (if (looking-at "Size limit exceeded") + (forward-line 1)) + (while (progn (skip-chars-forward " \t\n") (not (eobp))) - (setq dn (buffer-substring (point) (save-excursion + (setq dn (buffer-substring (point) (save-excursion (end-of-line) (point)))) (forward-line 1) - (while (looking-at "^\\(\\w*\\)[=:\t ]+\\(<[\t ]*file://\\)?\\(.*\\)$") + (while (looking-at "^\\(\\w*\\)\\(;\\w*\\)?[=:\t ]+\\(<[\t ]*file://\\)\\(.*\\)$") (setq name (match-string 1) - value (match-string 3)) - (save-excursion - (set-buffer bufval) - (erase-buffer) - (insert-file-contents-literally value) - (delete-file value) - (setq value (buffer-substring (point-min) (point-max)))) + value (match-string 4)) + ;; Need to handle file:///D:/... as generated by OpenLDAP + ;; on DOS/Windows as local files. + (if (and (memq system-type '(windows-nt ms-dos)) + (eq (string-match "/\\(.:.*\\)$" value) 0)) + (setq value (match-string 1 value))) + ;; Do not try to open non-existent files + (if (equal value "") + (setq value " ") + (save-excursion + (set-buffer bufval) + (erase-buffer) + (set-buffer-multibyte nil) + (insert-file-contents-literally value) + (delete-file value) + (setq value (buffer-string)))) (setq record (cons (list name value) record)) (forward-line 1)) - (setq result (cons (if withdn + (setq result (cons (if withdn (cons dn (nreverse record)) (nreverse record)) result)) (setq record nil) - (skip-chars-forward " \t\n") + (skip-chars-forward " \t\n") (message "Parsing results... %d" numres) (1+ numres)) (message "Parsing results... done") (nreverse result))))) - (provide 'ldap) +;;; arch-tag: 47913a76-6155-42e6-ac58-6d28b5d50eb0 ;;; ldap.el ends here