Merge from emacs--devo--0

[gnus] / lisp / mml-smime.el

diff --git a/lisp/mml-smime.el b/lisp/mml-smime.el
index 2ef6d51..c00ac41 100644 (file)
--- a/lisp/mml-smime.el
+++ b/lisp/mml-smime.el
@@ -1,7 +1,7 @@
 ;;; mml-smime.el --- S/MIME support for MML
 
 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006 Free Software Foundation, Inc.
+;;   2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: Simon Josefsson <simon@josefsson.org>
 ;; Keywords: Gnus, MIME, S/MIME, MML
@@ -10,7 +10,7 @@
 
 ;; 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 2, or (at your
+;; by the Free Software Foundation; either version 3, or (at your
 ;; option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful, but
@@ -306,7 +306,6 @@ Whether the passphrase is cached at all is controlled by
   (defvar epg-digest-algorithm-alist)
   (defvar inhibit-redisplay)
   (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")
@@ -351,10 +350,23 @@ Whether the passphrase is cached at all is controlled by
              (cons key-id mml-smime-epg-secret-key-id-list))
        (copy-sequence passphrase)))))
 
+(defun mml-smime-epg-find-usable-key (keys usage)
+  (catch 'found
+    (while keys
+      (let ((pointer (epg-key-sub-key-list (car keys))))
+       (while pointer
+         (if (and (memq usage (epg-sub-key-capability (car pointer)))
+                  (not (memq (epg-sub-key-validity (car pointer))
+                             '(revoked expired))))
+             (throw 'found (car keys)))
+         (setq pointer (cdr pointer))))
+      (setq keys (cdr keys)))))
+
 (defun mml-smime-epg-sign (cont)
   (let* ((inhibit-redisplay t)
         (context (epg-make-context 'CMS))
         (boundary (mml-compute-boundary cont))
+        signer-key
         (signers
          (or (message-options-get 'mml-smime-epg-signers)
              (message-options-set
@@ -365,17 +377,29 @@ Select keys for signing.
 If no one is selected, default secret key is used.  "
                                   mml-smime-signers t)
                (if mml-smime-signers
-                   (mapcar (lambda (name)
-                             (car (epg-list-keys context name t)))
-                           mml-smime-signers))))))
-       signature micalg)
+                   (mapcar
+                    (lambda (signer)
+                      (setq signer-key (mml-smime-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)
+                    mml-smime-signers))))))
+        signature micalg)
     (epg-context-set-signers context signers)
     (if mml-smime-cache-passphrase
        (epg-context-set-passphrase-callback
         context
         #'mml-smime-epg-passphrase-callback))
     (condition-case error
-       (setq signature (epg-sign-string context (buffer-string) t)
+       (setq signature (epg-sign-string context
+                                        (mm-replace-in-string (buffer-string)
+                                                              "\n" "\r\n")
+                                        t)
              mml-smime-epg-secret-key-id-list nil)
       (error
        (while mml-smime-epg-secret-key-id-list
@@ -414,7 +438,8 @@ Content-Disposition: attachment; filename=smime.p7s
        (config (epg-configuration))
        (recipients (message-options-get 'mml-smime-epg-recipients))
        cipher signers
-       (boundary (mml-compute-boundary cont)))
+       (boundary (mml-compute-boundary cont))
+       recipient-key)
     (unless recipients
       (setq recipients
            (apply #'nconc
@@ -434,9 +459,20 @@ Select recipients for encryption.
 If no one is selected, symmetric encryption will be performed.  "
                                 recipients))
        (setq recipients
-             (delq nil (mapcar (lambda (name)
-                                 (car (epg-list-keys context name)))
-                               recipients))))
+             (mapcar
+              (lambda (recipient)
+                (setq recipient-key (mml-smime-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 'mml-smime-epg-recipients recipients))
     (if mml-smime-cache-passphrase
        (epg-context-set-passphrase-callback
@@ -481,7 +517,8 @@ Content-Disposition: attachment; filename=smime.p7m
        (mm-set-handle-multipart-parameter
         mm-security-handle 'gnus-info "Corrupted")
        (throw 'error handle))
-      (setq context (epg-make-context 'CMS))
+      (setq part (mm-replace-in-string part "\n" "\r\n" t)
+           context (epg-make-context 'CMS))
       (condition-case error
          (setq plain (epg-verify-string context (mm-get-part signature) part))
        (error