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

From: Sebastian Fieber <[email-masked]>
Date: Thu, 23 Dec 2021 22:06:29 +0100

On Do, Dez 23 2021, Sebastian Fieber <[email-masked]> wrote:

> On Do, Dez 23 2021, Sebastian Fieber <[email-masked]> wrote:
>
>> This one should apply :)
>
> Wait, this was the wrong one.  I'll send the right one during the day!

Last mail seems to be broken.  Here is the correct patch again.

From 84ebb0331a0e16b1b767483c9d0bd1c140d73f09 Mon Sep 17 00:00:00 2001
From: Sebastian Fieber <[email-masked]>
Date: Thu, 23 Dec 2021 15:38:09 +0100
Subject: [PATCH] [PATCH] fix bug #40397

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

Also this patch enables proper security-buttons for pkcs7-mime
encrypted and/or signed mails.

Changes:
- 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"

- don't just check for multipart/signed in
  gnus-insert-mime-security-button but also for the pkcs7-mime mimetypes
  to print "Encrypted" or "Signed" accordingly in the security button

- adjust mm-possibly-verify-or-decrypt to check for smime-type to ask
  wether to verify or decrypt the part and not to always ask to decrypt

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

- adjust gnus-mime-security-verify-or-decrypt to handle pkcs7-mime
  right with the done changes
---
 lisp/gnus/gnus-art.el  |  78 ++++++++++++++++++++-----
 lisp/gnus/mm-decode.el | 128 +++++++++++++++++++++++++----------------
 lisp/gnus/mm-view.el   |  13 +++--
 3 files changed, 149 insertions(+), 70 deletions(-)

diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index b7701f10a5..a83f4b7d59 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -6084,6 +6084,34 @@ gnus-mime-display-part
    ((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)))))
@@ -8833,11 +8861,18 @@ gnus-mime-security-verify-or-decrypt
     (setq point (point))
     (with-current-buffer (mm-handle-multipart-original-buffer handle)
       (let* ((mm-verify-option 'known)
-	     (mm-decrypt-option 'known)
-	     (nparts (mm-possibly-verify-or-decrypt (cdr handle) handle)))
-	(unless (eq nparts (cdr handle))
-	  (mm-destroy-parts (cdr handle))
-	  (setcdr handle nparts))))
+            (mm-decrypt-option 'known)
+             (pkcs7-mime-p (or (equal (car handle) "application/pkcs7-mime")
+                               (equal (car handle) "application/x-pkcs7-mime")))
+            (nparts (if pkcs7-mime-p
+                         (list (mm-possibly-verify-or-decrypt (cadr handle) (cadadr handle)))
+                       (mm-possibly-verify-or-decrypt (cdr handle) handle))))
+       (unless (eq nparts (cdr handle))
+          ;; if pkcs7-mime don't destroy the parts as the buffer in
+          ;; the cdr still needs to be accessible
+          (when (not pkcs7-mime-p)
+           (mm-destroy-parts (cdr handle)))
+         (setcdr handle nparts))))
     (gnus-mime-display-security handle)
     (when region
       (delete-region (point) (cdr region))
@@ -8891,14 +8926,31 @@ gnus-insert-mime-security-button
   (let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol))
 	 (gnus-tmp-type
 	  (concat
-	   (or (nth 2 (assoc protocol mm-verify-function-alist))
-	       (nth 2 (assoc protocol mm-decrypt-function-alist))
-	       "Unknown")
-	   (if (equal (car handle) "multipart/signed")
-	       " Signed" " Encrypted")
-	   " Part"))
-	 (gnus-tmp-info
-	  (or (mm-handle-multipart-ctl-parameter handle 'gnus-info)
+          (or (nth 2 (assoc protocol mm-verify-function-alist))
+              (nth 2 (assoc protocol mm-decrypt-function-alist))
+              "Unknown")
+          (cond ((equal (car handle) "multipart/signed") " Signed")
+                ((equal (car handle) "multipart/encrypted") " Encrypted")
+                 ((and (equal (car handle) "application/pkcs7-mime")
+                       (equal (mm-handle-multipart-ctl-parameter handle 'protocol)
+                              "application/pkcs7-mime_signed-data"))
+                  " Signed")
+                 ((and (equal (car handle) "application/pkcs7-mime")
+                       (equal (mm-handle-multipart-ctl-parameter handle 'protocol)
+                              "application/pkcs7-mime_enveloped-data"))
+                  " Encrypted")
+                 ;; 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"))
+                  " Signed")
+                 ((and (equal (car handle) "application/x-pkcs7-mime")
+                       (equal (mm-handle-multipart-ctl-parameter handle 'protocol)
+                              "application/x-pkcs7-mime_enveloped-data"))
+                  " Encrypted"))
+          " Part"))
+        (gnus-tmp-info
+         (or (mm-handle-multipart-ctl-parameter handle 'gnus-info)
 	      "Undecided"))
 	 (gnus-tmp-details
 	  (mm-handle-multipart-ctl-parameter handle 'gnus-details))
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index d781407cdc..8d63c8552f 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -474,6 +474,7 @@ mm-dissect-default-type
 (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)
@@ -482,7 +483,15 @@ mm-verify-function-alist
     ("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.
@@ -501,11 +510,16 @@ mm-verify-option

 (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,18 +696,33 @@ mm-dissect-buffer
 					'start start)
 				  (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))))
-	(when id
-	  (when (string-match " *<\\(.*\\)> *" id)
-	    (setq id (match-string 1 id)))
+          (t
+           (let* ((handle
+                   (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))
+                  (intermediate-result (mm-possibly-verify-or-decrypt handle ctl from)))
+             (when (and (equal type "application")
+                        (or (equal subtype "pkcs7-mime")
+                            (equal subtype "x-pkcs7-mime")))
+               (add-text-properties 0
+                                    (length (car ctl))
+                                    (list 'protocol
+                                          (concat (substring-no-properties (car ctl))
+                                                  "_"
+                                                  (cdr (assoc 'smime-type ctl))))
+                                    (car ctl))
+               ;; 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 (cons (car ctl) (list intermediate-result))))
+             intermediate-result))))
+        (when id
+          (when (string-match " *<\\(.*\\)> *" id)
+            (setq id (match-string 1 id)))
 	  (push (cons id result) mm-content-id-alist))
 	result))))

@@ -1677,43 +1706,40 @@ mm-possibly-verify-or-decrypt
     (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)
-		    (t (y-or-n-p "Decrypt (S/MIME) part? ")))
-		   (mm-view-pkcs7 parts from))
-	  (goto-char (point-min))
-	  ;; The encrypted document is a MIME part, and may use either
-	  ;; CRLF (Outlook and the like) or newlines for end-of-line
-	  ;; markers.  Translate from CRLF.
-	  (while (search-forward "\r\n" nil t)
-	    (replace-match "\n"))
-	  ;; Normally there will be a Content-type header here, but
-	  ;; some mailers don't add that to the encrypted part, which
-	  ;; makes the subsequent re-dissection fail here.
-	  (save-restriction
-	    (mail-narrow-to-head)
-	    (unless (mail-fetch-field "content-type")
-	      (goto-char (point-max))
-	      (insert "Content-type: text/plain\n\n")))
-	  (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))))))
+      (add-text-properties 0 (length (car ctl))
+                           (list 'buffer (car parts))
+                           (car ctl))
+      (let* ((envelope-p (string= smime-type "enveloped-data"))
+             (decrypt-or-verify-option (if envelope-p
+                                           mm-decrypt-option
+                                         mm-verify-option))
+             (question (if envelope-p
+                           "Decrypt (S/MIME) part? "
+                         "Verify signed (S/MIME) part? ")))
+        (with-temp-buffer
+	  (when (and (cond
+		      ((equal smime-type "signed-data") t)
+		      ((eq decrypt-or-verify-option 'never) nil)
+		      ((eq decrypt-or-verify-option 'always) t)
+		      ((eq decrypt-or-verify-option 'known) t)
+		      (t (y-or-n-p (format question))))
+                     (mm-view-pkcs7 parts from))
+
+	    (goto-char (point-min))
+	    ;; The encrypted document is a MIME part, and may use either
+	    ;; CRLF (Outlook and the like) or newlines for end-of-line
+	    ;; markers.  Translate from CRLF.
+	    (while (search-forward "\r\n" nil t)
+	      (replace-match "\n"))
+	    ;; Normally there will be a Content-type header here, but
+	    ;; some mailers don't add that to the encrypted part, which
+	    ;; makes the subsequent re-dissection fail here.
+	    (save-restriction
+	      (mail-narrow-to-head)
+	      (unless (mail-fetch-field "content-type")
+	        (goto-char (point-max))
+	        (insert "Content-type: text/plain\n\n")))
+	    (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 d2a6d2cf5d..319bc745ff 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -634,12 +634,9 @@ mm-view-pkcs7-verify
 		 (context (epg-make-context 'CMS)))
 	     (prog1
 		 (epg-verify-string context part)
-	       (let ((result (car (epg-context-result-for context 'verify))))
+	       (let ((result (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))))))))
+		  'gnus-info (epg-verify-result-to-string result)))))))
       (with-temp-buffer
 	(insert "MIME-Version: 1.0\n")
 	(mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m")
@@ -659,7 +656,11 @@ mm-view-pkcs7-decrypt
       ;; 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)))
+           (prog1
+               (epg-decrypt-string context part)
+             (mm-sec-status 'gnus-info "OK")))))
     ;; Use openssl
     (insert "MIME-Version: 1.0\n")
     (mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m")
--
2.20.1