Add password-cache support to ldap.el

* 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.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 658f5b6ca84a0dd6bedd63cef99e22e27efd6e28..dc27519765c373eb4be26cfd049325186a541123 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,10 @@
+2014-11-13  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.
+
 2014-11-13  Thomas Fitzsimmons  <fitzsim@fitzsim.org>
 
        * net/eudc-vars.el (eudc-expansion-overwrites-query): Change

diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index 2b5b2fb89a5256a4cf85df63b8891fe5780f7a27..113a9bcd5ff82749603993eacb4af34f4362379d 100644 (file)
--- 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")
 
@@ -476,6 +477,20 @@ 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 and the password is cached.  The cache can be cleared
+with `password-reset`."
+  ;; 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)))
 
 (defun ldap-search-internal (search-plist)
   "Perform a search on a LDAP server.
@@ -531,7 +546,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)