;;; Code:
(require 'custom)
+(require 'password-cache)
(autoload 'auth-source-search "auth-source")
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.
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
: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
(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.
(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)
(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"))
(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"))))
(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)))))
(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))