]> code.delx.au - gnu-emacs/blobdiff - lisp/net/ldap.el
Merge changes from emacs-23 branch.
[gnu-emacs] / lisp / net / ldap.el
index 4b16622d75108f71f5fecba2b55a37fe92a243ef..17f6acce0f4bd7ae92280023352cdca489e02668 100644 (file)
@@ -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 <Oscar.Figueiredo@di.epfl.ch>
-;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
+;; Author: Oscar Figueiredo <oscar@cpe.fr>
+;; 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 <http://www.gnu.org/licenses/>.
 
 ;;; 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