Subject: bug#40397: 28.0.50; epg decrypt does not verify signed content in smime

From: Sebastian Fieber <[email-masked]>
Date: Mon, 06 Apr 2020 02:04:58 +0200

On So, Apr 05 2020, Sebastian Fieber <[email-masked]> wrote:

> I just had some time to look into this even further and I noticed that
> the mm-sec buttons for signatures/encryption are not displayed for the
> whole application/pkcs7-mime stuff, too.  I am working on a patch to fix
> this.
>
> I think most of the code would look like the one in mml-smime.el (the
> calls to mm-sec-* and getting error/success messages from epg).  The
> hard part is to get the mm-security-handle or better the information
> added about the pkcs7-mime signature by the mm-sec-* calls to some
> function that will add these (which is gnus-mime-display-security ?).
> The problem here is that the part is lost when the signature is verified
> as the actual signed content parts will have replace it.
>
> Best regards
> Sebastian

Hey,

here is the resulting more thorough patch replacing the one before.

It's not finished completely as error handling and reporting via
mm-sec-error is still missing in mm-view-pkcs7-[decrypt/verify].

But displaying verification and encryption information via
gnus-mime-display-security does work (at least in the good case).

See the patch for more information.

I'd welcome any comments :)

From 2d623b52c7810a293ad8309018ebc4973f1ff2e3 Mon Sep 17 00:00:00 2001
From: fallchildren <[email-masked]>
Date: Sat, 4 Apr 2020 01:16:12 +0200
Subject: [PATCH] fix bug #40397

This fixes S/MIME encrypted AND signed mails where in the encrypted
pkcs7 envelope is a signed pkcs7 structure.

- don't force Content-type header to text/plain in front of decrypted
  content for smime decryption using mm-view-pkcs7

- structure the result of mm-dissect-buffer of application/pkcs7-mime
  like a multipart mail so there is no loosing of information of
  verification and decryption results which can now be displayed by
  gnus-mime-display-security

- adjust gnus-mime-display-part to handle application/pkcs7-mime like
  multipart/encrypted or multipart/signed

- add dummy entries to mm-verify-function-alist and
  mm-decrypt-function-alist so gnus-mime-display-security correctly
  displays "S/MIME" and not "unknown protocol"

- adjust mm-possibly-verify-or-decrypt to check for smime-type to ask
  wether to verfiy or decrypt part and not to ask to decrypt either
  way

- adjust mm-view-pkcs7-decrypt and verify to call mm-sec-status so
  success information can be displayed by gnus-mime-display-security

- in mm-view-pkcs7-decrypt also replace "^M\n" with newline and not only
  "\r\n" - I have no idea why this is needed

TODO: mm-view-pkcs7-decrypt and verify error handling and
reporting. ATM there is only the good case implemented - at least for
reporting with gnus-mime-display-security.
---
 lisp/gnus/gnus-art.el  | 28 ++++++++++++++++
 lisp/gnus/mm-decode.el | 74 +++++++++++++++++++++++++++++-------------
 lisp/gnus/mm-view.el   | 32 +++++++++++++++---
 3 files changed, 108 insertions(+), 26 deletions(-)

diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 6b9610d312..4ab629eda0 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -5986,6 +5986,34 @@ If nil, don't show those extra buttons."
    ((equal (car handle) "multipart/encrypted")
     (gnus-add-wash-type 'encrypted)
     (gnus-mime-display-security handle))
+   ;; pkcs7-mime handling:
+   ;;
+   ;; although not really multipart these are structured internally by
+   ;; mm-dissect-buffer like multipart to not discard the decryption
+   ;; and verification results
+   ;;
+   ;; application/pkcs7-mime
+   ((and (equal (car handle) "application/pkcs7-mime")
+         (equal (mm-handle-multipart-ctl-parameter handle 'protocol)
+                "application/pkcs7-mime_signed-data"))
+    (gnus-add-wash-type 'signed)
+    (gnus-mime-display-security handle))
+   ((and (equal (car handle) "application/pkcs7-mime")
+         (equal (mm-handle-multipart-ctl-parameter handle 'protocol)
+                "application/pkcs7-mime_enveloped-data"))
+    (gnus-add-wash-type 'encrypted)
+    (gnus-mime-display-security handle))
+   ;; application/x-pkcs7-mime
+   ((and (equal (car handle) "application/x-pkcs7-mime")
+         (equal (mm-handle-multipart-ctl-parameter handle 'protocol)
+                "application/x-pkcs7-mime_signed-data"))
+    (gnus-add-wash-type 'signed)
+    (gnus-mime-display-security handle))
+   ((and (equal (car handle) "application/x-pkcs7-mime")
+         (equal (mm-handle-multipart-ctl-parameter handle 'protocol)
+                "application/x-pkcs7-mime_enveloped-data"))
+    (gnus-add-wash-type 'encrypted)
+    (gnus-mime-display-security handle))
    ;; Other multiparts are handled like multipart/mixed.
    (t
     (gnus-mime-display-mixed (cdr handle)))))
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 96695aabfd..5af2e50f66 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -473,6 +473,7 @@ The file will be saved in the directory `mm-tmp-directory'.")
 (autoload 'mml2015-verify-test "mml2015")
 (autoload 'mml-smime-verify "mml-smime")
 (autoload 'mml-smime-verify-test "mml-smime")
+(autoload 'mm-view-pkcs7-verify "mm-view")

 (defvar mm-verify-function-alist
   '(("application/pgp-signature" mml2015-verify "PGP" mml2015-verify-test)
@@ -481,7 +482,15 @@ The file will be saved in the directory `mm-tmp-directory'.")
     ("application/pkcs7-signature" mml-smime-verify "S/MIME"
      mml-smime-verify-test)
     ("application/x-pkcs7-signature" mml-smime-verify "S/MIME"
-     mml-smime-verify-test)))
+     mml-smime-verify-test)
+    ("application/x-pkcs7-signature" mml-smime-verify "S/MIME"
+     mml-smime-verify-test)
+    ;; these are only used for security-buttons and contain the
+    ;; smime-type after the underscore
+    ("application/pkcs7-mime_signed-data" mm-view-pkcs7-verify "S/MIME"
+     nil)
+    ("application/x-pkcs7-mime_signed-data" mml-view-pkcs7-verify "S/MIME"
+     nil)))

 (defcustom mm-verify-option 'never
   "Option of verifying signed parts.
@@ -500,11 +509,16 @@ result of the verification."

 (autoload 'mml2015-decrypt "mml2015")
 (autoload 'mml2015-decrypt-test "mml2015")
+(autoload 'mm-view-pkcs7-decrypt "mm-view")

 (defvar mm-decrypt-function-alist
   '(("application/pgp-encrypted" mml2015-decrypt "PGP" mml2015-decrypt-test)
     ("application/x-gnus-pgp-encrypted" mm-uu-pgp-encrypted-extract-1 "PGP"
-     mm-uu-pgp-encrypted-test)))
+     mm-uu-pgp-encrypted-test)
+    ;; these are only used for security-buttons and contain the
+    ;; smime-type after the underscore
+    ("application/pkcs7-mime_enveloped-data" mm-view-pkcs7-decrypt "S/MIME" nil)
+    ("application/x-pkcs7-mime_enveloped-data" mm-view-pkcs7-decrypt "S/MIME" nil)))

 (defcustom mm-decrypt-option nil
   "Option of decrypting encrypted parts.
@@ -682,14 +696,23 @@ MIME-Version header before proceeding."
 				  (car ctl))
 	     (cons (car ctl) (mm-dissect-multipart ctl from))))
 	  (t
-	   (mm-possibly-verify-or-decrypt
-	    (mm-dissect-singlepart
-	     ctl
-	     (and cte (intern (downcase (mail-header-strip-cte cte))))
-	     no-strict-mime
-	     (and cd (mail-header-parse-content-disposition cd))
-	     description id)
-	    ctl from))))
+	   (let* ((intermediate-result
+                   (mm-possibly-verify-or-decrypt
+                    (mm-dissect-singlepart
+	             ctl
+	             (and cte (intern (downcase (mail-header-strip-cte cte))))
+	             no-strict-mime
+	             (and cd (mail-header-parse-content-disposition cd))
+	             description id)
+                    ctl from)))
+             (when (and (equal type "application")
+                        (or (equal subtype "pkcs7-mime")
+                            (equal subtype "x-pkcs7-mime")))
+               ;; if this is a pkcs7-mime lets treat this special and
+               ;; more like multipart so the pkcs7-mime part does not
+               ;; get ignored
+               (setq intermediate-result (list (car ctl) intermediate-result)))
+             intermediate-result))))
 	(when id
 	  (when (string-match " *<\\(.*\\)> *" id)
 	    (setq id (match-string 1 id)))
@@ -759,7 +782,7 @@ MIME-Version header before proceeding."
         (mb enable-multibyte-characters)
         beg)
     (goto-char (point-min))
-    (search-forward-regexp "^\n" nil 'move) ;; There might be no body.
+    (search-forward-regexp "^?\n" nil 'move) ;; There might be no body.
     (setq beg (point))
     (with-current-buffer
           (generate-new-buffer " *mm*")
@@ -1672,17 +1695,24 @@ If RECURSIVE, search recursively."
     (cond
      ((or (equal type "application/x-pkcs7-mime")
 	  (equal type "application/pkcs7-mime"))
-      (with-temp-buffer
-	(when (and (cond
-		    ((eq mm-decrypt-option 'never) nil)
-		    ((eq mm-decrypt-option 'always) t)
-		    ((eq mm-decrypt-option 'known) t)
-		    (t (y-or-n-p
-			(format "Decrypt (S/MIME) part? "))))
-		   (mm-view-pkcs7 parts from))
-	  (goto-char (point-min))
-	  (insert "Content-type: text/plain\n\n")
-	  (setq parts (mm-dissect-buffer t)))))
+      (let* ((smime-type (cdr (assoc 'smime-type ctl)))
+             (envelope-p (string= smime-type "enveloped-data"))
+             (decrypt-or-sign-option (if envelope-p
+                                         mm-decrypt-option
+                                       mm-sign-option))
+             (question (if envelope-p
+                           "Decrypt (S/MIME) part? "
+                         "Verify signed (S/MIME) part? ")))
+        (with-temp-buffer
+	  (when (and (cond
+		      ((eq decrypt-or-sign-option 'never) nil)
+		      ((eq decrypt-or-sign-option 'always) t)
+		      ((eq decrypt-or-sign-option 'known) t)
+		      (t (y-or-n-p
+			  (format question))))
+		     (mm-view-pkcs7 parts from))
+	    (goto-char (point-min))
+	    (setq 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 828ac633dc..4c7350b55a 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -591,8 +591,20 @@ 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))
+                  (plain (epg-verify-string context part)))
+             (mm-sec-status
+              'gnus-info
+              (epg-verify-result-to-string (epg-context-result-for context 'verify))
+              'gnus-details
+              nil
+              'protocol
+              ;; just mimik pkcs7-signature actually we are in pkcs7-mime
+              (concat (substring-no-properties (caadr handle))
+                      "_"
+                      (cdr (assoc 'smime-type (cadr handle)))))
+             plain)))
       (with-temp-buffer
 	(insert "MIME-Version: 1.0\n")
 	(mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m")
@@ -612,7 +624,19 @@ If MODE is not set, try to find mode automatically."
       ;; Use EPG/gpgsm
       (let ((part (base64-decode-string (buffer-string))))
 	(erase-buffer)
-	(insert (epg-decrypt-string (epg-make-context 'CMS) part)))
+	(insert
+         (let* ((context (epg-make-context 'CMS))
+                (plain (epg-decrypt-string context part)))
+           (mm-sec-status
+            'gnus-info
+            "OK"
+            'gnus-details
+            nil
+            'protocol
+            (concat (substring-no-properties (caadr handle))
+                    "_"
+                    (cdr (assoc 'smime-type (cadr handle)))))
+           plain)))
     ;; Use openssl
     (insert "MIME-Version: 1.0\n")
     (mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m")
@@ -626,7 +650,7 @@ If MODE is not set, try to find mode automatically."
 	 smime-keys nil nil nil (car-safe (car-safe smime-keys)))))
      from))
   (goto-char (point-min))
-  (while (search-forward "\r\n" nil t)
+  (while (search-forward-regexp "\r\n|
\n" nil t)
     (replace-match "\n"))
   (goto-char (point-min)))

--
2.25.2