diff options
Diffstat (limited to 'lisp/epg.el')
| -rw-r--r-- | lisp/epg.el | 80 |
1 files changed, 71 insertions, 9 deletions
diff --git a/lisp/epg.el b/lisp/epg.el index 340fc76fb8c..c36de7e4624 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -37,6 +37,8 @@ (defvar epg-key-id nil) (defvar epg-context nil) (defvar epg-debug-buffer nil) +(defvar epg-agent-file nil) +(defvar epg-agent-mtime nil) ;; from gnupg/include/cipher.h (defconst epg-cipher-algorithm-alist @@ -161,6 +163,7 @@ (defvar epg-prompt-alist nil) (put 'epg-error 'error-conditions '(epg-error error)) +(put 'epg-error 'error-message "GPG error") (defun epg-make-data-from-file (file) "Make a data object from FILE." @@ -192,7 +195,7 @@ cipher-algorithm digest-algorithm compress-algorithm (list #'epg-passphrase-callback-function) nil - nil nil nil nil nil nil))) + nil nil nil nil nil nil nil))) (defun epg-context-protocol (context) "Return the protocol used within CONTEXT." @@ -286,6 +289,12 @@ This function is for internal use only." (signal 'wrong-type-argument (list 'epg-context-p context))) (aref (cdr context) 14)) +(defun epg-context-pinentry-mode (context) + "Return the mode of pinentry invocation." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (aref (cdr context) 15)) + (defun epg-context-set-protocol (context protocol) "Set the protocol used within CONTEXT." (unless (eq (car-safe context) 'epg-context) @@ -404,6 +413,14 @@ This function is for internal use only." (signal 'wrong-type-argument (list 'epg-context-p context))) (aset (cdr context) 14 operation)) +(defun epg-context-set-pinentry-mode (context mode) + "Set the mode of pinentry invocation." + (unless (eq (car-safe context) 'epg-context) + (signal 'wrong-type-argument (list 'epg-context-p context))) + (unless (memq mode '(nil ask cancel error loopback)) + (signal 'epg-error (list "Unknown pinentry mode" mode))) + (aset (cdr context) 15 mode)) + (defun epg-make-signature (status &optional key-id) "Return a signature object." (cons 'epg-signature (vector status key-id nil nil nil nil nil nil nil nil @@ -970,7 +987,8 @@ This function is for internal use only." "Convert SIGNATURE to a human readable string." (let* ((user-id (cdr (assoc (epg-signature-key-id signature) epg-user-id-alist))) - (pubkey-algorithm (epg-signature-pubkey-algorithm signature))) + (pubkey-algorithm (epg-signature-pubkey-algorithm signature)) + (key-id (epg-signature-key-id signature))) (concat (cond ((eq (epg-signature-status signature) 'good) "Good signature from ") @@ -984,7 +1002,7 @@ This function is for internal use only." "Signature made by revoked key ") ((eq (epg-signature-status signature) 'no-pubkey) "No public key for ")) - (epg-signature-key-id signature) + key-id (if user-id (concat " " (if (stringp user-id) @@ -1130,12 +1148,12 @@ This function is for internal use only." (if (eq (epg-context-protocol context) 'CMS) epg-gpgsm-program epg-gpg-program))) - (let* ((args (append (list "--no-tty" + (let* ((agent-info (getenv "GPG_AGENT_INFO")) + (args (append (list "--no-tty" "--status-fd" "1" "--yes") (if (and (not (eq (epg-context-protocol context) 'CMS)) - (string-match ":" (or (getenv "GPG_AGENT_INFO") - ""))) + (string-match ":" (or agent-info ""))) '("--use-agent")) (if (and (not (eq (epg-context-protocol context) 'CMS)) (epg-context-progress-callback context)) @@ -1148,20 +1166,53 @@ This function is for internal use only." (if (epg-context-textmode context) '("--textmode")) (if (epg-context-output-file context) (list "--output" (epg-context-output-file context))) + (if (epg-context-pinentry-mode context) + (list "--pinentry-mode" + (symbol-name (epg-context-pinentry-mode + context)))) args)) (coding-system-for-write 'binary) (coding-system-for-read 'binary) process-connection-type + (process-environment process-environment) (orig-mode (default-file-modes)) (buffer (generate-new-buffer " *epg*")) - process) + process + terminal-name + agent-file + (agent-mtime '(0 0 0 0))) + ;; Set GPG_TTY and TERM for pinentry-curses. Note that we can't + ;; use `terminal-name' here to get the real pty name for the child + ;; process, though /dev/fd/0" is not portable. + (unless (memq system-type '(ms-dos windows-nt)) + (with-temp-buffer + (condition-case nil + (when (= (call-process "tty" "/dev/fd/0" t) 0) + (delete-char -1) + (setq terminal-name (buffer-string))) + (file-error)))) + (when terminal-name + (setq process-environment + (cons (concat "GPG_TTY=" terminal-name) + (cons "TERM=xterm" process-environment)))) + ;; Record modified time of gpg-agent socket to restore the Emacs + ;; frame on text terminal in `epg-wait-for-completion'. + ;; See + ;; <http://lists.gnu.org/archive/html/emacs-devel/2007-02/msg00755.html> + ;; for more details. + (when (and agent-info (string-match "\\(.*\\):[0-9]+:[0-9]+" agent-info)) + (setq agent-file (match-string 1 agent-info) + agent-mtime (or (nth 5 (file-attributes agent-file)) '(0 0 0 0)))) (if epg-debug (save-excursion (unless epg-debug-buffer (setq epg-debug-buffer (generate-new-buffer " *epg-debug*"))) (set-buffer epg-debug-buffer) (goto-char (point-max)) - (insert (format "%s %s\n" + (insert (if agent-info + (format "GPG_AGENT_INFO=%s\n" agent-info) + "GPG_AGENT_INFO is not set\n") + (format "%s %s\n" (if (eq (epg-context-protocol context) 'CMS) epg-gpgsm-program epg-gpg-program) @@ -1180,7 +1231,11 @@ This function is for internal use only." (make-local-variable 'epg-key-id) (setq epg-key-id nil) (make-local-variable 'epg-context) - (setq epg-context context)) + (setq epg-context context) + (make-local-variable 'epg-agent-file) + (setq epg-agent-file agent-file) + (make-local-variable 'epg-agent-mtime) + (setq epg-agent-mtime agent-mtime)) (unwind-protect (progn (set-default-file-modes 448) @@ -1257,6 +1312,13 @@ This function is for internal use only." (accept-process-output (epg-context-process context) 1)) ;; This line is needed to run the process-filter right now. (sleep-for 0.1) + ;; Restore Emacs frame on text terminal, when pinentry-curses has terminated. + (if (with-current-buffer (process-buffer (epg-context-process context)) + (and epg-agent-file + (> (float-time (or (nth 5 (file-attributes epg-agent-file)) + '(0 0 0 0))) + (float-time epg-agent-mtime)))) + (redraw-frame (selected-frame))) (epg-context-set-result-for context 'error (nreverse (epg-context-result-for context 'error)))) |