X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/4fc35edd5fcdfe258c04cfed707753fdd8795a72..4b9ac23960d2998f899287ffcf696ad33b63a69a:/lisp/epg.el diff --git a/lisp/epg.el b/lisp/epg.el index f66545306d..315eb40f0a 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -1,5 +1,5 @@ ;;; epg.el --- the EasyPG Library -*- lexical-binding: t -*- -;; Copyright (C) 1999-2000, 2002-2015 Free Software Foundation, Inc. +;; Copyright (C) 1999-2000, 2002-2016 Free Software Foundation, Inc. ;; Author: Daiki Ueno ;; Keywords: PGP, GnuPG @@ -40,7 +40,6 @@ (defvar epg-debug-buffer nil) (defvar epg-agent-file nil) (defvar epg-agent-mtime nil) -(defvar epg-error-output nil) ;; from gnupg/include/cipher.h (defconst epg-cipher-algorithm-alist @@ -187,11 +186,11 @@ compress-algorithm &aux (program - (pcase protocol - (`OpenPGP epg-gpg-program) - (`CMS epg-gpgsm-program) - (_ (signal 'epg-error - (list "unknown protocol" protocol))))))) + (let ((configuration (epg-find-configuration protocol))) + (unless configuration + (signal 'epg-error + (list "no usable configuration" protocol))) + (alist-get 'program configuration))))) (:copier nil) (:predicate nil)) protocol @@ -213,7 +212,8 @@ result operation pinentry-mode - (error-output "")) + (error-output "") + error-buffer) ;; This is not an alias, just so we can mark it as autoloaded. ;;;###autoload @@ -551,6 +551,8 @@ callback data (if any)." (defun epg-errors-to-string (errors) (mapconcat #'epg-error-to-string errors "; ")) +(declare-function pinentry-start "pinentry" (&optional quiet)) + (defun epg--start (context args) "Start `epg-gpg-program' in a subprocess with given ARGS." (if (and (epg-context-process context) @@ -581,11 +583,9 @@ callback data (if any)." (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) (buffer (generate-new-buffer " *epg*")) + error-process process terminal-name agent-file @@ -604,6 +604,26 @@ callback data (if any)." (setq process-environment (cons (concat "GPG_TTY=" terminal-name) (cons "TERM=xterm" process-environment)))) + ;; Automatically start the Emacs Pinentry server if appropriate. + (when (and (fboundp 'pinentry-start) + ;; Emacs Pinentry is useless if Emacs has no interactive session. + (not noninteractive) + ;; Prefer pinentry-mode over Emacs Pinentry. + (null (epg-context-pinentry-mode context)) + ;; Check if the allow-emacs-pinentry option is set. + (executable-find epg-gpgconf-program) + (with-temp-buffer + (when (= (call-process epg-gpgconf-program nil t nil + "--list-options" "gpg-agent") + 0) + (goto-char (point-min)) + (re-search-forward + "^allow-emacs-pinentry:\\(?:.*:\\)\\{8\\}1" + nil t)))) + (pinentry-start 'quiet)) + (setq process-environment + (cons (format "INSIDE_EMACS=%s,epg" emacs-version) + process-environment)) ;; Record modified time of gpg-agent socket to restore the Emacs ;; frame on text terminal in `epg-wait-for-completion'. ;; See @@ -642,13 +662,24 @@ callback data (if any)." (make-local-variable 'epg-agent-file) (setq epg-agent-file agent-file) (make-local-variable 'epg-agent-mtime) - (setq epg-agent-mtime agent-mtime) - (make-local-variable 'epg-error-output) - (setq epg-error-output nil)) + (setq epg-agent-mtime agent-mtime)) + (setq error-process + (make-pipe-process :name "epg-error" + :buffer (generate-new-buffer " *epg-error*") + ;; Suppress "XXX finished" line. + :sentinel #'ignore + :noquery t)) + (setf (epg-context-error-buffer context) (process-buffer error-process)) (with-file-modes 448 - (setq process (apply #'start-process "epg" buffer - (epg-context-program context) args))) - (set-process-filter process #'epg--process-filter) + (setq process (make-process :name "epg" + :buffer buffer + :command (cons (epg-context-program context) + args) + :connection-type 'pipe + :coding '(binary . binary) + :filter #'epg--process-filter + :stderr error-process + :noquery t))) (setf (epg-context-process context) process))) (defun epg--process-filter (process input) @@ -690,14 +721,7 @@ callback data (if any)." (if (and symbol (fboundp symbol)) (funcall symbol epg-context string))) - (setq epg-last-status (cons status string))) - ;; Record other lines sent to stderr. This assumes - ;; that the process-filter receives output only from - ;; stderr and the FD specified with --status-fd. - (setq epg-error-output - (cons (buffer-substring (point) - (line-end-position)) - epg-error-output))) + (setq epg-last-status (cons status string)))) (forward-line) (setq epg-read-point (point))))))))) @@ -740,15 +764,17 @@ callback data (if any)." (epg-context-set-result-for context 'error (nreverse (epg-context-result-for context 'error))) - (with-current-buffer (process-buffer (epg-context-process context)) - (setf (epg-context-error-output context) - (mapconcat #'identity (nreverse epg-error-output) "\n")))) + (setf (epg-context-error-output context) + (with-current-buffer (epg-context-error-buffer context) + (buffer-string)))) (defun epg-reset (context) "Reset the CONTEXT." (if (and (epg-context-process context) (buffer-live-p (process-buffer (epg-context-process context)))) (kill-buffer (process-buffer (epg-context-process context)))) + (if (buffer-live-p (epg-context-error-buffer context)) + (kill-buffer (epg-context-error-buffer context))) (setf (epg-context-process context) nil) (setf (epg-context-edit-callback context) nil)) @@ -1317,8 +1343,8 @@ callback data (if any)." (defun epg-list-keys (context &optional name mode) "Return a list of epg-key objects matched with NAME. -If MODE is nil or 'public, only public keyring should be searched. -If MODE is t or 'secret, only secret keyring should be searched. +If MODE is nil or `public', only public keyring should be searched. +If MODE is t or `secret', only secret keyring should be searched. Otherwise, only public keyring should be searched and the key signatures should be included. NAME is either a string or a list of strings." @@ -1594,7 +1620,7 @@ handle the case where SIGNATURE has multiple signature. To check the verification results, use `epg-context-result-for' as follows: -\(epg-context-result-for context 'verify) +\(epg-context-result-for context \\='verify) which will return a list of `epg-signature' object." (unwind-protect @@ -1629,7 +1655,7 @@ handle the case where SIGNATURE has multiple signature. To check the verification results, use `epg-context-result-for' as follows: -\(epg-context-result-for context 'verify) +\(epg-context-result-for context \\='verify) which will return a list of `epg-signature' object." (let ((coding-system-for-write 'binary) @@ -1658,8 +1684,8 @@ which will return a list of `epg-signature' object." "Initiate a sign operation on PLAIN. PLAIN is a data object. -If optional 3rd argument MODE is t or 'detached, it makes a detached signature. -If it is nil or 'normal, it makes a normal signature. +If optional 3rd argument MODE is t or `detached', it makes a detached signature. +If it is nil or `normal', it makes a normal signature. Otherwise, it makes a cleartext signature. If you use this function, you will need to wait for the completion of @@ -1702,8 +1728,8 @@ If you are unsure, use synchronous version of this function (defun epg-sign-file (context plain signature &optional mode) "Sign a file PLAIN and store the result to a file SIGNATURE. If SIGNATURE is nil, it returns the result as a string. -If optional 3rd argument MODE is t or 'detached, it makes a detached signature. -If it is nil or 'normal, it makes a normal signature. +If optional 3rd argument MODE is t or `detached', it makes a detached signature. +If it is nil or `normal', it makes a normal signature. Otherwise, it makes a cleartext signature." (unwind-protect (progn @@ -1723,16 +1749,11 @@ Otherwise, it makes a cleartext signature." (defun epg-sign-string (context plain &optional mode) "Sign a string PLAIN and return the output as string. -If optional 3rd argument MODE is t or 'detached, it makes a detached signature. -If it is nil or 'normal, it makes a normal signature. +If optional 3rd argument MODE is t or `detached', it makes a detached signature. +If it is nil or `normal', it makes a normal signature. Otherwise, it makes a cleartext signature." (let ((input-file - (unless (or (eq (epg-context-protocol context) 'CMS) - (condition-case nil - (progn - (epg-check-configuration (epg-configuration)) - t) - (error))) + (unless (eq (epg-context-protocol context) 'CMS) (epg--make-temp-file "epg-input"))) (coding-system-for-write 'binary)) (unwind-protect @@ -1839,12 +1860,7 @@ If RECIPIENTS is nil, it performs symmetric encryption." If RECIPIENTS is nil, it performs symmetric encryption." (let ((input-file (unless (or (not sign) - (eq (epg-context-protocol context) 'CMS) - (condition-case nil - (progn - (epg-check-configuration (epg-configuration)) - t) - (error))) + (eq (epg-context-protocol context) 'CMS)) (epg--make-temp-file "epg-input"))) (coding-system-for-write 'binary)) (unwind-protect @@ -2051,7 +2067,9 @@ If you are unsure, use synchronous version of this function (defun epg-start-generate-key (context parameters) "Initiate a key generation. -PARAMETERS specifies parameters for the key. +PARAMETERS is a string which specifies parameters of the generated key. +See Info node `(gnupg) Unattended GPG key generation' in the +GnuPG manual for the format. If you use this function, you will need to wait for the completion of `epg-gpg-program' by using `epg-wait-for-completion' and call @@ -2061,9 +2079,9 @@ If you are unsure, use synchronous version of this function (setf (epg-context-operation context) 'generate-key) (setf (epg-context-result context) nil) (if (epg-data-file parameters) - (epg--start context (list "--batch" "--genkey" "--" + (epg--start context (list "--batch" "--gen-key" "--" (epg-data-file parameters))) - (epg--start context '("--batch" "--genkey")) + (epg--start context '("--batch" "--gen-key")) (if (eq (process-status (epg-context-process context)) 'run) (process-send-string (epg-context-process context) (epg-data-string parameters))) @@ -2177,7 +2195,7 @@ The return value is an alist mapping from types to values." (if (eq index (string-match "[ \t\n\r]*" string index)) (setq index (match-end 0))) (if (eq index (string-match - "\\([0-9]+\\(\\.[0-9]+\\)*\\)\[ \t\n\r]*=[ \t\n\r]*" + "\\([0-9]+\\(\\.[0-9]+\\)*\\)[ \t\n\r]*=[ \t\n\r]*" string index)) (setq type (match-string 1 string) index (match-end 0))