]> code.delx.au - gnu-emacs/blobdiff - lisp/epg.el
Remove compatibility with Emacs 24.3 in octave-mode
[gnu-emacs] / lisp / epg.el
index 520ff8d78b7015f3f8c04102ec6683d86bc7bd7f..315eb40f0a45615cc5488badd6bd938101ca5219 100644 (file)
@@ -1,5 +1,5 @@
 ;;; epg.el --- the EasyPG Library -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2000, 2002-2014 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2000, 2002-2016 Free Software Foundation, Inc.
 
 ;; Author: Daiki Ueno <ueno@unixuser.org>
 ;; 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
                           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
   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))