OSDN Git Service

Add "(tiny change)".
[epg/epg.git] / pgg-epg.el
index e21faa2..16fe555 100644 (file)
@@ -1,10 +1,10 @@
-;;; pgg-epg.el --- Gnus/PGG backend of EasyPG.
+;;; pgg-epg.el --- GnusPGG 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
+;; Keywords: PGP, GnuPG, Gnus
 
 ;; This file is part of EasyPG.
 
 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 ;; Boston, MA 02110-1301, USA.
 
+;;; Commentary:
+
+;; To use, add (setq pgg-scheme 'epg) to your ~/.gnus.
+
 ;;; Code:
 
-(require 'epg)
+(require 'epa)
 (eval-when-compile (require 'pgg))
 
 (defvar pgg-epg-secret-key-id-list nil)
 
-(defun pgg-epg-passphrase-callback (key-id ignore)
+(defun pgg-epg-passphrase-callback (context key-id ignore)
   (if (eq key-id 'SYM)
-      (epg-passphrase-callback-function key-id nil)
+      (epa-passphrase-callback-function context key-id nil)
     (let* ((entry (assoc key-id epg-user-id-alist))
           (passphrase
            (pgg-read-passphrase
@@ -49,6 +53,7 @@
              (cons key-id pgg-epg-secret-key-id-list))
        (copy-sequence passphrase)))))
 
+(defvar inhibit-redisplay)
 (defun pgg-epg-encrypt-region (start end recipients &optional sign passphrase)
   "This function is for internal use only.
 
@@ -59,23 +64,36 @@ If optional argument SIGN is non-nil, do a combined sign and encrypt.
 If optional PASSPHRASE is not specified, it will be obtained from the
 passphrase cache or user."
   (let ((context (epg-make-context))
-       cipher)
+       (inhibit-redisplay t)           ;Gnus users don't like flickering
+       cipher recipient-keys)
     (epg-context-set-armor context t)
     (epg-context-set-textmode context pgg-text-mode)
     (epg-context-set-passphrase-callback context #'pgg-epg-passphrase-callback)
-    (get-buffer-create pgg-output-buffer)
-    (get-buffer-create pgg-errors-buffer)
+    (save-excursion
+      (set-buffer (get-buffer-create pgg-output-buffer))
+      (erase-buffer)
+      (set-buffer (get-buffer-create pgg-errors-buffer))
+      (erase-buffer))
     (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)
+             (epg-encrypt-string
+              context
+              (buffer-substring start end)
+              (apply #'nconc
+                     (mapcar
+                      (lambda (recipient)
+                        (setq recipient-keys
+                              (epg-list-keys context recipient))
+                        (unless (or recipient-keys
+                                    (y-or-n-p
+                                     (format "No public key for %s; skip it? "
+                                             recipient)))
+                          (error "No public key for %s" recipient))
+                        recipient-keys)
+                      (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
@@ -84,7 +102,6 @@ passphrase cache or user."
        (signal (car error) (cdr error))))
     (save-excursion
       (set-buffer (get-buffer-create pgg-output-buffer))
-      (erase-buffer)
       (insert cipher))
     t))
 
@@ -105,23 +122,30 @@ Decrypt the current region between START and END.
 If optional PASSPHRASE is not specified, it will be obtained from the
 passphrase cache or user."
   (let ((context (epg-make-context))
+       (inhibit-redisplay t)           ;Gnus users don't like flickering
        plain)
     (epg-context-set-armor context t)
     (epg-context-set-textmode context pgg-text-mode)
     (epg-context-set-passphrase-callback context #'pgg-epg-passphrase-callback)
-    (get-buffer-create pgg-output-buffer)
-    (get-buffer-create pgg-errors-buffer)
+    (save-excursion
+      (set-buffer (get-buffer-create pgg-output-buffer))
+      (erase-buffer)
+      (set-buffer (get-buffer-create pgg-errors-buffer))
+      (erase-buffer))
     (condition-case error
-       (setq plain (epg-decrypt-string context (buffer-substring start end))
+       (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))))
+    (if (and pgg-text-mode
+            (fboundp 'decode-coding-string))
+       (setq plain (decode-coding-string plain 'raw-text)))
     (save-excursion
       (set-buffer (get-buffer-create pgg-output-buffer))
-      (erase-buffer)
       (insert plain))
     t))
 
@@ -133,18 +157,25 @@ Make detached signature from text between START and END.
 If optional PASSPHRASE is not specified, it will be obtained from the
 passphrase cache or user."
   (let ((context (epg-make-context))
+       (inhibit-redisplay t)           ;Gnus users don't like flickering
        signature)
     (epg-context-set-armor context t)
     (epg-context-set-textmode context pgg-text-mode)
     (epg-context-set-passphrase-callback context #'pgg-epg-passphrase-callback)
-    (get-buffer-create pgg-output-buffer)
-    (get-buffer-create pgg-errors-buffer)
+    (epg-context-set-signers
+     context
+     (list (car (epg-list-keys context pgg-default-user-id t))))
+    (save-excursion
+      (set-buffer (get-buffer-create pgg-output-buffer))
+      (erase-buffer)
+      (set-buffer (get-buffer-create pgg-errors-buffer))
+      (erase-buffer))
     (condition-case error
        (setq signature
              (epg-sign-string context
                               (buffer-substring start end)
                               (if cleartext
-                                  'clearsign
+                                  'clear
                                 'detached))
              pgg-epg-secret-key-id-list nil)
       (error
@@ -154,7 +185,6 @@ passphrase cache or user."
        (signal (car error) (cdr error))))
     (save-excursion
       (set-buffer (get-buffer-create pgg-output-buffer))
-      (erase-buffer)
       (insert signature))
     t))
 
@@ -164,11 +194,15 @@ passphrase cache or user."
   "This function is for internal use only.
 
 Verify region between START and END as the detached signature SIGNATURE."
-  (let ((context (epg-make-context)))
+  (let ((context (epg-make-context))
+       (inhibit-redisplay t))          ;Gnus users don't like flickering
     (epg-context-set-armor context t)
     (epg-context-set-textmode context pgg-text-mode)
-    (get-buffer-create pgg-output-buffer)
-    (get-buffer-create pgg-errors-buffer)
+    (save-excursion
+      (set-buffer (get-buffer-create pgg-output-buffer))
+      (erase-buffer)
+      (set-buffer (get-buffer-create pgg-errors-buffer))
+      (erase-buffer))
     (if signature
        (epg-verify-string context
                           (with-temp-buffer
@@ -180,7 +214,6 @@ Verify region between START and END as the detached signature SIGNATURE."
       (set-buffer (get-buffer-create pgg-errors-buffer))
       (make-local-variable 'pgg-epg-signatures)
       (setq pgg-epg-signatures (epg-context-result-for context 'verify))
-      (erase-buffer)
       (insert (epg-verify-result-to-string pgg-epg-signatures)))
     t))
 
@@ -189,31 +222,47 @@ Verify region between START and END as the detached signature SIGNATURE."
 
 Insert public key at point."
   (let ((context (epg-make-context))
-       pointer)
+       (inhibit-redisplay t)           ;Gnus users don't like flickering
+       )
     (epg-context-set-armor context t)
     (epg-context-set-textmode context pgg-text-mode)
-    (insert (epg-export-keys context pgg-default-user-id))))
+    (save-excursion
+      (set-buffer (get-buffer-create pgg-output-buffer))
+      (erase-buffer)
+      (set-buffer (get-buffer-create pgg-errors-buffer))
+      (erase-buffer))
+    (insert (epg-export-keys-to-string context pgg-default-user-id))))
 
 (defun pgg-epg-snarf-keys-region (start end)
   "This function is for internal use only.
 
 Add all public keys in region between START and END to the keyring."
   (let ((context (epg-make-context))
-       pointer)
+       (inhibit-redisplay t)           ;Gnus users don't like flickering
+       )
     (epg-context-set-armor context t)
     (epg-context-set-textmode context pgg-text-mode)
-    (epg-import-keys context (buffer-substring start end))))
+    (save-excursion
+      (set-buffer (get-buffer-create pgg-output-buffer))
+      (erase-buffer)
+      (set-buffer (get-buffer-create pgg-errors-buffer))
+      (erase-buffer))
+    (epg-import-keys-from-string context (buffer-substring start end))))
 
+(eval-when-compile
+  (autoload 'mml2015-gpg-pretty-print-fpr "mml2015"))
 (defun mml2015-gpg-extract-signature-details ()
   (if pgg-epg-signatures
       (let* ((expired (eq (epg-signature-status (car pgg-epg-signatures))
                          'key-expired))
             (signer (cons (epg-signature-key-id (car pgg-epg-signatures))
-                          (epg-signature-user-id (car pgg-epg-signatures))))
+                          (cdr (assoc (epg-signature-key-id
+                                       (car pgg-epg-signatures))
+                                      epg-user-id-alist))))
             (fprint (epg-signature-fingerprint (car pgg-epg-signatures)))
             (trust-good-enough-p
              (memq (epg-signature-validity (car pgg-epg-signatures))
-                   '(marginal fully ultimate))))
+                   '(marginal full ultimate))))
        (cond ((and signer fprint)
               (concat (cdr signer)
                       (unless trust-good-enough-p
@@ -226,6 +275,12 @@ Add all public keys in region between START and END to the keyring."
               "From unknown user")))
     "From unknown user"))
 
+(defun pgg-epg-lookup-key (string &optional type)
+  "Search keys associated with STRING."
+  (mapcar (lambda (key)
+           (epg-sub-key-id (car (epg-key-sub-key-list key))))
+         (epg-list-keys (epg-make-context) string (not (null type)))))
+
 (provide 'pgg-epg)
 
 ;;; pgg-epg.el ends here