From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Mon, 7 Sep 2020 14:29:59 +0000 (+0200)
Subject: Show the status of signed + encrypted S/MIME messages in Gnus
X-Git-Tag: emacs-28.0.90~6201
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=0c4789e2defee35237651961391d0da69fbe26d8;p=emacs.git

Show the status of signed + encrypted S/MIME messages in Gnus

* lisp/gnus/mm-decode.el (mm-possibly-verify-or-decrypt): Use the
data to tell the caller (i.e., Gnus) something about the
validation of signed + encrypted S/MIME messages.

* lisp/gnus/mm-view.el (mm-view-pkcs7-verify): Pass along details
about whether we could validate the signature or not (bug#42637).
---

diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index a01fd2729af..1bce6ca020e 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -1665,12 +1665,14 @@ If RECURSIVE, search recursively."
   (let ((type (car ctl))
 	(subtype (cadr (split-string (car ctl) "/")))
 	(mm-security-handle ctl) ;; (car CTL) is the type.
+	(smime-type (cdr (assq 'smime-type (mm-handle-type parts))))
 	protocol func functest)
     (cond
      ((or (equal type "application/x-pkcs7-mime")
 	  (equal type "application/pkcs7-mime"))
       (with-temp-buffer
 	(when (and (cond
+		    ((equal smime-type "signed-data") t)
 		    ((eq mm-decrypt-option 'never) nil)
 		    ((eq mm-decrypt-option 'always) t)
 		    ((eq mm-decrypt-option 'known) t)
@@ -1691,7 +1693,21 @@ If RECURSIVE, search recursively."
 	    (unless (mail-fetch-field "content-type")
 	      (goto-char (point-max))
 	      (insert "Content-type: text/plain\n\n")))
-	  (setq parts (mm-dissect-buffer t)))))
+	  (setq parts
+		(if (equal smime-type "signed-data")
+		    (list (propertize
+			   "multipart/signed"
+			   'protocol "application/pkcs7-signature"
+			   'gnus-info
+			   (format
+			    "%s:%s"
+			    (get-text-property 0 'gnus-info
+					       (car mm-security-handle))
+			    (get-text-property 0 'gnus-details
+					       (car mm-security-handle))))
+			  (mm-dissect-buffer t)
+			  parts)
+		  (mm-dissect-buffer t))))))
      ((equal subtype "signed")
       (unless (and (setq protocol
 			 (mm-handle-multipart-ctl-parameter ctl 'protocol))
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index bd5960c18b2..cb39ffe9462 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -597,8 +597,16 @@ If MODE is not set, try to find mode automatically."
 	 (with-temp-buffer
 	   (insert-buffer-substring (mm-handle-buffer handle))
 	   (goto-char (point-min))
-	   (let ((part (base64-decode-string (buffer-string))))
-	     (epg-verify-string (epg-make-context 'CMS) part))))
+	   (let ((part (base64-decode-string (buffer-string)))
+		 (context (epg-make-context 'CMS)))
+	     (prog1
+		 (epg-verify-string context part)
+	       (let ((result (car (epg-context-result-for context 'verify))))
+		 (mm-sec-status
+		  'gnus-info (epg-signature-status result)
+		  'gnus-details
+		  (format "%s:%s" (epg-signature-validity result)
+			  (epg-signature-key-id result))))))))
       (with-temp-buffer
 	(insert "MIME-Version: 1.0\n")
 	(mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m")