master b6fac9a: verify signed content in smime encrypted and signed message

[Lars Ingebrigtsen]

branch: master
commit b6fac9aaaf21c12a25e1cbec9cb8b8d14d2dc8a8
Author: Sebastian Fieber <sebastian.fieber@web.de>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    verify signed content in smime encrypted and signed message
    
    * lisp/gnus/gnus-art.el (gnus-mime-display-part): Parse pkcs7
    parts (bug#40397).
    (gnus-mime-security-verify-or-decrypt):
    (gnus-insert-mime-security-button): Handle these parts.
    
    * lisp/gnus/mm-decode.el (mm-verify-function-alist): Add pkcs7
    functions.
    (mm-decrypt-function-alist): Handle them.
    (mm-possibly-verify-or-decrypt): Ditto.
    
    * lisp/gnus/mm-view.el (mm-view-pkcs7-decrypt): Handle pkcs7.
    
    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  |  83 ++++++++++++++++++++++++++-----
 lisp/gnus/mm-decode.el | 131 ++++++++++++++++++++++++++++++-------------------
 lisp/gnus/mm-view.el   |  13 ++---
 3 files changed, 157 insertions(+), 70 deletions(-)

diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index b7701f1..3b3564f 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -6084,6 +6084,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)))))
@@ -8833,11 +8861,19 @@ For example:
     (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 +8927,35 @@ For example:
   (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 d781407..d2889a5 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -474,6 +474,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)
@@ -482,7 +483,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.
@@ -501,11 +510,17 @@ 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,18 +697,35 @@ MIME-Version header before proceeding."
                                        '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 +1709,40 @@ If RECURSIVE, search recursively."
     (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 d2a6d2c..319bc74 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -634,12 +634,9 @@ If MODE is not set, try to find mode automatically."
                 (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 @@ 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)))
+           (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")