diff options
Diffstat (limited to 'lisp/net/ldap.el')
| -rw-r--r-- | lisp/net/ldap.el | 136 |
1 files changed, 107 insertions, 29 deletions
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)) |