]> git.eshelyaron.com Git - emacs.git/commitdiff
Show the status of signed + encrypted S/MIME messages in Gnus
authorLars Ingebrigtsen <larsi@gnus.org>
Mon, 7 Sep 2020 14:29:59 +0000 (16:29 +0200)
committerLars Ingebrigtsen <larsi@gnus.org>
Mon, 7 Sep 2020 14:29:59 +0000 (16:29 +0200)
* 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).

lisp/gnus/mm-decode.el
lisp/gnus/mm-view.el

index a01fd2729afd5a8959f4f5cd5c60c42f391adac6..1bce6ca020e82a53aa151b6cb069de8987166ba9 100644 (file)
@@ -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))
index bd5960c18b28c386b4b91cf8e6b992cd43029b21..cb39ffe94626445393681f6bc2fcbf4de6109f65 100644 (file)
@@ -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")