From: Daiki Ueno Date: Tue, 18 Aug 2015 02:55:26 +0000 (+0900) Subject: pinentry.el: Support external passphrase cache X-Git-Tag: emacs-25.0.90~1367 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=e086e55a664ec27fbca7b3231c4b32cb78a89337;p=emacs.git pinentry.el: Support external passphrase cache * lisp/net/pinentry.el (pinentry-use-secrets): New user option. (pinentry--allow-external-password-cache): New local variable. (pinentry--key-info): New local variable. (secrets-enabled, secrets-search-items, secrets-get-secret): Declare. (pinentry--send-passphrase): New function, split from `pinentry--process-filter'. (pinentry--process-filter): Use secrets.el to retrieve passphrase from login keyring. --- diff --git a/lisp/net/pinentry.el b/lisp/net/pinentry.el index 13a15c964ab..aee86473e10 100644 --- a/lisp/net/pinentry.el +++ b/lisp/net/pinentry.el @@ -63,6 +63,11 @@ :type 'integer :group 'pinentry) +(defcustom pinentry-use-secrets nil + "If non-nil, use secrets.el to store passwords in login keyring." + :type 'boolean + :group 'pinentry) + (defvar pinentry--server-process nil) (defvar pinentry--connection-process-list nil) @@ -70,6 +75,10 @@ (put 'pinentry-read-point 'permanent-local t) (defvar pinentry--read-point nil) (put 'pinentry--read-point 'permanent-local t) +(defvar pinentry--allow-external-password-cache nil) +(put 'pinentry--allow-external-password-cache 'permanent-local t) +(defvar pinentry--key-info nil) +(put 'pinentry--key-info 'permanent-local t) (defvar pinentry--prompt-buffer nil) @@ -143,6 +152,10 @@ If local sockets are not supported, this is nil.") (concat prompt (substring short-prompt -2)) query-args))) +(defvar secrets-enabled) +(declare-function secrets-search-items "secrets" (collection &rest attributes)) +(declare-function secrets-get-secret "secrets" (collection item)) + ;;;###autoload (defun pinentry-start () "Start a Pinentry service. @@ -277,6 +290,23 @@ Assuan protocol." (defun pinentry--send-error (process error) (process-send-string process (format "ERR %d %s\n" (car error) (cdr error)))) +(defun pinentry--send-passphrase (process passphrase) + (let (escaped-passphrase encoded-passphrase) + (unwind-protect + (condition-case nil + (progn + (setq escaped-passphrase (pinentry--escape-string passphrase)) + (setq encoded-passphrase (encode-coding-string escaped-passphrase + 'utf-8)) + (pinentry--send-data process encoded-passphrase) + (process-send-string process "OK\n")) + (error + (pinentry--send-error process pinentry--error-cancelled))) + (if escaped-passphrase + (clear-string escaped-passphrase)) + (if encoded-passphrase + (clear-string encoded-passphrase))))) + (defun pinentry--process-filter (process input) (unless (buffer-live-p (process-buffer process)) (let ((buffer (generate-new-buffer " *pinentry*"))) @@ -286,7 +316,9 @@ Assuan protocol." (set-buffer-multibyte nil)) (make-local-variable 'pinentry--read-point) (setq pinentry--read-point (point-min)) - (make-local-variable 'pinentry--labels)))) + (make-local-variable 'pinentry--labels) + (make-local-variable 'pinentry--allow-external-password-cache) + (make-local-variable 'pinentry--key-info)))) (with-current-buffer (process-buffer process) (save-excursion (goto-char (point-max)) @@ -311,52 +343,79 @@ Assuan protocol." ("NOP" (ignore-errors (process-send-string process "OK\n"))) + ("OPTION" + (if (and pinentry-use-secrets + (require 'secrets) + secrets-enabled + (equal string "allow-external-password-cache")) + (setq pinentry--allow-external-password-cache t)) + (ignore-errors + (process-send-string process "OK\n"))) + ("SETKEYINFO" + (setq pinentry--key-info string) + (ignore-errors + (process-send-string process "OK\n"))) ("GETPIN" - (let ((prompt - (or (cdr (assq 'desc pinentry--labels)) - (cdr (assq 'prompt pinentry--labels)) - "")) - (confirm (not (null (assq 'repeat pinentry--labels)))) - entry) - (if (setq entry (assq 'error pinentry--labels)) - (setq prompt (concat "Error: " - (propertize - (copy-sequence (cdr entry)) - 'face 'error) - "\n" - prompt))) - (if (setq entry (assq 'title pinentry--labels)) - (setq prompt (format "[%s] %s" - (cdr entry) prompt))) - (let (passphrase escaped-passphrase encoded-passphrase) - (unwind-protect - (condition-case nil - (progn - (setq passphrase - (pinentry--prompt prompt "Password: " - #'read-passwd confirm)) - (setq escaped-passphrase - (pinentry--escape-string - passphrase)) - (setq encoded-passphrase (encode-coding-string - escaped-passphrase - 'utf-8)) - (ignore-errors - (pinentry--send-data - process encoded-passphrase) - (process-send-string process "OK\n"))) - (error - (ignore-errors - (pinentry--send-error - process - pinentry--error-cancelled)))) - (if passphrase - (clear-string passphrase)) - (if escaped-passphrase - (clear-string escaped-passphrase)) - (if encoded-passphrase - (clear-string encoded-passphrase)))) - (setq pinentry--labels nil))) + (let (passphrase-sent) + (when (and pinentry--allow-external-password-cache + pinentry--key-info) + (let ((items + (secrets-search-items "login" + :keygrip pinentry--key-info))) + (if items + (let (passphrase) + (unwind-protect + (progn + (setq passphrase (secrets-get-secret + "login" + (car items))) + (ignore-errors + (process-send-string + process + "S PASSWORD_FROM_CACHE\n") + (pinentry--send-passphrase + process passphrase) + (setq passphrase-sent t))) + (if passphrase + (clear-string passphrase))))))) + (unless passphrase-sent + (let ((prompt + (or (cdr (assq 'desc pinentry--labels)) + (cdr (assq 'prompt pinentry--labels)) + "")) + (confirm + (not (null (assq 'repeat pinentry--labels)))) + entry) + (if (setq entry (assq 'error pinentry--labels)) + (setq prompt (concat "Error: " + (propertize + (copy-sequence (cdr entry)) + 'face 'error) + "\n" + prompt))) + (if (setq entry (assq 'title pinentry--labels)) + (setq prompt (format "[%s] %s" + (cdr entry) prompt))) + (let (passphrase) + (unwind-protect + (condition-case nil + (progn + (setq passphrase + (pinentry--prompt prompt "Password: " + #'read-passwd + confirm)) + (ignore-errors + (pinentry--send-passphrase process + passphrase) + (process-send-string process "OK\n"))) + (error + (ignore-errors + (pinentry--send-error + process + pinentry--error-cancelled)))) + (if passphrase + (clear-string passphrase)))) + (setq pinentry--labels nil))))) ("CONFIRM" (let ((prompt (or (cdr (assq 'desc pinentry--labels))