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
This commit is contained in:
Sebastian Fieber
Lars Ingebrigtsen
parent
b9015606d1
commit
b6fac9aaaf
3 changed files with 157 additions and 70 deletions
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue