* epg.el (epg-sign-file): Signal an error only when a signature is not
[elisp/epg.git] / pgg-epg.el
index 23aced9..345cc7c 100644 (file)
@@ -1,6 +1,54 @@
+;;; pgg-epg.el --- Gnus/PGG backend of EasyPG.
+;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
+;;   2005, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 2006 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Keywords: PGP, GnuPG
+
+;; This file is part of EasyPG.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.         See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Code:
+
 (require 'epg)
 (eval-when-compile (require 'pgg))
 
+(defvar pgg-epg-secret-key-id-list nil)
+
+(defun pgg-epg-passphrase-callback (key-id ignore)
+  (if (eq key-id 'SYM)
+      (epg-passphrase-callback-function key-id nil)
+    (let* ((entry (assoc key-id epg-user-id-alist))
+          (passphrase
+           (pgg-read-passphrase
+            (format "GnuPG passphrase for %s: "
+                    (if entry
+                        (cdr entry)
+                      key-id))
+            (if (eq key-id 'PIN)
+                "PIN"
+              key-id))))
+      (when passphrase
+       (pgg-add-passphrase-to-cache key-id passphrase)
+       (setq pgg-epg-secret-key-id-list
+             (cons key-id pgg-epg-secret-key-id-list))
+       (copy-sequence passphrase)))))
+
 (defun pgg-epg-encrypt-region (start end recipients &optional sign passphrase)
   "This function is for internal use only.
 
@@ -14,11 +62,24 @@ passphrase cache or user."
        cipher)
     (epg-context-set-armor context t)
     (epg-context-set-textmode context pgg-text-mode)
-    (setq cipher (epg-encrypt-string context (buffer-substring start end)
-                                    (if pgg-encrypt-for-me
-                                        (cons pgg-default-user-id recipients)
-                                      recipients)
-                                    sign t))
+    (epg-context-set-passphrase-callback context #'pgg-epg-passphrase-callback)
+    (condition-case error
+       (setq cipher
+             (epg-encrypt-string context
+                                 (buffer-substring start end)
+                                 (mapcar
+                                  (lambda (recipient)
+                                    (car (epg-list-keys recipient)))
+                                  (if pgg-encrypt-for-me
+                                      (cons pgg-default-user-id recipients)
+                                    recipients))
+                                 sign t)
+             pgg-epg-secret-key-id-list nil)
+      (error
+       (while pgg-epg-secret-key-id-list
+        (pgg-remove-passphrase-from-cache (car pgg-epg-secret-key-id-list))
+        (setq pgg-epg-secret-key-id-list (cdr pgg-epg-secret-key-id-list)))
+       (signal (car error) (cdr error))))
     (save-excursion
       (set-buffer (get-buffer-create pgg-output-buffer))
       (erase-buffer)
@@ -45,7 +106,15 @@ passphrase cache or user."
        plain)
     (epg-context-set-armor context t)
     (epg-context-set-textmode context pgg-text-mode)
-    (setq plain (epg-decrypt-string context (buffer-substring start end)))
+    (epg-context-set-passphrase-callback context #'pgg-epg-passphrase-callback)
+    (condition-case error
+       (setq plain (epg-decrypt-string context (buffer-substring start end))
+             pgg-epg-secret-key-id-list nil)
+      (error
+       (while pgg-epg-secret-key-id-list
+        (pgg-remove-passphrase-from-cache (car pgg-epg-secret-key-id-list))
+        (setq pgg-epg-secret-key-id-list (cdr pgg-epg-secret-key-id-list)))
+       (signal (car error) (cdr error))))
     (save-excursion
       (set-buffer (get-buffer-create pgg-output-buffer))
       (erase-buffer)
@@ -63,43 +132,49 @@ passphrase cache or user."
        signature)
     (epg-context-set-armor context t)
     (epg-context-set-textmode context pgg-text-mode)
-    (setq signature (epg-sign-string context (buffer-substring start end)
-                                    (if cleartext
-                                        'cleartext
-                                      'detached)))
+    (epg-context-set-passphrase-callback context #'pgg-epg-passphrase-callback)
+    (condition-case error
+       (setq signature
+             (epg-sign-string context
+                              (buffer-substring start end)
+                              (if cleartext
+                                  'clearsign
+                                'detached))
+             pgg-epg-secret-key-id-list nil)
+      (error
+       (while pgg-epg-secret-key-id-list
+        (pgg-remove-passphrase-from-cache (car pgg-epg-secret-key-id-list))
+        (setq pgg-epg-secret-key-id-list (cdr pgg-epg-secret-key-id-list)))
+       (signal (car error) (cdr error))))
     (save-excursion
       (set-buffer (get-buffer-create pgg-output-buffer))
+      (erase-buffer)
       (insert signature))
     t))
 
-(defvar pgg-epg-signature nil)
+(defvar pgg-epg-signatures nil)
 
 (defun pgg-epg-verify-region (start end &optional signature)
   "This function is for internal use only.
 
 Verify region between START and END as the detached signature SIGNATURE."
-  (let ((context (epg-make-context))
-       pointer)
+  (let ((context (epg-make-context)))
     (epg-context-set-armor context t)
     (epg-context-set-textmode context pgg-text-mode)
     (if signature
-       (epg-verify-file context signature (buffer-substring start end))
+       (epg-verify-string context
+                          (with-temp-buffer
+                            (insert-file-contents signature)
+                            (buffer-string))
+                          (buffer-substring start end))
       (epg-verify-string context (buffer-substring start end)))
-    (setq signature (reverse (epg-context-result-for context 'verify))
-         pointer signature)
     (save-excursion
       (set-buffer (get-buffer-create pgg-errors-buffer))
-      (make-local-variable 'pgg-epg-signature)
-      (setq pgg-epg-signature (car signature))
+      (make-local-variable 'pgg-epg-signatures)
+      (setq pgg-epg-signatures (epg-context-result-for context 'verify))
       (erase-buffer)
-      (while pointer
-       (insert (format "%s: %s %s %s\n"
-                       (epg-signature-status (car pointer))
-                       (epg-signature-key-id (car pointer))
-                       (epg-signature-user-id (car pointer))
-                       (epg-signature-validity (car pointer))))
-       (setq pointer (cdr pointer))))
-    signature))
+      (insert (epg-verify-result-to-string pgg-epg-signatures)))
+    t))
 
 (defun pgg-epg-insert-key ()
   "This function is for internal use only.
@@ -122,14 +197,14 @@ Add all public keys in region between START and END to the keyring."
     (epg-import-keys context (buffer-substring start end))))
 
 (defun mml2015-gpg-extract-signature-details ()
-  (if pgg-epg-signature
-      (let* ((expired (eq (epg-signature-status pgg-epg-signature)
+  (if pgg-epg-signatures
+      (let* ((expired (eq (epg-signature-status (car pgg-epg-signatures))
                          'key-expired))
-            (signer (cons (epg-signature-key-id pgg-epg-signature)
-                          (epg-signature-user-id pgg-epg-signature)))
-            (fprint (epg-signature-fingerprint pgg-epg-signature))
+            (signer (cons (epg-signature-key-id (car pgg-epg-signatures))
+                          (epg-signature-user-id (car pgg-epg-signatures))))
+            (fprint (epg-signature-fingerprint (car pgg-epg-signatures)))
             (trust-good-enough-p
-             (memq (epg-signature-validity pgg-epg-signature)
+             (memq (epg-signature-validity (car pgg-epg-signatures))
                    '(marginal fully ultimate))))
        (cond ((and signer fprint)
               (concat (cdr signer)