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.
This commit is contained in:
Daiki Ueno
parent
3a23c477d9
commit
e086e55a66
1 changed files with 105 additions and 46 deletions
|
|
@ -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))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue