lisp/net/{eudc,ldap}: Merge branch streamline-eudc-configuration

7 files changed, 425 insertions, 132 deletions

diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index 2baa13cea8c..e75589f92ec 100644
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -1,3 +1,8 @@
+2015-01-23  Thomas Fitzsimmons  <fitzsim@fitzsim.org>
+
+        * eudc.texi (LDAP Configuration): Rename from LDAP Requirements
+        and provide configuration examples.
+
 2015-01-17  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * eieio.texi (Slot Options): Document :protection as unsupported.
@@ -28,8 +33,8 @@
 
 2014-12-18  Eric Abrahamsen  <eric@ericabrahamsen.net>
 
-        * gnus.texi (Gnus Registry Setup): Explain pruning changes.  Mention
-        gnus-registry-prune-factor. Explain sorting changes and
+        * gnus.texi (Gnus Registry Setup): Explain pruning changes.
+        Mention gnus-registry-prune-factor. Explain sorting changes and
         gnus-registry-default-sort-function. Correct file extension.
 
 2014-12-17  Jay Belanger  <jay.p.belanger@gmail.com>
diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi
index b5a4e3aae40..9757c82fe7e 100644
--- a/doc/misc/eudc.texi
+++ b/doc/misc/eudc.texi
@@ -137,7 +137,7 @@ location, etc@enddots{} More information about LDAP can be found at
 @url{http://www.openldap.org/}.
 
 EUDC requires external support to access LDAP directory servers
-(@pxref{LDAP Requirements})
+(@pxref{LDAP Configuration})
 
 
 @node CCSO PH/QI
@@ -213,17 +213,131 @@ email composition buffers (@pxref{Inline Query Expansion})
 @end lisp
 
 @menu
-* LDAP Requirements::           EUDC needs external support for LDAP
+* LDAP Configuration::           EUDC needs external support for LDAP
 @end menu
 
-@node LDAP Requirements
-@section LDAP Requirements
+@node LDAP Configuration
+@section LDAP Configuration
 
-LDAP support is added by means of @file{ldap.el}, which is part of Emacs.
-@file{ldap.el} needs an external command line utility named
-@file{ldapsearch}, available as part of Open LDAP
-(@url{http://www.openldap.org/}).
+LDAP support is added by means of @file{ldap.el}, which is part of
+Emacs.  @file{ldap.el} needs an external command line utility named
+@file{ldapsearch}, available as part of OpenLDAP
+(@url{http://www.openldap.org/}).  The configurations in this section
+were tested with OpenLDAP 2.4.23.
 
+The following examples use a base of
+@code{ou=people,dc=example,dc=com} and the host name
+@code{directory.example.com}, a server that supports LDAP-over-SSL
+(the @code{ldaps} protocol, with default port @code{636}) and which
+requires authentication by the user @code{emacsuser} with password
+@code{s3cr3t}.
+
+These configurations are meant to be self-contained; that is, each
+provides everything required for sensible TAB-completion of email
+fields.  BBDB lookups are attempted first; if a matching BBDB entry is
+found then EUDC will not attempt any LDAP lookups.
+
+Wildcard LDAP lookups are supported using the @code{*} character.  For
+example, attempting to TAB-complete the following:
+
+@example
+To: * Smith
+@end example
+
+will return all LDAP entries with surnames that begin with
+@code{Smith}.  In every LDAP query it makes, EUDC implicitly appends
+the wildcard character to the end of the last word.
+
+@subsection Emacs-only Configuration
+
+Emacs can pass most required configuration options via the
+@file{ldapsearch} command-line.  One exception is certificate
+configuration for LDAP-over-SSL, which must be specified in
+@file{/etc/openldap/ldap.conf}.  On systems that provide such
+certificates as part of the @code{OpenLDAP} installation, this can be
+as simple as one line:
+
+@example
+TLS_CACERTDIR /etc/openldap/certs
+@end example
+
+In @file{.emacs}, these expressions suffice to configure EUDC for
+LDAP:
+
+@lisp
+(eval-after-load "message"
+  '(define-key message-mode-map (kbd "TAB") 'eudc-expand-inline))
+(customize-set-variable 'eudc-server-hotlist
+                        '(("" . bbdb)
+                          ("ldaps://directory.example.com" . ldap)))
+(customize-set-variable 'ldap-host-parameters-alist
+                        '(("ldaps://directory.example.com"
+                           base "ou=people,dc=example,dc=com"
+                           binddn "example\\emacsuser"
+                           passwd ldap-password-read)))
+@end lisp
+
+Specifying the function @code{ldap-password-read} for @code{passwd}
+will cause Emacs to prompt interactively for the password.  The
+password will then be validated and cached, unless
+@code{password-cache} is nil.  You can customize
+@code{password-cache-expiry} to control the duration for which the
+password is cached.  If you want to clear the cache, call
+@code{password-reset}.
+
+@subsection External Configuration
+
+Your system may already be configured for a default LDAP server.  For
+example, @file{/etc/openldap/ldap.conf} might contain:
+
+@example
+BASE ou=people,dc=example,dc=com
+URI ldaps://directory.example.com
+TLS_CACERTDIR /etc/openldap/certs
+@end example
+
+To authenticate, the @dfn{bind distinguished name (binddn)} is
+required, in this case, @code{example\emacsuser}, along with the
+password.  These can be specified in @file{~/.authinfo.gpg} with the
+following line:
+
+@example
+machine ldaps://directory.example.com binddn example\emacsuser password s3cr3t
+@end example
+
+Then in the @file{.emacs} init file, these expressions suffice to
+configure EUDC for LDAP:
+
+@lisp
+(eval-after-load "message"
+  '(define-key message-mode-map (kbd "TAB") 'eudc-expand-inline))
+(customize-set-variable 'eudc-server-hotlist
+                        '(("" . bbdb)
+                          ("ldaps://directory.example.com" . ldap)))
+(customize-set-variable 'ldap-host-parameters-alist
+                        '(("ldaps://directory.example.com"
+                           auth-source t)))
+@end lisp
+
+For this example where we only care about one server, the server name
+can be omitted in @file{~/.authinfo.gpg} and @file{.emacs}, in which
+case @file{ldapsearch} defaults to the host name in
+@file{/etc/openldap/ldap.conf}.
+
+The @file{~/.authinfo.gpg} line becomes:
+
+@example
+binddn example\emacsuser password s3cr3t
+@end example
+
+and the @file{.emacs} expressions become:
+
+@lisp
+(eval-after-load "message"
+  '(define-key message-mode-map (kbd "TAB") 'eudc-expand-inline))
+(customize-set-variable 'eudc-server-hotlist '(("" . bbdb) ("" . ldap)))
+(customize-set-variable 'ldap-host-parameters-alist '(("" auth-source t)))
+@end lisp
 
 @node Usage
 @chapter Usage
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index ed4e1ab1e15..15518a73eb1 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,88 @@
+2015-01-23  Thomas Fitzsimmons  <fitzsim@fitzsim.org>
+
+        * net/ldap.el (ldap-search-internal): Mention binddn in invalid
+        credentials error message.
+
+2015-01-23  Thomas Fitzsimmons  <fitzsim@fitzsim.org>
+
+        * net/ldap.el (ldap-password-read): Validate password before
+        caching it.
+        (ldap-search-internal): Handle ldapsearch error conditions.
+
+2015-01-23  Thomas Fitzsimmons  <fitzsim@fitzsim.org>
+
+        * net/ldap.el (ldap-password-read): Handle password-cache being nil.
+
+2015-01-23  Thomas Fitzsimmons  <fitzsim@fitzsim.org>
+
+        * net/eudc.el (eudc-expand-inline): Always restore former server
+        and protocol.
+
+2015-01-23  Thomas Fitzsimmons  <fitzsim@fitzsim.org>
+
+        * net/eudcb-ldap.el: Don't nag the user in case a default base is
+        provided by the LDAP system configuration file.
+
+2015-01-23  Thomas Fitzsimmons  <fitzsim@fitzsim.org>
+
+        * net/eudc.el (eudc-format-query): Preserve the
+        eudc-inline-query-format ordering of attributes in the returned list.
+        * net/eudcb-ldap.el (eudc-ldap-format-query-as-rfc1558):
+        Append the LDAP wildcard character to the last attribute value.
+
+2015-01-23  Thomas Fitzsimmons  <fitzsim@fitzsim.org>
+
+        * net/eudcb-ldap.el (eudc-ldap-cleanup-record-simple):
+        Downcase field names of LDAP results.
+        (eudc-ldap-cleanup-record-filtering-addresses): Likewise.
+
+2015-01-23  Thomas Fitzsimmons  <fitzsim@fitzsim.org>
+
+        * net/ldap.el (ldap-ldapsearch-password-prompt): New defcustom.
+        (ldap-search-internal): Send password to ldapsearch through a pipe
+        instead of via the command line.
+
+2015-01-23  Thomas Fitzsimmons  <fitzsim@fitzsim.org>
+
+        * net/ldap.el: Require password-cache.
+        (ldap-password-read): New function.
+        (ldap-search-internal): Call ldap-password-read when it is
+        configured to be called.
+
+2015-01-23  Thomas Fitzsimmons  <fitzsim@fitzsim.org>
+
+        * net/eudc-vars.el (eudc-expansion-overwrites-query):
+        Change default to nil.
+
+2015-01-23  Thomas Fitzsimmons  <fitzsim@fitzsim.org>
+
+        * net/eudc.el (eudc-expand-inline): Ignore text properties of
+        string-to-expand.
+
+2015-01-23  Thomas Fitzsimmons  <fitzsim@fitzsim.org>
+
+        * net/eudc-vars.el (eudc-inline-expansion-format): Default to a
+        format that includes first name and surname.
+
+2015-01-23  Thomas Fitzsimmons  <fitzsim@fitzsim.org>
+
+        * net/eudc-vars.el (eudc-inline-query-format): Change default to
+        query email and first name instead of surname.
+
+2015-01-23  Thomas Fitzsimmons  <fitzsim@fitzsim.org>
+
+        * net/ldap.el (ldap-search-internal): Support new-style LDAP URIs.
+
+2015-01-23  Thomas Fitzsimmons  <fitzsim@fitzsim.org>
+
+        * net/eudc-vars.el (eudc-server): Adjust docstring to mention
+        eudc-server-hotlist.
+        (eudc-server-hotlist): Move from eudc.el and make defcustom.
+        * net/eudc.el (eudc-server-hotlist): Move to eudc-vars.el.
+        (eudc-set-server): Allow setting protocol to nil.
+        (eudc-expand-inline): Support hotlist-only expansions when server
+        is not set.
+
 2015-01-23  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * emacs-lisp/cl-generic.el (cl-no-primary-method): New fun and error.
diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el
index 6bc0337f958..29ddf613376 100644
--- a/lisp/net/eudc-vars.el
+++ b/lisp/net/eudc-vars.el
@@ -41,14 +41,36 @@
   "The name or IP address of the directory server.
 A port number may be specified by appending a colon and a
 number to the name of the server.  Use `localhost' if the directory
-server resides on your computer (BBDB backend)."
-  :type  '(choice (string :tag "Server") (const :tag "None" nil))
-  :group 'eudc)
+server resides on your computer (BBDB backend).
+
+To specify multiple servers, customize eudc-server-hotlist
+instead."
+  :type  '(choice (string :tag "Server") (const :tag "None" nil)))
 
 ;; Known protocols (used in completion)
 ;; Not to be mistaken with `eudc-supported-protocols'
 (defvar eudc-known-protocols '(bbdb ph ldap))
 
+(defcustom eudc-server-hotlist nil
+  "Directory servers to query.
+This is an alist of the form (SERVER . PROTOCOL).  SERVER is the
+host name or URI of the server, PROTOCOL is a symbol representing
+the EUDC backend with which to access the server.
+
+The BBDB backend ignores SERVER; `localhost' can be used as a
+placeholder string."
+  :tag   "Directory Servers to Query"
+  :type  `(repeat (cons :tag "Directory Server"
+                        (string :tag "Server Host Name or URI")
+                        (choice :tag "Protocol"
+                                :menu-tag "Protocol"
+                                ,@(mapcar (lambda (s)
+                                            (list 'const
+                                                  ':tag (symbol-name s) s))
+                                          eudc-known-protocols)
+                                (const :tag "None" nil))))
+  :version "25.1")
+
 (defvar eudc-supported-protocols nil
   "Protocols currently supported by EUDC.
 This variable is updated when protocol-specific libraries
@@ -61,15 +83,13 @@ Supported protocols are specified by `eudc-supported-protocols'."
                   ,@(mapcar (lambda (s)
                               (list 'const ':tag (symbol-name s) s))
                             eudc-known-protocols)
-                  (const :tag "None" nil))
-  :group 'eudc)
+                  (const :tag "None" nil)))
 
 
 (defcustom eudc-strict-return-matches t
   "Ignore or allow entries not containing all requested return attributes.
 If non-nil, such entries are ignored."
-  :type  'boolean
-  :group 'eudc)
+  :type  'boolean)
 
 (defcustom eudc-default-return-attributes nil
   "A list of default attributes to extract from directory entries.
@@ -82,8 +102,7 @@ server."
                   (repeat :menu-tag "Attribute list"
                           :tag "Attribute name"
                           :value (nil)
-                          (symbol :tag "Attribute name")))
-  :group 'eudc)
+                          (symbol :tag "Attribute name"))))
 
 (defcustom eudc-multiple-match-handling-method 'select
   "What to do when multiple entries match an inline expansion query.
@@ -102,8 +121,7 @@ Possible values are:
                   (const :menu-tag "Abort Operation"
                          :tag "Abort Operation"  abort)
                   (const :menu-tag "Default (Use First)"
-                         :tag "Default (Use First)" nil))
-  :group 'eudc)
+                         :tag "Default (Use First)" nil)))
 
 (defcustom eudc-duplicate-attribute-handling-method '((email . duplicate))
   "A method to handle entries containing duplicate attributes.
@@ -130,10 +148,10 @@ different values."
                                        (const :menu-tag "List" list)
                                        (const :menu-tag "First" first)
                                        (const :menu-tag "Concat" concat)
-                                       (const :menu-tag "Duplicate" duplicate)))))
-  :group 'eudc)
+                                       (const :menu-tag "Duplicate" duplicate))))))
 
-(defcustom eudc-inline-query-format '((name)
+(defcustom eudc-inline-query-format '((email)
+                                      (firstname)
                                       (firstname name))
   "Format of an inline expansion query.
 This is a list of FORMATs.  A FORMAT is itself a list of one or more
@@ -160,14 +178,16 @@ must be set in a protocol/server-local fashion, see `eudc-server-set' and
              (const :menu-tag "Email Address" :tag "Email Address" email)
              (const :menu-tag "Phone" :tag "Phone" phone)
              (symbol :menu-tag "Other" :tag "Attribute name"))))
-  :group 'eudc)
+  :version "25.1")
 
-(defcustom eudc-expansion-overwrites-query t
+;; Default to nil so that the most common use of eudc-expand-inline,
+;; where replace is nil, does not affect the kill ring.
+(defcustom eudc-expansion-overwrites-query nil
   "If non-nil, expanding a query overwrites the query string."
   :type  'boolean
-  :group 'eudc)
+  :version "25.1")
 
-(defcustom eudc-inline-expansion-format '("%s" email)
+(defcustom eudc-inline-expansion-format '("%s %s <%s>" firstname name email)
   "A list specifying the format of the expansion of inline queries.
 This variable controls what `eudc-expand-inline' actually inserts in
 the buffer.  First element is a string passed to `format'.  Remaining
@@ -185,7 +205,7 @@ are passed as additional arguments to `format'."
                     (const :menu-tag "Phone" :tag "Phone" phone)
                     (symbol :menu-tag "Other")
                     (symbol :tag "Attribute name"))))
-  :group 'eudc)
+  :version "25.1")
 
 (defcustom eudc-inline-expansion-servers 'server-then-hotlist
   "Which servers to contact for the expansion of inline queries.
@@ -198,8 +218,7 @@ Possible values are:
                  :menu-tag "Servers"
                  (const :menu-tag "Current server" current-server)
                  (const :menu-tag "Servers in the hotlist" hotlist)
-                 (const :menu-tag "Current server then hotlist" server-then-hotlist))
-  :group 'eudc)
+                 (const :menu-tag "Current server then hotlist" server-then-hotlist)))
 
 (defcustom eudc-max-servers-to-query nil
   "Maximum number of servers to query for an inline expansion.
@@ -213,8 +232,7 @@ If nil, query all servers available from `eudc-inline-expansion-servers'."
                  (const :menu-tag "3" 3)
                  (const :menu-tag "4" 4)
                  (const :menu-tag "5" 5)
-                 (integer :menu-tag "Set"))
-  :group 'eudc)
+                 (integer :menu-tag "Set")))
 
 (defcustom eudc-query-form-attributes '(name firstname email phone)
   "A list of attributes presented in the query form."
@@ -226,8 +244,7 @@ If nil, query all servers available from `eudc-inline-expansion-servers'."
             (const :menu-tag "Surname" :tag "Surname" name)
             (const :menu-tag "Email Address" :tag "Email Address" email)
             (const :menu-tag "Phone" :tag "Phone" phone)
-            (symbol :menu-tag "Other" :tag "Attribute name")))
-  :group 'eudc)
+            (symbol :menu-tag "Other" :tag "Attribute name"))))
 
 (defcustom eudc-user-attribute-names-alist '((url . "URL")
                                              (callsign . "HAM Call Sign")
@@ -257,15 +274,13 @@ at `_' characters and capitalizing the individual words."
   :tag   "User-defined Names of Directory Attributes"
   :type  '(repeat (cons :tag "Field"
                         (symbol :tag "Directory attribute")
-                        (string :tag "User friendly name ")))
-  :group 'eudc)
+                        (string :tag "User friendly name "))))
 
 (defcustom eudc-use-raw-directory-names nil
   "If non-nil, use attributes names as defined in the directory.
 Otherwise, directory query/response forms display the user attribute
 names defined in `eudc-user-attribute-names-alist'."
-  :type  'boolean
-  :group 'eudc)
+  :type  'boolean)
 
 (defcustom eudc-attribute-display-method-alist nil
   "An alist specifying methods to display attribute values.
@@ -277,8 +292,7 @@ attribute values for display."
   :tag "Attribute Decoding Functions"
   :type '(repeat (cons :tag "Attribute"
                        (symbol :tag "Name")
-                       (symbol :tag "Display Function")))
-  :group 'eudc)
+                       (symbol :tag "Display Function"))))
 
 (defcustom eudc-external-viewers '(("ImageMagick" "display" "-")
                                    ("ShowAudio" "showaudio"))
@@ -295,18 +309,15 @@ arguments that should be passed to the program."
                        (repeat
                         :tag "Arguments"
                         :inline t
-                        (string :tag "Argument"))))
-  :group 'eudc)
+                        (string :tag "Argument")))))
 
 (defcustom eudc-options-file "~/.eudc-options"
   "A file where the `servers' hotlist is stored."
-  :type '(file :Tag "File Name:")
-  :group 'eudc)
+  :type '(file :Tag "File Name:"))
 
 (defcustom eudc-mode-hook nil
   "Normal hook run on entry to EUDC mode."
-  :type '(repeat (sexp :tag "Hook definition"))
-  :group 'eudc)
+  :type 'hook)
 
 ;;}}}
 
@@ -341,8 +352,7 @@ BBDB fields.  SPECs are sexps which are evaluated:
   :tag "BBDB to PH Field Name Mapping"
   :type '(repeat (cons :tag "Field Name"
                        (symbol :tag "BBDB Field")
-                       (sexp :tag "Conversion Spec")))
-  :group 'eudc-ph)
+                       (sexp :tag "Conversion Spec"))))
 
 ;;}}}
 
@@ -376,8 +386,7 @@ BBDB fields.  SPECs are sexps which are evaluated:
   :tag "BBDB to LDAP Attribute Names Mapping"
   :type '(repeat (cons :tag "Field Name"
                        (symbol :tag "BBDB Field")
-                       (sexp :tag "Conversion Spec")))
-  :group 'eudc-ldap)
+                       (sexp :tag "Conversion Spec"))))
 
 ;;}}}
 
@@ -391,14 +400,12 @@ BBDB fields.  SPECs are sexps which are evaluated:
   "If non-nil, BBDB address and phone locations are used as attribute names.
 This has no effect on queries (you can't search for a specific location)
 but influences the way records are displayed."
-  :type 'boolean
-  :group 'eudc-bbdb)
+  :type 'boolean)
 
 (defcustom eudc-bbdb-enable-substring-matches t
   "If non-nil, authorize substring match in the same way BBDB does.
 Otherwise records must match queries exactly."
-  :type 'boolean
-  :group 'eudc-bbdb)
+  :type 'boolean)
 
 ;;}}}
 
diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
index 0f2fc0be7bd..4dd80972e3f 100644
--- a/lisp/net/eudc.el
+++ b/lisp/net/eudc.el
@@ -76,10 +76,6 @@
 
 (defvar mode-popup-menu)
 
-;; List of known servers
-;; Alist of (SERVER . PROTOCOL)
-(defvar eudc-server-hotlist nil)
-
 ;; List of variables that have server- or protocol-local bindings
 (defvar eudc-local-vars nil)
 
@@ -688,7 +684,8 @@ server for future sessions."
                                                     (cons (symbol-name elt)
                                                           elt))
                                                  eudc-known-protocols)))))
-  (unless (or (member protocol
+  (unless (or (null protocol)
+              (member protocol
                       eudc-supported-protocols)
               (load (concat "eudcb-" (symbol-name protocol)) t))
     (error "Unsupported protocol: %s" protocol))
@@ -766,7 +763,6 @@ otherwise a list of symbols is returned."
                   format (cdr format)))
           ;; If the same attribute appears more than once, merge
           ;; the corresponding values
-          (setq query-alist (nreverse query-alist))
           (while query-alist
             (setq key (eudc-caar query-alist)
                   val (eudc-cdar query-alist)
@@ -812,19 +808,29 @@ If REPLACE is non-nil, then this expansion replaces the name in the buffer.
 Multiple servers can be tried with the same query until one finds a match,
 see `eudc-inline-expansion-servers'"
   (interactive)
-  (if (memq eudc-inline-expansion-servers
-            '(current-server server-then-hotlist))
-      (or eudc-server
-          (call-interactively 'eudc-set-server))
+  (cond
+   ((eq eudc-inline-expansion-servers 'current-server)
+    (or eudc-server
+        (call-interactively 'eudc-set-server)))
+   ((eq eudc-inline-expansion-servers 'server-then-hotlist)
+    (or eudc-server
+        ;; Allow server to be nil if hotlist is set.
+        eudc-server-hotlist
+        (call-interactively 'eudc-set-server)))
+   ((eq eudc-inline-expansion-servers 'hotlist)
     (or eudc-server-hotlist
         (error "No server in the hotlist")))
+   (t
+    (error "Wrong value for `eudc-inline-expansion-servers': %S"
+           eudc-inline-expansion-servers)))
   (let* ((end (point))
          (beg (save-excursion
                 (if (re-search-backward "\\([:,]\\|^\\)[ \t]*"
                                         (point-at-bol) 'move)
                     (goto-char (match-end 0)))
                 (point)))
-         (query-words (split-string (buffer-substring beg end) "[ \t]+"))
+         (query-words (split-string (buffer-substring-no-properties beg end)
+                                    "[ \t]+"))
          query-formats
          response
          response-string
@@ -840,18 +846,17 @@ see `eudc-inline-expansion-servers'"
            ((eq eudc-inline-expansion-servers 'hotlist)
             eudc-server-hotlist)
            ((eq eudc-inline-expansion-servers 'server-then-hotlist)
-            (cons (cons eudc-server eudc-protocol)
-                  (delete (cons eudc-server eudc-protocol) servers)))
+            (if eudc-server
+                (cons (cons eudc-server eudc-protocol)
+                      (delete (cons eudc-server eudc-protocol) servers))
+              eudc-server-hotlist))
            ((eq eudc-inline-expansion-servers 'current-server)
-            (list (cons eudc-server eudc-protocol)))
-           (t
-            (error "Wrong value for `eudc-inline-expansion-servers': %S"
-                   eudc-inline-expansion-servers))))
+            (list (cons eudc-server eudc-protocol)))))
     (if (and eudc-max-servers-to-query
              (> (length servers) eudc-max-servers-to-query))
         (setcdr (nthcdr (1- eudc-max-servers-to-query) servers) nil))
 
-    (condition-case signal
+    (unwind-protect
         (progn
           (setq response
                 (catch 'found
@@ -887,14 +892,15 @@ see `eudc-inline-expansion-servers'"
 
             ;; Process response through eudc-inline-expansion-format
             (while response
-              (setq response-string (apply 'format
-                                           (car eudc-inline-expansion-format)
-                                           (mapcar (function
-                                                    (lambda (field)
-                                                      (or (cdr (assq field (car response)))
-                                                          "")))
-                                                   (eudc-translate-attribute-list
-                                                    (cdr eudc-inline-expansion-format)))))
+              (setq response-string
+                    (apply 'format
+                           (car eudc-inline-expansion-format)
+                           (mapcar (function
+                                    (lambda (field)
+                                      (or (cdr (assq field (car response)))
+                                          "")))
+                                   (eudc-translate-attribute-list
+                                    (cdr eudc-inline-expansion-format)))))
               (if (> (length response-string) 0)
                   (setq response-strings
                         (cons response-string response-strings)))
@@ -916,15 +922,10 @@ see `eudc-inline-expansion-servers'"
               (delete-region beg end)
               (insert (mapconcat 'identity response-strings ", ")))
              ((eq eudc-multiple-match-handling-method 'abort)
-              (error "There is more than one match for the query"))))
-          (or (and (equal eudc-server eudc-former-server)
-                   (equal eudc-protocol eudc-former-protocol))
-              (eudc-set-server eudc-former-server eudc-former-protocol t)))
-      (error
-       (or (and (equal eudc-server eudc-former-server)
-                (equal eudc-protocol eudc-former-protocol))
-           (eudc-set-server eudc-former-server eudc-former-protocol t))
-       (signal (car signal) (cdr signal))))))
+              (error "There is more than one match for the query")))))
+      (or (and (equal eudc-server eudc-former-server)
+               (equal eudc-protocol eudc-former-protocol))
+          (eudc-set-server eudc-former-server eudc-former-protocol t)))))
 
 ;;;###autoload
 (defun eudc-query-form (&optional get-fields-from-server)
diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el
index 4c9b2490ee3..92972c5f99e 100644
--- a/lisp/net/eudcb-ldap.el
+++ b/lisp/net/eudcb-ldap.el
@@ -70,16 +70,17 @@
                      ("mail" . eudc-display-mail)
                      ("url" . eudc-display-url))
                    'ldap)
-(eudc-protocol-set 'eudc-switch-to-server-hook
-                   '(eudc-ldap-check-base)
-                   'ldap)
 
 (defun eudc-ldap-cleanup-record-simple (record)
   "Do some cleanup in a RECORD to make it suitable for EUDC."
   (mapcar
    (function
     (lambda (field)
-      (cons (intern (car field))
+      ;; Some servers return case-sensitive names (e.g. givenName
+      ;; instead of givenname); downcase the field's name so that it
+      ;; can be matched against
+      ;; eudc-ldap-attributes-translation-alist.
+      (cons (intern (downcase (car field)))
             (if (cdr (cdr field))
                 (cdr field)
               (car (cdr field))))))
@@ -95,7 +96,7 @@
   (mapcar
    (function
     (lambda (field)
-      (let ((name (intern (car field)))
+      (let ((name (intern (downcase (car field))))
             (value (cdr field)))
         (if (memq name '(postaladdress registeredaddress))
             (setq value (mapcar 'eudc-filter-$ value)))
@@ -170,14 +171,16 @@ attribute names are returned. Default to `person'"
 
 (defun eudc-ldap-format-query-as-rfc1558 (query)
   "Format the EUDC QUERY list as a RFC1558 LDAP search filter."
-  (format "(&%s)"
-          (apply 'concat
-                 (mapcar (lambda (item)
-                           (format "(%s=%s)"
-                                   (car item)
-                                   (eudc-ldap-escape-query-special-chars (cdr item))))
-                         query))))
-
+  (let ((formatter (lambda (item &optional wildcard)
+                     (format "(%s=%s)"
+                             (car item)
+                             (concat
+                              (eudc-ldap-escape-query-special-chars
+                               (cdr item)) (if wildcard "*" ""))))))
+    (format "(&%s)"
+            (concat
+             (mapconcat formatter (butlast query) "")
+             (funcall formatter (car (last query)) t)))))
 
 ;;}}}
 
diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index eb1b7589b48..a77fc3c6514 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -34,6 +34,7 @@
 ;;; Code:
 
 (require 'custom)
+(require 'password-cache)
 
 (autoload 'auth-source-search "auth-source")
 
@@ -47,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.
@@ -63,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
@@ -144,35 +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
+  :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
@@ -476,6 +474,47 @@ Additional search parameters can be specified through
                 (mapcar 'ldap-decode-attribute record))
               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.  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.
@@ -531,7 +570,11 @@ an alist of attribute/value pairs."
          (passwd (or (plist-get search-plist 'passwd)
                      (plist-get asfound :secret)))
          ;; convert the password from a function call if needed
-         (passwd (if (functionp passwd) (funcall passwd) passwd))
+         (passwd (if (functionp passwd)
+                     (if (eq passwd 'ldap-password-read)
+                         (funcall passwd host)
+                       (funcall passwd))
+                   passwd))
          ;; get the binddn from the search-list or from the
          ;; auth-source user or binddn tokens
          (binddn (or (plist-get search-plist 'binddn)
@@ -550,7 +593,7 @@ an alist of attribute/value pairs."
         (sizelimit (plist-get search-plist 'sizelimit))
         (withdn (plist-get search-plist 'withdn))
         (numres 0)
-        arglist dn name value record result)
+        arglist dn name value record result proc)
     (if (or (null filter)
             (equal "" filter))
         (error "No search filter"))
@@ -559,7 +602,13 @@ an alist of attribute/value pairs."
       (erase-buffer)
       (if (and host
                (not (equal "" host)))
-          (setq arglist (nconc arglist (list (format "-h%s" host)))))
+          (setq arglist (nconc arglist
+                               (list (format
+                                      ;; Use -H if host is a new-style LDAP URI.
+                                      (if (string-match "^[a-zA-Z]+://" host)
+                                          "-H%s"
+                                        "-h%s")
+                                      host)))))
       (if (and attrsonly
                (not (equal "" attrsonly)))
           (setq arglist (nconc arglist (list "-A"))))
@@ -575,9 +624,9 @@ an alist of attribute/value pairs."
       (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)))))
+      ;; Allow passwd to be set to "", representing a blank password.
+      (if passwd
+          (setq arglist (nconc arglist (list "-W"))))
       (if (and deref
                (not (equal "" deref)))
           (setq arglist (nconc arglist (list (format "-a%s" deref)))))
@@ -587,14 +636,43 @@ an alist of attribute/value pairs."
       (if (and sizelimit
                (not (equal "" sizelimit)))
           (setq arglist (nconc arglist (list (format "-z%s" sizelimit)))))
-      (apply #'call-process ldap-ldapsearch-prog
-             ;; Ignore stderr, which can corrupt results
-             nil (list buf nil) nil
-             (append arglist ldap-ldapsearch-args filter))
+      (if passwd
+          (let* ((process-connection-type nil)
+                 (proc-args (append arglist ldap-ldapsearch-args
+                                    filter))
+                 (proc (apply #'start-process "ldapsearch" buf
+                              ldap-ldapsearch-prog
+                              proc-args)))
+            (while (null (progn
+                           (goto-char (point-min))
+                           (re-search-forward
+                            ldap-ldapsearch-password-prompt-regexp
+                            (point-max) t)))
+              (accept-process-output proc 1))
+            (process-send-string proc passwd)
+            (process-send-string proc "\n")
+            (while (not (memq (process-status proc) '(exit signal)))
+              (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
+               (append arglist ldap-ldapsearch-args filter)))
       (insert "\n")
       (goto-char (point-min))
 
-      (while (re-search-forward "[\t\n\f]+ " nil t)
+      (while (re-search-forward (concat "[\t\n\f]+ \\|"
+                                        ldap-ldapsearch-password-prompt-regexp)
+                                nil t)
         (replace-match "" nil nil))
       (goto-char (point-min))