Save current-prefix-arg.

[elisp/epg.git] / pgg-epg.el

diff --git a/pgg-epg.el b/pgg-epg.el
index 345cc7c..86c6155 100644 (file)
--- a/pgg-epg.el
+++ b/pgg-epg.el
@@ -1,10 +1,10 @@
-;;; pgg-epg.el --- Gnus/PGG backend of EasyPG.
+;;; 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>
 ;; 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.
 
 
 ;; This file is part of EasyPG.
 

@@ -23,16 +23,20 @@
 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 ;; Boston, MA 02110-1301, USA.
 
 ;; 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:
 
 ;;; Code:
 

-(require 'epg)
+(require 'epa)

 (eval-when-compile (require 'pgg))
 
 (defvar pgg-epg-secret-key-id-list nil)
 
 (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)
   (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
     (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)))))
 
              (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.
 
 (defun pgg-epg-encrypt-region (start end recipients &optional sign passphrase)
   "This function is for internal use only.
 

@@ -59,17 +64,23 @@ 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))
 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

        cipher)
     (epg-context-set-armor context t)
     (epg-context-set-textmode context pgg-text-mode)
     (epg-context-set-passphrase-callback context #'pgg-epg-passphrase-callback)
        cipher)
     (epg-context-set-armor context t)
     (epg-context-set-textmode context pgg-text-mode)
     (epg-context-set-passphrase-callback context #'pgg-epg-passphrase-callback)

+    (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)
     (condition-case error
        (setq cipher
              (epg-encrypt-string context
                                  (buffer-substring start end)
                                  (mapcar
                                   (lambda (recipient)

-                                    (car (epg-list-keys recipient)))
+                                    (car (epg-list-keys context recipient)))

                                   (if pgg-encrypt-for-me
                                       (cons pgg-default-user-id recipients)
                                     recipients))
                                   (if pgg-encrypt-for-me
                                       (cons pgg-default-user-id recipients)
                                     recipients))

@@ -82,7 +93,6 @@ passphrase cache or user."
        (signal (car error) (cdr error))))
     (save-excursion
       (set-buffer (get-buffer-create pgg-output-buffer))
        (signal (car error) (cdr error))))
     (save-excursion
       (set-buffer (get-buffer-create pgg-output-buffer))

-      (erase-buffer)

       (insert cipher))
     t))
 
       (insert cipher))
     t))
 

@@ -103,21 +113,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))
 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)
        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)

+    (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
     (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))))
              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))
     (save-excursion
       (set-buffer (get-buffer-create pgg-output-buffer))

-      (erase-buffer)

       (insert plain))
     t))
 
       (insert plain))
     t))
 

@@ -129,16 +148,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))
 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)
        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)

+    (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
     (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
                                 'detached))
              pgg-epg-secret-key-id-list nil)
       (error

@@ -148,7 +176,6 @@ passphrase cache or user."
        (signal (car error) (cdr error))))
     (save-excursion
       (set-buffer (get-buffer-create pgg-output-buffer))
        (signal (car error) (cdr error))))
     (save-excursion
       (set-buffer (get-buffer-create pgg-output-buffer))

-      (erase-buffer)

       (insert signature))
     t))
 
       (insert signature))
     t))
 

@@ -158,9 +185,15 @@ passphrase cache or user."
   "This function is for internal use only.
 
 Verify region between START and END as the detached signature SIGNATURE."
   "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)
     (epg-context-set-armor context t)
     (epg-context-set-textmode context pgg-text-mode)

+    (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
     (if signature
        (epg-verify-string context
                           (with-temp-buffer

@@ -172,7 +205,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))
       (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))
 
       (insert (epg-verify-result-to-string pgg-epg-signatures)))
     t))
 

@@ -181,31 +213,47 @@ Verify region between START and END as the detached signature SIGNATURE."
 
 Insert public key at point."
   (let ((context (epg-make-context))
 
 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)
     (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))
 
 (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-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))
 (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))
             (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
        (cond ((and signer fprint)
               (concat (cdr signer)
                       (unless trust-good-enough-p

@@ -218,6 +266,12 @@ Add all public keys in region between START and END to the keyring."
               "From unknown user")))
     "From unknown user"))
 
               "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
 (provide 'pgg-epg)
 
 ;;; pgg-epg.el ends here