Add 2010 to copyright years.
[gnus] / lisp / mml2015.el
index 1b1ba0d..65cf1a8 100644 (file)
@@ -1,27 +1,25 @@
 ;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP)
 
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+;;   2008, 2009, 2010 Free Software Foundation, Inc.
 
 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
 ;; Keywords: PGP MIME MML
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs 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 3, or (at your
-;; option) any later version.
+;; GNU Emacs 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 3 of the License, or
+;; (at your option) any later version.
 
-;; GNU Emacs 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.
+;; GNU Emacs 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.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -153,6 +151,17 @@ Whether the passphrase is cached at all is controlled by
 ;; should be done by GnuPG rather than Elisp, but older PGP backends
 ;; (such as Mailcrypt, PGG, and gpg.el) discard the output from GnuPG.
 (defun mml2015-extract-cleartext-signature ()
+  ;; Daiki Ueno in
+  ;; <54a15d860801080142l70b95d7dkac4bf51a86196011@mail.gmail.com>: ``I still
+  ;; believe that the right way is to use the plaintext output from GnuPG as
+  ;; it is, and mml2015-extract-cleartext-signature is just a kludge for
+  ;; misdesigned libraries like PGG, which have no ability to do that.  So, I
+  ;; think it should not have descriptive documentation.''
+  ;;
+  ;; This function doesn't handle NotDashEscaped correctly.  EasyPG handles it
+  ;; correctly.
+  ;; http://thread.gmane.org/gmane.emacs.gnus.general/66062/focus=66082
+  ;; http://thread.gmane.org/gmane.emacs.gnus.general/65087/focus=65109
   (goto-char (point-min))
   (forward-line)
   ;; We need to be careful not to strip beyond the armor headers.
@@ -173,13 +182,12 @@ Whether the passphrase is cached at all is controlled by
 
 ;;; mailcrypt wrapper
 
-(eval-and-compile
-  (autoload 'mailcrypt-decrypt "mailcrypt")
-  (autoload 'mailcrypt-verify "mailcrypt")
-  (autoload 'mc-pgp-always-sign "mailcrypt")
-  (autoload 'mc-encrypt-generic "mc-toplev")
-  (autoload 'mc-cleanup-recipient-headers "mc-toplev")
-  (autoload 'mc-sign-generic "mc-toplev"))
+(autoload 'mailcrypt-decrypt "mailcrypt")
+(autoload 'mailcrypt-verify "mailcrypt")
+(autoload 'mc-pgp-always-sign "mailcrypt")
+(autoload 'mc-encrypt-generic "mc-toplev")
+(autoload 'mc-cleanup-recipient-headers "mc-toplev")
+(autoload 'mc-sign-generic "mc-toplev")
 
 (defvar mc-default-scheme)
 (defvar mc-schemes)
@@ -444,14 +452,13 @@ Whether the passphrase is cached at all is controlled by
 
 ;;; gpg wrapper
 
-(eval-and-compile
-  (autoload 'gpg-decrypt "gpg")
-  (autoload 'gpg-verify "gpg")
-  (autoload 'gpg-verify-cleartext "gpg")
-  (autoload 'gpg-sign-detached "gpg")
-  (autoload 'gpg-sign-encrypt "gpg")
-  (autoload 'gpg-encrypt "gpg")
-  (autoload 'gpg-passphrase-read "gpg"))
+(autoload 'gpg-decrypt "gpg")
+(autoload 'gpg-verify "gpg")
+(autoload 'gpg-verify-cleartext "gpg")
+(autoload 'gpg-sign-detached "gpg")
+(autoload 'gpg-sign-encrypt "gpg")
+(autoload 'gpg-encrypt "gpg")
+(autoload 'gpg-passphrase-read "gpg")
 
 (defun mml2015-gpg-passphrase ()
   (or (message-options-get 'gpg-passphrase)
@@ -722,12 +729,11 @@ Whether the passphrase is cached at all is controlled by
 (defvar pgg-errors-buffer)
 (defvar pgg-output-buffer)
 
-(eval-and-compile
-  (autoload 'pgg-decrypt-region "pgg")
-  (autoload 'pgg-verify-region "pgg")
-  (autoload 'pgg-sign-region "pgg")
-  (autoload 'pgg-encrypt-region "pgg")
-  (autoload 'pgg-parse-armor "pgg-parse"))
+(autoload 'pgg-decrypt-region "pgg")
+(autoload 'pgg-verify-region "pgg")
+(autoload 'pgg-sign-region "pgg")
+(autoload 'pgg-encrypt-region "pgg")
+(autoload 'pgg-parse-armor "pgg-parse")
 
 (defun mml2015-pgg-decrypt (handle ctl)
   (catch 'error
@@ -959,27 +965,26 @@ Whether the passphrase is cached at all is controlled by
 (defvar epg-digest-algorithm-alist)
 (defvar inhibit-redisplay)
 
-(eval-and-compile
-  (autoload 'epg-make-context "epg")
-  (autoload 'epg-context-set-armor "epg")
-  (autoload 'epg-context-set-textmode "epg")
-  (autoload 'epg-context-set-signers "epg")
-  (autoload 'epg-context-result-for "epg")
-  (autoload 'epg-new-signature-digest-algorithm "epg")
-  (autoload 'epg-verify-result-to-string "epg")
-  (autoload 'epg-list-keys "epg")
-  (autoload 'epg-decrypt-string "epg")
-  (autoload 'epg-verify-string "epg")
-  (autoload 'epg-sign-string "epg")
-  (autoload 'epg-encrypt-string "epg")
-  (autoload 'epg-passphrase-callback-function "epg")
-  (autoload 'epg-context-set-passphrase-callback "epg")
-  (autoload 'epg-key-sub-key-list "epg")
-  (autoload 'epg-sub-key-capability "epg")
-  (autoload 'epg-sub-key-validity "epg")
-  (autoload 'epg-configuration "epg-config")
-  (autoload 'epg-expand-group "epg-config")
-  (autoload 'epa-select-keys "epa"))
+(autoload 'epg-make-context "epg")
+(autoload 'epg-context-set-armor "epg")
+(autoload 'epg-context-set-textmode "epg")
+(autoload 'epg-context-set-signers "epg")
+(autoload 'epg-context-result-for "epg")
+(autoload 'epg-new-signature-digest-algorithm "epg")
+(autoload 'epg-verify-result-to-string "epg")
+(autoload 'epg-list-keys "epg")
+(autoload 'epg-decrypt-string "epg")
+(autoload 'epg-verify-string "epg")
+(autoload 'epg-sign-string "epg")
+(autoload 'epg-encrypt-string "epg")
+(autoload 'epg-passphrase-callback-function "epg")
+(autoload 'epg-context-set-passphrase-callback "epg")
+(autoload 'epg-key-sub-key-list "epg")
+(autoload 'epg-sub-key-capability "epg")
+(autoload 'epg-sub-key-validity "epg")
+(autoload 'epg-configuration "epg-config")
+(autoload 'epg-expand-group "epg-config")
+(autoload 'epa-select-keys "epa")
 
 (defvar password-cache-expiry)
 
@@ -988,7 +993,11 @@ Whether the passphrase is cached at all is controlled by
 (defun mml2015-epg-passphrase-callback (context key-id ignore)
   (if (eq key-id 'SYM)
       (epg-passphrase-callback-function context key-id nil)
-    (let* (entry
+    (let* ((password-cache-key-id
+           (if (eq key-id 'PIN)
+               "PIN"
+              key-id))
+          entry
           (passphrase
            (password-read
             (if (eq key-id 'PIN)
@@ -996,14 +1005,12 @@ Whether the passphrase is cached at all is controlled by
               (if (setq entry (assoc key-id epg-user-id-alist))
                   (format "Passphrase for %s %s: " key-id (cdr entry))
                 (format "Passphrase for %s: " key-id)))
-            (if (eq key-id 'PIN)
-                "PIN"
-              key-id))))
+            password-cache-key-id)))
       (when passphrase
        (let ((password-cache-expiry mml2015-passphrase-cache-expiry))
-         (password-cache-add key-id passphrase))
+         (password-cache-add password-cache-key-id passphrase))
        (setq mml2015-epg-secret-key-id-list
-             (cons key-id mml2015-epg-secret-key-id-list))
+             (cons password-cache-key-id mml2015-epg-secret-key-id-list))
        (copy-sequence passphrase)))))
 
 (defun mml2015-epg-find-usable-key (keys usage)
@@ -1180,24 +1187,26 @@ Whether the passphrase is cached at all is controlled by
          (or (message-options-get 'mml2015-epg-signers)
              (message-options-set
               'mml2015-epg-signers
-              (if mml2015-verbose
+              (if (eq mm-sign-option 'guided)
                   (epa-select-keys context "\
 Select keys for signing.
 If no one is selected, default secret key is used.  "
                                    mml2015-signers t)
                 (if mml2015-signers
-                    (mapcar
-                     (lambda (signer)
-                       (setq signer-key (mml2015-epg-find-usable-key
-                                         (epg-list-keys context signer t)
-                                         'sign))
-                       (unless (or signer-key
-                                   (y-or-n-p
-                                    (format "No secret key for %s; skip it? "
-                                            signer)))
-                         (error "No secret key for %s" signer))
-                       signer-key)
-                     mml2015-signers))))))
+                    (delq nil
+                          (mapcar
+                           (lambda (signer)
+                             (setq signer-key (mml2015-epg-find-usable-key
+                                               (epg-list-keys context signer t)
+                                               'sign))
+                             (unless (or signer-key
+                                         (y-or-n-p
+                                          (format
+                                           "No secret key for %s; skip it? "
+                                           signer)))
+                               (error "No secret key for %s" signer))
+                             signer-key)
+                           mml2015-signers)))))))
         signature micalg)
     (epg-context-set-armor context t)
     (epg-context-set-textmode context t)
@@ -1260,25 +1269,26 @@ If no one is selected, default secret key is used.  "
        (unless mml2015-signers
          (error "mml2015-signers not set"))
        (setq recipients (nconc recipients mml2015-signers)))
-      (if mml2015-verbose
+      (if (eq mm-encrypt-option 'guided)
          (setq recipients
                (epa-select-keys context "\
 Select recipients for encryption.
 If no one is selected, symmetric encryption will be performed.  "
                                 recipients))
        (setq recipients
-             (mapcar
-              (lambda (recipient)
-                (setq recipient-key (mml2015-epg-find-usable-key
-                                     (epg-list-keys context recipient)
-                                     'encrypt))
-                (unless (or recipient-key
-                            (y-or-n-p
-                             (format "No public key for %s; skip it? "
-                                     recipient)))
-                  (error "No public key for %s" recipient))
-                recipient-key)
-              recipients))
+             (delq nil
+                   (mapcar
+                    (lambda (recipient)
+                      (setq recipient-key (mml2015-epg-find-usable-key
+                                           (epg-list-keys context recipient)
+                                           'encrypt))
+                      (unless (or recipient-key
+                                  (y-or-n-p
+                                   (format "No public key for %s; skip it? "
+                                           recipient)))
+                        (error "No public key for %s" recipient))
+                      recipient-key)
+                    recipients)))
        (unless recipients
          (error "No recipient specified")))
       (message-options-set 'mml2015-epg-recipients recipients))
@@ -1287,25 +1297,26 @@ If no one is selected, symmetric encryption will be performed.  "
            (or (message-options-get 'mml2015-epg-signers)
                (message-options-set
                 'mml2015-epg-signers
-                (if mml2015-verbose
+                (if (eq mm-sign-option 'guided)
                     (epa-select-keys context "\
 Select keys for signing.
 If no one is selected, default secret key is used.  "
                                      mml2015-signers t)
                   (if mml2015-signers
-                      (mapcar
-                       (lambda (signer)
-                         (setq signer-key (mml2015-epg-find-usable-key
-                                           (epg-list-keys context signer t)
-                                           'sign))
-                         (unless (or signer-key
-                                     (y-or-n-p
-                                      (format
-                                       "No secret key for %s; skip it? "
-                                       signer)))
-                           (error "No secret key for %s" signer))
-                         signer-key)
-                       mml2015-signers))))))
+                      (delq nil
+                            (mapcar
+                             (lambda (signer)
+                               (setq signer-key (mml2015-epg-find-usable-key
+                                                 (epg-list-keys context signer t)
+                                                 'sign))
+                               (unless (or signer-key
+                                           (y-or-n-p
+                                            (format
+                                             "No secret key for %s; skip it? "
+                                             signer)))
+                                 (error "No secret key for %s" signer))
+                               signer-key)
+                             mml2015-signers)))))))
       (epg-context-set-signers context signers))
     (epg-context-set-armor context t)
     (epg-context-set-textmode context t)
@@ -1405,5 +1416,5 @@ If no one is selected, default secret key is used.  "
 
 (provide 'mml2015)
 
-;;; arch-tag: b04701d5-0b09-44d8-bed8-de901bf435f2
+;; arch-tag: b04701d5-0b09-44d8-bed8-de901bf435f2
 ;;; mml2015.el ends here