X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/c69b943f41240a0720f0bae6ff975555acf93e2f..ca3fa30248b923c17c021c0fcdb945271d14e8c2:/lisp/net/ldap.el diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index 4b16622d75..17f6acce0f 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -1,18 +1,19 @@ ;;; 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, +;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. -;; Author: Oscar Figueiredo -;; Maintainer: Oscar Figueiredo +;; Author: Oscar Figueiredo +;; Maintainer: FSF ;; Created: April 1998 ;; Keywords: comm ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -20,9 +21,7 @@ ;; GNU General Public License for more details. ;; 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. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -36,6 +35,7 @@ ;;; Code: (require 'custom) +(eval-when-compile (require 'cl)) (defgroup ldap nil "Lightweight Directory Access Protocol." @@ -43,7 +43,7 @@ :group 'comm) (defcustom ldap-default-host nil - "*Default LDAP server. + "Default LDAP server. A TCP port number can be appended to that name using a colon as a separator." :type '(choice (string :tag "Host name") @@ -51,14 +51,14 @@ a separator." :group 'ldap) (defcustom ldap-default-port nil - "*Default TCP port for LDAP connections. + "Default TCP port for LDAP connections. Initialized from the LDAP library at build time. Default value is 389." :type '(choice (const :tag "Use library default" nil) (integer :tag "Port number")) :group 'ldap) (defcustom ldap-default-base nil - "*Default base for LDAP searches. + "Default base for LDAP searches. This is a string using the syntax of RFC 1779. For instance, \"o=ACME, c=US\" limits the search to the Acme organization in the United States." @@ -68,9 +68,9 @@ Acme organization in the United States." (defcustom ldap-host-parameters-alist nil - "*Alist of host-specific options for LDAP transactions. + "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 +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: @@ -148,32 +148,28 @@ Valid properties include: :group 'ldap) (defcustom ldap-ldapsearch-prog "ldapsearch" - "*The name of the ldapsearch command line program." + "The name of the ldapsearch command line program." :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 nil - "*If non-nil, do not encode/decode LDAP attribute values." + "If non-nil, do not encode/decode LDAP attribute values." :type 'boolean :group 'ldap) (defcustom ldap-default-attribute-decoder nil - "*Decoder function to use for attributes whose syntax is unknown." + "Decoder function to use for attributes whose syntax is unknown." :type 'symbol :group 'ldap) (defcustom ldap-coding-system 'utf-8 - "*Coding system of LDAP string values. + "Coding system of LDAP string values. LDAP v3 specifies the coding system of strings to be UTF-8." :type 'symbol :group 'ldap) @@ -468,17 +464,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)))) @@ -493,9 +488,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. @@ -515,6 +512,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)) @@ -526,8 +524,7 @@ an alist of attribute/value pairs." (equal "" filter)) (error "No search filter")) (setq filter (cons filter attributes)) - (save-excursion - (set-buffer buf) + (with-current-buffer buf (erase-buffer) (if (and host (not (equal "" host))) @@ -544,6 +541,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))))) @@ -561,15 +561,21 @@ an alist of attribute/value pairs." buf 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... ") + ;; 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))) @@ -577,21 +583,31 @@ an alist of attribute/value pairs." (end-of-line) (point)))) (forward-line 1) - (while (looking-at "^\\(\\w*\\)[=:\t ]+\\(<[\t ]*file://\\)?\\(.*\\)$") + (while (looking-at "^\\([A-Za-z][-A-Za-z0-9]*\ +\\|[0-9]+\\(?:\\.[0-9]+\\)*\\)\\(;[-A-Za-z0-9]+\\)*[=:\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 " ") + (with-current-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 - (cons dn (nreverse record)) - (nreverse record)) result)) + (push (if withdn + (cons dn (nreverse record)) + (nreverse record)) result) (setq record nil) (skip-chars-forward " \t\n") (message "Parsing results... %d" numres) @@ -601,4 +617,5 @@ an alist of attribute/value pairs." (provide 'ldap) +;; arch-tag: 47913a76-6155-42e6-ac58-6d28b5d50eb0 ;;; ldap.el ends here