X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ea0ea9003d498afaac6c90222dc63919679b1769..1adfb5ee55d16cd3d9d78998ae7bbb8e5708d9c5:/lisp/net/ldap.el

diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index 32e403a871..d08fdbee37 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -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
@@ -48,15 +48,13 @@
 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 `password-reset`."
+  "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)))
-    (when (not (password-in-cache-p host-key))
-      (password-cache-add host-key (password-read
-				    (format "Enter LDAP Password%s: "
-					    (if (equal host "")
-						""
-					      (format " for %s" host))))))
-    (password-read-from-cache host-key)))
+  (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