]> code.delx.au - gnu-emacs/blobdiff - lisp/net/ldap.el
Merge from origin/emacs-25
[gnu-emacs] / lisp / net / ldap.el
index 477c21b01454e920cf16b002581e4a363daacfe6..d08fdbee37508cb737ece07a1d8b7259795ce635 100644 (file)
@@ -1,6 +1,6 @@
 ;;; ldap.el --- client interface to LDAP for Emacs
 
-;; Copyright (C) 1998-2014 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2016 Free Software Foundation, Inc.
 
 ;; Author: Oscar Figueiredo <oscar@cpe.fr>
 ;; Maintainer: emacs-devel@gnu.org
 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))
-  :group 'ldap)
+                (const :tag "Use library default" nil)))
 
 (defcustom ldap-default-port nil
   "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)
+                (integer :tag "Port number")))
 
 (defcustom ldap-default-base nil
   "Default base for LDAP searches.
@@ -64,8 +62,7 @@ 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."
   :type '(choice (const :tag "Use library default" nil)
-                (string :tag "Search base"))
-  :group 'ldap)
+                (string :tag "Search base")))
 
 
 (defcustom ldap-host-parameters-alist nil
@@ -145,41 +142,35 @@ Valid properties include:
                                   :tag "Size Limit"
                                   :inline t
                                   (const :tag "Size Limit" sizelimit)
-                                  (integer :tag "(number of records)")))))
-  :group 'ldap)
+                                  (integer :tag "(number of records)"))))))
 
 (defcustom ldap-ldapsearch-prog "ldapsearch"
   "The name of the ldapsearch command line program."
-  :type '(string :tag "`ldapsearch' Program")
-  :group 'ldap)
+  :type '(string :tag "`ldapsearch' Program"))
 
 (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)
+                (string :tag "Argument")))
 
 (defcustom ldap-ldapsearch-password-prompt-regexp "Enter LDAP Password: "
   "A regular expression used to recognize the `ldapsearch'
 program's password prompt."
   :type 'regexp
-  :group 'ldap)
+  :version "25.1")
 
 (defcustom ldap-ignore-attribute-codings nil
   "If non-nil, do not encode/decode LDAP attribute values."
-  :type 'boolean
-  :group 'ldap)
+  :type 'boolean)
 
 (defcustom ldap-default-attribute-decoder nil
   "Decoder function to use for attributes whose syntax is unknown."
-  :type 'symbol
-  :group 'ldap)
+  :type 'symbol)
 
 (defcustom ldap-coding-system 'utf-8
   "Coding system of LDAP string values.
 LDAP v3 specifies the coding system of strings to be UTF-8."
-  :type 'symbol
-  :group 'ldap)
+  :type 'symbol)
 
 (defvar ldap-attribute-syntax-encoders
   [nil                                 ; 1  ACI Item                        N
@@ -385,9 +376,19 @@ RFC2252 section 4.3.2")
     (houseidentifier . 15)
     (supportedalgorithms . 49)
     (deltarevocationlist . 9)
-    (dmdname . 15))
+    (dmdname . 15)
+    (carlicense . 15)
+    (departmentnumber . 15)
+    (displayname . 15)
+    (employeenumber . 15)
+    (employeetype . 15)
+    (jpegphoto . 28)
+    (preferredlanguage . 15)
+    (usersmimecertificate . 5)
+    (userpkcs12 . 5))
   "A map of LDAP attribute names to their type object id minor number.
-This table is built from RFC2252 Section 5 and RFC2256 Section 5")
+This table is built from RFC2252 Section 5, RFC2256 Section 5 and
+RFC2798 Section 9.1.1")
 
 
 ;; Coding/decoding functions
@@ -484,19 +485,46 @@ Additional search parameters can be specified through
              result))))
 
 (defun ldap-password-read (host)
-  "Read LDAP password for HOST.  If the password is cached, it is
-read from the cache, otherwise the user is prompted for the
-password and the password is cached.  The cache can be cleared
-with the `password-reset' function and the
-`password-cache-expiry' variable controls how long the password
-is cached for."
-  (password-read-and-add
-   (format "Enter LDAP Password%s: "
-                               (if (equal host "")
-                                   ""
-                                 (format " for %s" host)))
-   ;; Add ldap: namespace to allow empty string for default host.
-   (concat "ldap:" host)))
+  "Read LDAP password for HOST.
+If the password is cached, it is read from the cache, otherwise the user
+is prompted for the password.  If `password-cache' is non-nil the password
+is verified and cached.  The `password-cache-expiry' variable
+controls for how long the password is cached.
+
+This function can be specified for the `passwd' property in
+`ldap-host-parameters-alist' when interactive password prompting
+is desired for HOST."
+  ;; Add ldap: namespace to allow empty string for default host.
+  (let* ((host-key (concat "ldap:" host))
+        (password (password-read
+                   (format "Enter LDAP Password%s: "
+                           (if (equal host "")
+                               ""
+                             (format " for %s" host)))
+                   host-key)))
+    (when (and password-cache
+              (not (password-in-cache-p host-key))
+              ;; Confirm the password is valid before adding it to
+              ;; the password cache.  ldap-search-internal will throw
+              ;; an error if the password is invalid.
+              (not (ldap-search-internal
+                    `(host ,host
+                           ;; Specify an arbitrary filter that should
+                           ;; produce no results, since only
+                           ;; authentication success is of interest.
+                           filter "emacs-test-password="
+                           attributes nil
+                           attrsonly nil
+                           withdn nil
+                           ;; Preempt passwd ldap-password-read
+                           ;; setting in ldap-host-parameters-alist.
+                           passwd ,password
+                           ,@(cdr
+                              (assoc
+                               host
+                               ldap-host-parameters-alist))))))
+      (password-cache-add host-key password))
+    password))
 
 (defun ldap-search-internal (search-plist)
   "Perform a search on a LDAP server.
@@ -528,8 +556,8 @@ 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'
+  `binddn' is the distinguished name of the user to bind as (in
+RFC 1779 syntax).
   `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.
@@ -620,10 +648,11 @@ an alist of attribute/value pairs."
          (setq arglist (nconc arglist (list (format "-z%s" sizelimit)))))
       (if passwd
          (let* ((process-connection-type nil)
+                (proc-args (append arglist ldap-ldapsearch-args
+                                   filter))
                 (proc (apply #'start-process "ldapsearch" buf
                              ldap-ldapsearch-prog
-                             (append arglist ldap-ldapsearch-args
-                                     filter))))
+                             proc-args)))
            (while (null (progn
                           (goto-char (point-min))
                           (re-search-forward
@@ -633,7 +662,17 @@ an alist of attribute/value pairs."
            (process-send-string proc passwd)
            (process-send-string proc "\n")
            (while (not (memq (process-status proc) '(exit signal)))
-             (sit-for 0.1)))
+             (sit-for 0.1))
+           (let ((status (process-exit-status proc)))
+             (when (not (eq status 0))
+               ;; Handle invalid credentials exit status specially
+               ;; for ldap-password-read.
+               (if (eq status 49)
+                   (error (concat "Incorrect LDAP password or"
+                                  " bind distinguished name (binddn)"))
+                 (error "Failed ldapsearch invocation: %s \"%s\""
+                        ldap-ldapsearch-prog
+                        (mapconcat 'identity proc-args "\" \""))))))
        (apply #'call-process ldap-ldapsearch-prog
               ;; Ignore stderr, which can corrupt results
               nil (list buf nil) nil