bug#39884: 27.0.50; Emacs may destroy outgoing email messages during sending

[Noam Postavsky <npostavs@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 1163 bytes --]

tags 39884 + patch
quit

"Rainer Gemulla" <rgemulla@gmx.de> writes:

> During step 9, this statement is executed, but afterwards, the tag
> variable is not set to the list mentioned in the statement
> (seriously!). In my case, it had value 'Content-Type:
> multipart/alternative; boundary="====-=-="' right afterwards

Yes, it's due destructive modification of a quoted literal value.  To
catch it, I modified mml.el like this:

--- i/lisp/gnus/mml.el
+++ w/lisp/gnus/mml.el
@@ -216,6 +216,8 @@ mml-parse
     (with-syntax-table mml-syntax-table
       (mml-parse-1))))
 
+(defconst mml-text/plain-tag-literal-constant '(type . "text/plain"))
+
 (defun mml-parse-1 ()
   "Parse the current buffer as an MML document."
   (let (struct tag point contents charsets warn use-ascii no-markup-p raw)
@@ -281,7 +283,7 @@ mml-parse-1
 	    (setq tag (mml-read-tag)
 		  no-markup-p nil
 		  warn nil)
-	  (setq tag (list 'part '(type . "text/plain"))
+	  (setq tag (list 'part mml-text/plain-tag-literal-constant)
 		no-markup-p t
 		warn t))
 	(setq raw (cdr (assq 'raw tag))

And added a debug check around setcdr as in the attached
bug-39884-bad-mml-parsing.el file.


[-- Attachment #2: bug reproducer --]
[-- Type: text/plain, Size: 3020 bytes --]

(defconst bug-39884-orig-message "\
From: a <at> b.ce
To: c <at> d.de
Subject: Test
--text follows this line--
Test

<#mml type=message/rfc822 disposition=inline>
<#multipart type=alternative>
<#part type=text/plain charset=\"UTF-8\" disposition=inline nofile=yes>
Some text.
<#part type=text/html charset=\"UTF-8\" nofile=yes>
Some more text.
<#/multipart>
<#/mml>
")

(defconst bug-39884-correct-result "\
From: a <at> b.ce
To: c <at> d.de
Subject: Test
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary=\"=-=-=\"
--text follows this line--
--=-=-=
Content-Type: text/plain

Test


--=-=-=
Content-Type: message/rfc822
Content-Disposition: inline

--====-=-=
Content-Disposition: inline
MIME-Version: 1.0
Content-Type: multipart/alternative; boundary=\"====-=-=\"

Some text.

--====-=-=
Content-Type: text/html; charset=utf-8

Some more text.

--====-=-=--

--=-=-=--
")

(defconst 39884-incorrect-results-of-step-9
  "\
From: a <at> b.ce
To: c <at> d.de
Subject: Test
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary=\"=-=-=\"
--text follows this line--
--=-=-=
Content-Type: multipart/alternative; boundary=\"====-=-=\"
Content-Transfer-Encoding: base64

VGV4dAoK
--=-=-=
Content-Type: message/rfc822
Content-Disposition: inline

--====-=-=
Content-Disposition: inline
MIME-Version: 1.0
Content-Type: multipart/alternative; boundary=\"====-=-=\"

Some text.

--====-=-=
Content-Type: text/html; charset=utf-8

Some more text.

--====-=-=--

--=-=-=--
")

;; (defvar mml-text/plain-tag-literal-constant)

;; (defun check-setcdr (fun cell newcdr)
;;   (when (eq cell mml-text/plain-tag-literal-constant)
;;     (debug nil))
;;   (funcall fun cell newcdr))
;; (advice-add 'setcdr :around #'check-setcdr)
;; (load-library "mml.el") ;; `setcdr' has an opcode, so must run from source to advise it.

;; 2. M-x message-mode
(message-mode)
(setq buffer-file-name nil)
(setq buffer-auto-save-file-name nil)
;; 3. Clear scratch buffer, paste original message
(erase-buffer)
(insert bug-39884-orig-message)

;; 4. M-: (mml-to-mime) --> gives CORRECT result
(goto-char (point-min))
(mml-to-mime)
(cl-assert (equal (buffer-string) bug-39884-correct-result))

;; 5. Clear scratch buffer, paste original message
(erase-buffer)
(insert bug-39884-orig-message)

;; 6. Insert a new line "<#secure method=pgpmime mode=sign>" at start of 
;; message (after line "--text follows this line--"). This makes Emacs try 
;; to sign the mail.
(search-backward "--text follows this line--")
(forward-line)
(insert "<#secure method=pgpmime mode=sign>\n")

;; 7. M-: (mml-to-mime) --> throws (expected) signer name error
(cl-assert (condition-case ()
               (progn (goto-char (point-min))
                      (mml-to-mime)
                      nil)
             (error t)))

;; 8. Clear scratch buffer, paste original message
(erase-buffer)
(insert bug-39884-orig-message)

;; 9. M-: (mml-to-mime)
;;   --> broken result (first Content-Type after "text follows..." is 
;; wrong)
(goto-char (point-min))
(mml-to-mime)

[-- Attachment #3: Type: text/plain, Size: 28 bytes --]


This gives the backtrace:


[-- Attachment #4: backtrace from the guilty setcdr --]
[-- Type: text/plain, Size: 38037 bytes --]

Debugger entered: nil
  (progn (debug nil))
  (if (eq cell mml-text/plain-tag-literal-constant) (progn (debug nil)))
  check-setcdr(#<subr setcdr> (type . "text/plain") "multipart/alternative; boundary=\"====-=-=\"")
  apply(check-setcdr #<subr setcdr> ((type . "text/plain") "multipart/alternative; boundary=\"====-=-=\""))
  setcdr((type . "text/plain") "multipart/alternative; boundary=\"====-=-=\"")
  (progn (setcdr (assq 'type (cdr (car cont))) content-type))
  (if (and (consp (car cont)) (= (length cont) 1) content-type) (progn (setcdr (assq 'type (cdr (car cont))) content-type)))
  (if (not cont) nil (if (and (consp (car cont)) (= (length cont) 1) content-type) (progn (setcdr (assq 'type (cdr (car cont))) content-type))) (if (and (consp (car cont)) (= (length cont) 1) (fboundp 'libxml-parse-html-region) (equal (cdr (assq 'type (car cont))) "text/html")) (progn (setq cont (mml-expand-html-into-multipart-related (car cont))))) (prog1 (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (set-buffer-multibyte nil) (setq message-options options) (cond (... ...) (... ...) (t ...)) (setq options message-options) (buffer-string)) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) (setq message-options options)))
  (let ((cont (mml-parse)) (mml-multipart-number mml-multipart-number) (options message-options)) (if (not cont) nil (if (and (consp (car cont)) (= (length cont) 1) content-type) (progn (setcdr (assq 'type (cdr (car cont))) content-type))) (if (and (consp (car cont)) (= (length cont) 1) (fboundp 'libxml-parse-html-region) (equal (cdr (assq 'type (car cont))) "text/html")) (progn (setq cont (mml-expand-html-into-multipart-related (car cont))))) (prog1 (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (set-buffer-multibyte nil) (setq message-options options) (cond ... ... ...) (setq options message-options) (buffer-string)) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) (setq message-options options))))
  mml-generate-mime(nil "multipart/alternative; boundary=\"====-=-=\"")
  message-encode-message-body()
  mml-to-mime()
  (let ((mml-boundary (mml-compute-boundary cont)) (mml-generate-default-type "text/plain")) (mml-to-mime) (if mml-inhibit-compute-boundary nil (setcdr (assoc 'contents cont) (buffer-string))))
  (cond ((eq (car cont) 'mml) (let ((mml-boundary (mml-compute-boundary cont)) (mml-generate-default-type "text/plain")) (mml-to-mime) (if mml-inhibit-compute-boundary nil (setcdr (assoc 'contents cont) (buffer-string)))) (let ((mm-7bit-chars (concat mm-7bit-chars "\33"))) (setq encoding (mm-body-7-or-8)))) ((string= (car (split-string type "/")) "message") (let ((mm-7bit-chars (concat mm-7bit-chars "\33"))) (setq encoding (mm-body-7-or-8)))) (t (let (use-hard-newlines) (if (and mml-enable-flowed (string= type "text/plain") (not (string= (cdr ...) "pgp")) (or (null (assq ... cont)) (string= (cdr ...) "flowed")) (setq use-hard-newlines (text-property-any (point-min) (point-max) 'hard 't))) (progn (fill-flowed-encode) (setq flowed (null (assq ... cont)))))) (if (or charset (not (string= type "text/calendar"))) (setq charset (mm-encode-body charset)) (let ((mm-coding-system-priorities (cons 'utf-8 mm-coding-system-priorities))) (setq charset (mm-encode-body)))) (setq encoding (mm-body-encoding charset (cdr (assq 'encoding cont))))))
  (progn (cond ((cdr (assq 'buffer cont)) (insert-buffer-substring (cdr (assq 'buffer cont)))) ((and filename (not (equal (cdr (assq ... cont)) "yes"))) (let ((coding-system-for-read coding)) (mm-insert-file-contents filename))) ((eq 'mml (car cont)) (insert (cdr (assq 'contents cont)))) (t (save-restriction (narrow-to-region (point) (point)) (insert (cdr (assq 'contents cont))) (goto-char (point-min)) (while (re-search-forward "<#!+/?\\(part\\|multipart\\|external\\|mml\\|secure\\)" nil t) (delete-region (+ (match-beginning 0) 2) (+ (match-beginning 0) 3)))))) (cond ((eq (car cont) 'mml) (let ((mml-boundary (mml-compute-boundary cont)) (mml-generate-default-type "text/plain")) (mml-to-mime) (if mml-inhibit-compute-boundary nil (setcdr (assoc 'contents cont) (buffer-string)))) (let ((mm-7bit-chars (concat mm-7bit-chars "\33"))) (setq encoding (mm-body-7-or-8)))) ((string= (car (split-string type "/")) "message") (let ((mm-7bit-chars (concat mm-7bit-chars "\33"))) (setq encoding (mm-body-7-or-8)))) (t (let (use-hard-newlines) (if (and mml-enable-flowed (string= type "text/plain") (not (string= ... "pgp")) (or (null ...) (string= ... "flowed")) (setq use-hard-newlines (text-property-any ... ... ... ...))) (progn (fill-flowed-encode) (setq flowed (null ...))))) (if (or charset (not (string= type "text/calendar"))) (setq charset (mm-encode-body charset)) (let ((mm-coding-system-priorities (cons ... mm-coding-system-priorities))) (setq charset (mm-encode-body)))) (setq encoding (mm-body-encoding charset (cdr (assq 'encoding cont)))))) (setq coded (buffer-string)))
  (unwind-protect (progn (cond ((cdr (assq 'buffer cont)) (insert-buffer-substring (cdr (assq 'buffer cont)))) ((and filename (not (equal (cdr ...) "yes"))) (let ((coding-system-for-read coding)) (mm-insert-file-contents filename))) ((eq 'mml (car cont)) (insert (cdr (assq 'contents cont)))) (t (save-restriction (narrow-to-region (point) (point)) (insert (cdr (assq ... cont))) (goto-char (point-min)) (while (re-search-forward "<#!+/?\\(part\\|multipart\\|external\\|mml\\|secure\\)" nil t) (delete-region (+ ... 2) (+ ... 3)))))) (cond ((eq (car cont) 'mml) (let ((mml-boundary (mml-compute-boundary cont)) (mml-generate-default-type "text/plain")) (mml-to-mime) (if mml-inhibit-compute-boundary nil (setcdr (assoc ... cont) (buffer-string)))) (let ((mm-7bit-chars (concat mm-7bit-chars "\33"))) (setq encoding (mm-body-7-or-8)))) ((string= (car (split-string type "/")) "message") (let ((mm-7bit-chars (concat mm-7bit-chars "\33"))) (setq encoding (mm-body-7-or-8)))) (t (let (use-hard-newlines) (if (and mml-enable-flowed (string= type "text/plain") (not ...) (or ... ...) (setq use-hard-newlines ...)) (progn (fill-flowed-encode) (setq flowed ...)))) (if (or charset (not (string= type "text/calendar"))) (setq charset (mm-encode-body charset)) (let ((mm-coding-system-priorities ...)) (setq charset (mm-encode-body)))) (setq encoding (mm-body-encoding charset (cdr (assq ... cont)))))) (setq coded (buffer-string))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer)))
  (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (cond ((cdr (assq 'buffer cont)) (insert-buffer-substring (cdr (assq ... cont)))) ((and filename (not (equal ... "yes"))) (let ((coding-system-for-read coding)) (mm-insert-file-contents filename))) ((eq 'mml (car cont)) (insert (cdr (assq ... cont)))) (t (save-restriction (narrow-to-region (point) (point)) (insert (cdr ...)) (goto-char (point-min)) (while (re-search-forward "<#!+/?\\(part\\|multipart\\|external\\|mml\\|secure\\)" nil t) (delete-region ... ...))))) (cond ((eq (car cont) 'mml) (let ((mml-boundary ...) (mml-generate-default-type "text/plain")) (mml-to-mime) (if mml-inhibit-compute-boundary nil (setcdr ... ...))) (let ((mm-7bit-chars ...)) (setq encoding (mm-body-7-or-8)))) ((string= (car (split-string type "/")) "message") (let ((mm-7bit-chars ...)) (setq encoding (mm-body-7-or-8)))) (t (let (use-hard-newlines) (if (and mml-enable-flowed ... ... ... ...) (progn ... ...))) (if (or charset (not ...)) (setq charset (mm-encode-body charset)) (let (...) (setq charset ...))) (setq encoding (mm-body-encoding charset (cdr ...))))) (setq coded (buffer-string))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))
  (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (cond ((cdr (assq ... cont)) (insert-buffer-substring (cdr ...))) ((and filename (not ...)) (let (...) (mm-insert-file-contents filename))) ((eq 'mml (car cont)) (insert (cdr ...))) (t (save-restriction (narrow-to-region ... ...) (insert ...) (goto-char ...) (while ... ...)))) (cond ((eq (car cont) 'mml) (let (... ...) (mml-to-mime) (if mml-inhibit-compute-boundary nil ...)) (let (...) (setq encoding ...))) ((string= (car ...) "message") (let (...) (setq encoding ...))) (t (let (use-hard-newlines) (if ... ...)) (if (or charset ...) (setq charset ...) (let ... ...)) (setq encoding (mm-body-encoding charset ...)))) (setq coded (buffer-string))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer)))))
  (progn (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (cond ((cdr ...) (insert-buffer-substring ...)) ((and filename ...) (let ... ...)) ((eq ... ...) (insert ...)) (t (save-restriction ... ... ... ...))) (cond ((eq ... ...) (let ... ... ...) (let ... ...)) ((string= ... "message") (let ... ...)) (t (let ... ...) (if ... ... ...) (setq encoding ...))) (setq coded (buffer-string))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) (mml-insert-mime-headers cont type charset encoding flowed) (insert "\n") (insert coded))
  (if (and (not raw) (member (car (split-string type "/")) '("text" "message"))) (progn (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (cond (... ...) (... ...) (... ...) (t ...)) (cond (... ... ...) (... ...) (t ... ... ...)) (setq coded (buffer-string))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) (mml-insert-mime-headers cont type charset encoding flowed) (insert "\n") (insert coded)) (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (set-buffer-multibyte nil) (cond ((cdr ...) (insert ...)) ((and filename ...) (let ... ...) (if charset nil ...)) (t (let ... ...))) (if (setq encoding (cdr ...)) (setq encoding (intern ...))) (setq encoding (mm-encode-buffer type encoding)) (setq coded (decode-coding-string (buffer-string) 'us-ascii))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) (mml-insert-mime-headers cont type charset encoding nil) (insert "\n" coded))
  (let* ((raw (cdr (assq 'raw cont))) (filename (cdr (assq 'filename cont))) (type (or (cdr (assq 'type cont)) (if filename (or (mm-default-file-encoding filename) "application/octet-stream") "text/plain"))) (charset (cdr (assq 'charset cont))) (coding (mm-charset-to-coding-system charset)) encoding flowed coded) (cond ((eq coding 'ascii) (setq charset nil coding nil)) (charset (setq charset (or (mm-coding-system-to-mime-charset coding) (intern (downcase charset)))))) (if (and (not raw) (member (car (split-string type "/")) '("text" "message"))) (progn (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (cond ... ... ... ...) (cond ... ... ...) (setq coded ...)) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) (mml-insert-mime-headers cont type charset encoding flowed) (insert "\n") (insert coded)) (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (set-buffer-multibyte nil) (cond (... ...) (... ... ...) (t ...)) (if (setq encoding ...) (setq encoding ...)) (setq encoding (mm-encode-buffer type encoding)) (setq coded (decode-coding-string ... ...))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) (mml-insert-mime-headers cont type charset encoding nil) (insert "\n" coded)))
  (cond ((or (eq (car cont) 'part) (eq (car cont) 'mml)) (let* ((raw (cdr (assq 'raw cont))) (filename (cdr (assq 'filename cont))) (type (or (cdr (assq ... cont)) (if filename (or ... "application/octet-stream") "text/plain"))) (charset (cdr (assq 'charset cont))) (coding (mm-charset-to-coding-system charset)) encoding flowed coded) (cond ((eq coding 'ascii) (setq charset nil coding nil)) (charset (setq charset (or (mm-coding-system-to-mime-charset coding) (intern ...))))) (if (and (not raw) (member (car (split-string type "/")) '("text" "message"))) (progn (let ((temp-buffer ...)) (save-current-buffer (set-buffer temp-buffer) (unwind-protect ... ...))) (mml-insert-mime-headers cont type charset encoding flowed) (insert "\n") (insert coded)) (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn ... ... ... ... ...) (and ... ...)))) (mml-insert-mime-headers cont type charset encoding nil) (insert "\n" coded)))) ((eq (car cont) 'external) (insert "Content-Type: message/external-body") (let ((parameters (mml-parameter-string cont '(expiration size permission))) (name (cdr (assq 'name cont))) (url (cdr (assq 'url cont)))) (if name (progn (setq name (mml-parse-file-name name)) (if (stringp name) (mml-insert-parameter (mail-header-encode-parameter "name" name) "access-type=local-file") (mml-insert-parameter (mail-header-encode-parameter "name" ...) (mail-header-encode-parameter "site" ...) (mail-header-encode-parameter "directory" ...)) (mml-insert-parameter (concat "access-type=" ...))))) (if url (progn (mml-insert-parameter (mail-header-encode-parameter "url" url) "access-type=url"))) (if parameters (progn (mml-insert-parameter-string cont '(expiration size permission)))) (insert "\n\n") (insert "Content-Type: " (or (cdr (assq 'type cont)) (if name (or (mm-default-file-encoding name) "application/octet-stream") "text/plain")) "\n") (insert "Content-ID: " (message-make-message-id) "\n") (insert "Content-Transfer-Encoding: " (or (cdr (assq 'encoding cont)) "binary")) (insert "\n\n") (insert (or (cdr (assq 'contents cont)))) (insert "\n"))) ((eq (car cont) 'multipart) (let* ((type (or (cdr (assq ... cont)) "mixed")) (mml-generate-default-type (if (equal type "digest") "message/rfc822" "text/plain")) (handler (assoc type mml-generate-multipart-alist))) (if handler (funcall (cdr handler) cont) (let ((mml-boundary (mml-compute-boundary cont))) (insert (format "Content-Type: multipart/%s; boundary=\"%s\"" type mml-boundary) (if (cdr ...) (format "; start=\"%s\"\n" ...) "\n")) (let ((cont cont) part) (while (setq part ...) (if ... ...))) (insert "\n--" mml-boundary "--\n"))))) (t (error "Invalid element: %S" cont)))
  (save-restriction (narrow-to-region (point) (point)) (mml-tweak-part cont) (cond ((or (eq (car cont) 'part) (eq (car cont) 'mml)) (let* ((raw (cdr (assq ... cont))) (filename (cdr (assq ... cont))) (type (or (cdr ...) (if filename ... "text/plain"))) (charset (cdr (assq ... cont))) (coding (mm-charset-to-coding-system charset)) encoding flowed coded) (cond ((eq coding 'ascii) (setq charset nil coding nil)) (charset (setq charset (or ... ...)))) (if (and (not raw) (member (car ...) '...)) (progn (let (...) (save-current-buffer ... ...)) (mml-insert-mime-headers cont type charset encoding flowed) (insert "\n") (insert coded)) (let ((temp-buffer ...)) (save-current-buffer (set-buffer temp-buffer) (unwind-protect ... ...))) (mml-insert-mime-headers cont type charset encoding nil) (insert "\n" coded)))) ((eq (car cont) 'external) (insert "Content-Type: message/external-body") (let ((parameters (mml-parameter-string cont '...)) (name (cdr (assq ... cont))) (url (cdr (assq ... cont)))) (if name (progn (setq name (mml-parse-file-name name)) (if (stringp name) (mml-insert-parameter ... "access-type=local-file") (mml-insert-parameter ... ... ...) (mml-insert-parameter ...)))) (if url (progn (mml-insert-parameter (mail-header-encode-parameter "url" url) "access-type=url"))) (if parameters (progn (mml-insert-parameter-string cont '...))) (insert "\n\n") (insert "Content-Type: " (or (cdr (assq ... cont)) (if name (or ... "application/octet-stream") "text/plain")) "\n") (insert "Content-ID: " (message-make-message-id) "\n") (insert "Content-Transfer-Encoding: " (or (cdr (assq ... cont)) "binary")) (insert "\n\n") (insert (or (cdr (assq ... cont)))) (insert "\n"))) ((eq (car cont) 'multipart) (let* ((type (or (cdr ...) "mixed")) (mml-generate-default-type (if (equal type "digest") "message/rfc822" "text/plain")) (handler (assoc type mml-generate-multipart-alist))) (if handler (funcall (cdr handler) cont) (let ((mml-boundary ...)) (insert (format "Content-Type: multipart/%s; boundary=\"%s\"" type mml-boundary) (if ... ... "\n")) (let (... part) (while ... ...)) (insert "\n--" mml-boundary "--\n"))))) (t (error "Invalid element: %S" cont))) (let ((sign-item (assoc (cdr (assq 'sign cont)) mml-sign-alist)) (encrypt-item (assoc (cdr (assq 'encrypt cont)) mml-encrypt-alist)) sender recipients) (if (or sign-item encrypt-item) (progn (if (setq sender (cdr (assq ... cont))) (progn (message-options-set 'mml-sender sender) (message-options-set 'message-sender sender))) (if (setq recipients (cdr (assq ... cont))) (message-options-set 'message-recipients recipients)) (let ((style (mml-signencrypt-style ...))) (if (and sign-item encrypt-item (equal ... ...) (equal style ...)) (funcall (nth 1 encrypt-item) cont t) (if sign-item (progn ...)) (if encrypt-item (progn ...))))))))
  (let ((mm-use-ultra-safe-encoding (or mm-use-ultra-safe-encoding (assq 'sign cont)))) (save-restriction (narrow-to-region (point) (point)) (mml-tweak-part cont) (cond ((or (eq (car cont) 'part) (eq (car cont) 'mml)) (let* ((raw (cdr ...)) (filename (cdr ...)) (type (or ... ...)) (charset (cdr ...)) (coding (mm-charset-to-coding-system charset)) encoding flowed coded) (cond ((eq coding ...) (setq charset nil coding nil)) (charset (setq charset ...))) (if (and (not raw) (member ... ...)) (progn (let ... ...) (mml-insert-mime-headers cont type charset encoding flowed) (insert "\n") (insert coded)) (let (...) (save-current-buffer ... ...)) (mml-insert-mime-headers cont type charset encoding nil) (insert "\n" coded)))) ((eq (car cont) 'external) (insert "Content-Type: message/external-body") (let ((parameters (mml-parameter-string cont ...)) (name (cdr ...)) (url (cdr ...))) (if name (progn (setq name ...) (if ... ... ... ...))) (if url (progn (mml-insert-parameter ... "access-type=url"))) (if parameters (progn (mml-insert-parameter-string cont ...))) (insert "\n\n") (insert "Content-Type: " (or (cdr ...) (if name ... "text/plain")) "\n") (insert "Content-ID: " (message-make-message-id) "\n") (insert "Content-Transfer-Encoding: " (or (cdr ...) "binary")) (insert "\n\n") (insert (or (cdr ...))) (insert "\n"))) ((eq (car cont) 'multipart) (let* ((type (or ... "mixed")) (mml-generate-default-type (if ... "message/rfc822" "text/plain")) (handler (assoc type mml-generate-multipart-alist))) (if handler (funcall (cdr handler) cont) (let (...) (insert ... ...) (let ... ...) (insert "\n--" mml-boundary "--\n"))))) (t (error "Invalid element: %S" cont))) (let ((sign-item (assoc (cdr (assq ... cont)) mml-sign-alist)) (encrypt-item (assoc (cdr (assq ... cont)) mml-encrypt-alist)) sender recipients) (if (or sign-item encrypt-item) (progn (if (setq sender (cdr ...)) (progn (message-options-set ... sender) (message-options-set ... sender))) (if (setq recipients (cdr ...)) (message-options-set 'message-recipients recipients)) (let ((style ...)) (if (and sign-item encrypt-item ... ...) (funcall ... cont t) (if sign-item ...) (if encrypt-item ...))))))))
  mml-generate-mime-1((mml (type . "message/rfc822") (disposition . "inline") (tag-location . 108) (contents . "--====-=-=\nContent-Disposition: inline\nMIME-Versio...")))
  (let ((mml-inhibit-compute-boundary t) (mml-multipart-number 0) mml-sign-alist mml-encrypt-alist) (mml-generate-mime-1 cont))
  (progn (mm-enable-multibyte) (let ((mml-inhibit-compute-boundary t) (mml-multipart-number 0) mml-sign-alist mml-encrypt-alist) (mml-generate-mime-1 cont)) (goto-char (point-min)) (if (re-search-forward (concat "^--" (regexp-quote mml-boundary)) nil t) (progn (setq mml-boundary (funcall mml-boundary-function (setq mml-multipart-number (1+ mml-multipart-number)))) (throw 'not-unique nil))))
  (unwind-protect (progn (mm-enable-multibyte) (let ((mml-inhibit-compute-boundary t) (mml-multipart-number 0) mml-sign-alist mml-encrypt-alist) (mml-generate-mime-1 cont)) (goto-char (point-min)) (if (re-search-forward (concat "^--" (regexp-quote mml-boundary)) nil t) (progn (setq mml-boundary (funcall mml-boundary-function (setq mml-multipart-number (1+ mml-multipart-number)))) (throw 'not-unique nil)))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer)))
  (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (mm-enable-multibyte) (let ((mml-inhibit-compute-boundary t) (mml-multipart-number 0) mml-sign-alist mml-encrypt-alist) (mml-generate-mime-1 cont)) (goto-char (point-min)) (if (re-search-forward (concat "^--" (regexp-quote mml-boundary)) nil t) (progn (setq mml-boundary (funcall mml-boundary-function (setq mml-multipart-number ...))) (throw 'not-unique nil)))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))
  (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (mm-enable-multibyte) (let ((mml-inhibit-compute-boundary t) (mml-multipart-number 0) mml-sign-alist mml-encrypt-alist) (mml-generate-mime-1 cont)) (goto-char (point-min)) (if (re-search-forward (concat "^--" (regexp-quote mml-boundary)) nil t) (progn (setq mml-boundary (funcall mml-boundary-function ...)) (throw 'not-unique nil)))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer)))))
  (cond ((member (car cont) '(part mml)) (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (mm-enable-multibyte) (let (... ... mml-sign-alist mml-encrypt-alist) (mml-generate-mime-1 cont)) (goto-char (point-min)) (if (re-search-forward ... nil t) (progn ... ...))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer)))))) ((eq (car cont) 'multipart) (mapc 'mml-compute-boundary-1 (cdr (cdr cont)))))
  mml-compute-boundary-1((mml (type . "message/rfc822") (disposition . "inline") (tag-location . 108) (contents . "--====-=-=\nContent-Disposition: inline\nMIME-Versio...")))
  mapc(mml-compute-boundary-1 ((tag-location . 76) (part (type . "text/plain") (contents . "Test\n\n")) (mml (type . "message/rfc822") (disposition . "inline") (tag-location . 108) (contents . "--====-=-=\nContent-Disposition: inline\nMIME-Versio..."))))
  (cond ((member (car cont) '(part mml)) (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (mm-enable-multibyte) (let (... ... mml-sign-alist mml-encrypt-alist) (mml-generate-mime-1 cont)) (goto-char (point-min)) (if (re-search-forward ... nil t) (progn ... ...))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer)))))) ((eq (car cont) 'multipart) (mapc 'mml-compute-boundary-1 (cdr (cdr cont)))))
  mml-compute-boundary-1((multipart (sign . "pgpmime") (tag-location . 76) (part (type . "text/plain") (contents . "Test\n\n")) (mml (type . "message/rfc822") (disposition . "inline") (tag-location . 108) (contents . "--====-=-=\nContent-Disposition: inline\nMIME-Versio..."))))
  (catch 'not-unique (mml-compute-boundary-1 cont))
  (not (catch 'not-unique (mml-compute-boundary-1 cont)))
  (while (not (catch 'not-unique (mml-compute-boundary-1 cont))))
  (if mml-inhibit-compute-boundary nil (while (not (catch 'not-unique (mml-compute-boundary-1 cont)))))
  (let ((mml-boundary (funcall mml-boundary-function (setq mml-multipart-number (1+ mml-multipart-number))))) (if mml-inhibit-compute-boundary nil (while (not (catch 'not-unique (mml-compute-boundary-1 cont))))) mml-boundary)
  mml-compute-boundary((multipart (sign . "pgpmime") (tag-location . 76) (part (type . "text/plain") (contents . "Test\n\n")) (mml (type . "message/rfc822") (disposition . "inline") (tag-location . 108) (contents . "--====-=-=\nContent-Disposition: inline\nMIME-Versio..."))))
  mml2015-epg-sign((multipart (sign . "pgpmime") (tag-location . 76) (part (type . "text/plain") (contents . "Test\n\n")) (mml (type . "message/rfc822") (disposition . "inline") (tag-location . 108) (contents . "--====-=-=\nContent-Disposition: inline\nMIME-Versio..."))))
  mml2015-sign((multipart (sign . "pgpmime") (tag-location . 76) (part (type . "text/plain") (contents . "Test\n\n")) (mml (type . "message/rfc822") (disposition . "inline") (tag-location . 108) (contents . "--====-=-=\nContent-Disposition: inline\nMIME-Versio..."))))
  mml-pgpmime-sign-buffer((multipart (sign . "pgpmime") (tag-location . 76) (part (type . "text/plain") (contents . "Test\n\n")) (mml (type . "message/rfc822") (disposition . "inline") (tag-location . 108) (contents . "--====-=-=\nContent-Disposition: inline\nMIME-Versio..."))))
  funcall(mml-pgpmime-sign-buffer (multipart (sign . "pgpmime") (tag-location . 76) (part (type . "text/plain") (contents . "Test\n\n")) (mml (type . "message/rfc822") (disposition . "inline") (tag-location . 108) (contents . "--====-=-=\nContent-Disposition: inline\nMIME-Versio..."))))
  (progn (funcall (nth 1 sign-item) cont))
  (if sign-item (progn (funcall (nth 1 sign-item) cont)))
  (if (and sign-item encrypt-item (equal (car sign-item) (car encrypt-item)) (equal style 'combined)) (funcall (nth 1 encrypt-item) cont t) (if sign-item (progn (funcall (nth 1 sign-item) cont))) (if encrypt-item (progn (funcall (nth 1 encrypt-item) cont))))
  (let ((style (mml-signencrypt-style (car (or sign-item encrypt-item))))) (if (and sign-item encrypt-item (equal (car sign-item) (car encrypt-item)) (equal style 'combined)) (funcall (nth 1 encrypt-item) cont t) (if sign-item (progn (funcall (nth 1 sign-item) cont))) (if encrypt-item (progn (funcall (nth 1 encrypt-item) cont)))))
  (progn (if (setq sender (cdr (assq 'sender cont))) (progn (message-options-set 'mml-sender sender) (message-options-set 'message-sender sender))) (if (setq recipients (cdr (assq 'recipients cont))) (message-options-set 'message-recipients recipients)) (let ((style (mml-signencrypt-style (car (or sign-item encrypt-item))))) (if (and sign-item encrypt-item (equal (car sign-item) (car encrypt-item)) (equal style 'combined)) (funcall (nth 1 encrypt-item) cont t) (if sign-item (progn (funcall (nth 1 sign-item) cont))) (if encrypt-item (progn (funcall (nth 1 encrypt-item) cont))))))
  (if (or sign-item encrypt-item) (progn (if (setq sender (cdr (assq 'sender cont))) (progn (message-options-set 'mml-sender sender) (message-options-set 'message-sender sender))) (if (setq recipients (cdr (assq 'recipients cont))) (message-options-set 'message-recipients recipients)) (let ((style (mml-signencrypt-style (car (or sign-item encrypt-item))))) (if (and sign-item encrypt-item (equal (car sign-item) (car encrypt-item)) (equal style 'combined)) (funcall (nth 1 encrypt-item) cont t) (if sign-item (progn (funcall (nth 1 sign-item) cont))) (if encrypt-item (progn (funcall (nth 1 encrypt-item) cont)))))))
  (let ((sign-item (assoc (cdr (assq 'sign cont)) mml-sign-alist)) (encrypt-item (assoc (cdr (assq 'encrypt cont)) mml-encrypt-alist)) sender recipients) (if (or sign-item encrypt-item) (progn (if (setq sender (cdr (assq 'sender cont))) (progn (message-options-set 'mml-sender sender) (message-options-set 'message-sender sender))) (if (setq recipients (cdr (assq 'recipients cont))) (message-options-set 'message-recipients recipients)) (let ((style (mml-signencrypt-style (car ...)))) (if (and sign-item encrypt-item (equal (car sign-item) (car encrypt-item)) (equal style 'combined)) (funcall (nth 1 encrypt-item) cont t) (if sign-item (progn (funcall ... cont))) (if encrypt-item (progn (funcall ... cont))))))))
  (save-restriction (narrow-to-region (point) (point)) (mml-tweak-part cont) (cond ((or (eq (car cont) 'part) (eq (car cont) 'mml)) (let* ((raw (cdr (assq ... cont))) (filename (cdr (assq ... cont))) (type (or (cdr ...) (if filename ... "text/plain"))) (charset (cdr (assq ... cont))) (coding (mm-charset-to-coding-system charset)) encoding flowed coded) (cond ((eq coding 'ascii) (setq charset nil coding nil)) (charset (setq charset (or ... ...)))) (if (and (not raw) (member (car ...) '...)) (progn (let (...) (save-current-buffer ... ...)) (mml-insert-mime-headers cont type charset encoding flowed) (insert "\n") (insert coded)) (let ((temp-buffer ...)) (save-current-buffer (set-buffer temp-buffer) (unwind-protect ... ...))) (mml-insert-mime-headers cont type charset encoding nil) (insert "\n" coded)))) ((eq (car cont) 'external) (insert "Content-Type: message/external-body") (let ((parameters (mml-parameter-string cont '...)) (name (cdr (assq ... cont))) (url (cdr (assq ... cont)))) (if name (progn (setq name (mml-parse-file-name name)) (if (stringp name) (mml-insert-parameter ... "access-type=local-file") (mml-insert-parameter ... ... ...) (mml-insert-parameter ...)))) (if url (progn (mml-insert-parameter (mail-header-encode-parameter "url" url) "access-type=url"))) (if parameters (progn (mml-insert-parameter-string cont '...))) (insert "\n\n") (insert "Content-Type: " (or (cdr (assq ... cont)) (if name (or ... "application/octet-stream") "text/plain")) "\n") (insert "Content-ID: " (message-make-message-id) "\n") (insert "Content-Transfer-Encoding: " (or (cdr (assq ... cont)) "binary")) (insert "\n\n") (insert (or (cdr (assq ... cont)))) (insert "\n"))) ((eq (car cont) 'multipart) (let* ((type (or (cdr ...) "mixed")) (mml-generate-default-type (if (equal type "digest") "message/rfc822" "text/plain")) (handler (assoc type mml-generate-multipart-alist))) (if handler (funcall (cdr handler) cont) (let ((mml-boundary ...)) (insert (format "Content-Type: multipart/%s; boundary=\"%s\"" type mml-boundary) (if ... ... "\n")) (let (... part) (while ... ...)) (insert "\n--" mml-boundary "--\n"))))) (t (error "Invalid element: %S" cont))) (let ((sign-item (assoc (cdr (assq 'sign cont)) mml-sign-alist)) (encrypt-item (assoc (cdr (assq 'encrypt cont)) mml-encrypt-alist)) sender recipients) (if (or sign-item encrypt-item) (progn (if (setq sender (cdr (assq ... cont))) (progn (message-options-set 'mml-sender sender) (message-options-set 'message-sender sender))) (if (setq recipients (cdr (assq ... cont))) (message-options-set 'message-recipients recipients)) (let ((style (mml-signencrypt-style ...))) (if (and sign-item encrypt-item (equal ... ...) (equal style ...)) (funcall (nth 1 encrypt-item) cont t) (if sign-item (progn ...)) (if encrypt-item (progn ...))))))))
  (let ((mm-use-ultra-safe-encoding (or mm-use-ultra-safe-encoding (assq 'sign cont)))) (save-restriction (narrow-to-region (point) (point)) (mml-tweak-part cont) (cond ((or (eq (car cont) 'part) (eq (car cont) 'mml)) (let* ((raw (cdr ...)) (filename (cdr ...)) (type (or ... ...)) (charset (cdr ...)) (coding (mm-charset-to-coding-system charset)) encoding flowed coded) (cond ((eq coding ...) (setq charset nil coding nil)) (charset (setq charset ...))) (if (and (not raw) (member ... ...)) (progn (let ... ...) (mml-insert-mime-headers cont type charset encoding flowed) (insert "\n") (insert coded)) (let (...) (save-current-buffer ... ...)) (mml-insert-mime-headers cont type charset encoding nil) (insert "\n" coded)))) ((eq (car cont) 'external) (insert "Content-Type: message/external-body") (let ((parameters (mml-parameter-string cont ...)) (name (cdr ...)) (url (cdr ...))) (if name (progn (setq name ...) (if ... ... ... ...))) (if url (progn (mml-insert-parameter ... "access-type=url"))) (if parameters (progn (mml-insert-parameter-string cont ...))) (insert "\n\n") (insert "Content-Type: " (or (cdr ...) (if name ... "text/plain")) "\n") (insert "Content-ID: " (message-make-message-id) "\n") (insert "Content-Transfer-Encoding: " (or (cdr ...) "binary")) (insert "\n\n") (insert (or (cdr ...))) (insert "\n"))) ((eq (car cont) 'multipart) (let* ((type (or ... "mixed")) (mml-generate-default-type (if ... "message/rfc822" "text/plain")) (handler (assoc type mml-generate-multipart-alist))) (if handler (funcall (cdr handler) cont) (let (...) (insert ... ...) (let ... ...) (insert "\n--" mml-boundary "--\n"))))) (t (error "Invalid element: %S" cont))) (let ((sign-item (assoc (cdr (assq ... cont)) mml-sign-alist)) (encrypt-item (assoc (cdr (assq ... cont)) mml-encrypt-alist)) sender recipients) (if (or sign-item encrypt-item) (progn (if (setq sender (cdr ...)) (progn (message-options-set ... sender) (message-options-set ... sender))) (if (setq recipients (cdr ...)) (message-options-set 'message-recipients recipients)) (let ((style ...)) (if (and sign-item encrypt-item ... ...) (funcall ... cont t) (if sign-item ...) (if encrypt-item ...))))))))
  mml-generate-mime-1((multipart (sign . "pgpmime") (tag-location . 76) (part (type . "text/plain") (contents . "Test\n\n")) (mml (type . "message/rfc822") (disposition . "inline") (tag-location . 108) (contents . "--====-=-=\nContent-Disposition: inline\nMIME-Versio..."))))
  (cond ((and (consp (car cont)) (= (length cont) 1)) (mml-generate-mime-1 (car cont))) ((eq (car cont) 'multipart) (mml-generate-mime-1 cont)) (t (mml-generate-mime-1 (nconc (list 'multipart (cons 'type (or multipart-type "mixed"))) cont))))
  (progn (set-buffer-multibyte nil) (setq message-options options) (cond ((and (consp (car cont)) (= (length cont) 1)) (mml-generate-mime-1 (car cont))) ((eq (car cont) 'multipart) (mml-generate-mime-1 cont)) (t (mml-generate-mime-1 (nconc (list 'multipart (cons 'type (or multipart-type "mixed"))) cont)))) (setq options message-options) (buffer-string))
  (unwind-protect (progn (set-buffer-multibyte nil) (setq message-options options) (cond ((and (consp (car cont)) (= (length cont) 1)) (mml-generate-mime-1 (car cont))) ((eq (car cont) 'multipart) (mml-generate-mime-1 cont)) (t (mml-generate-mime-1 (nconc (list 'multipart (cons ... ...)) cont)))) (setq options message-options) (buffer-string)) (and (buffer-name temp-buffer) (kill-buffer temp-buffer)))
  (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (set-buffer-multibyte nil) (setq message-options options) (cond ((and (consp (car cont)) (= (length cont) 1)) (mml-generate-mime-1 (car cont))) ((eq (car cont) 'multipart) (mml-generate-mime-1 cont)) (t (mml-generate-mime-1 (nconc (list ... ...) cont)))) (setq options message-options) (buffer-string)) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))
  (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (set-buffer-multibyte nil) (setq message-options options) (cond ((and (consp ...) (= ... 1)) (mml-generate-mime-1 (car cont))) ((eq (car cont) 'multipart) (mml-generate-mime-1 cont)) (t (mml-generate-mime-1 (nconc ... cont)))) (setq options message-options) (buffer-string)) (and (buffer-name temp-buffer) (kill-buffer temp-buffer)))))
  (prog1 (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (set-buffer-multibyte nil) (setq message-options options) (cond ((and ... ...) (mml-generate-mime-1 ...)) ((eq ... ...) (mml-generate-mime-1 cont)) (t (mml-generate-mime-1 ...))) (setq options message-options) (buffer-string)) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) (setq message-options options))
  (if (not cont) nil (if (and (consp (car cont)) (= (length cont) 1) content-type) (progn (setcdr (assq 'type (cdr (car cont))) content-type))) (if (and (consp (car cont)) (= (length cont) 1) (fboundp 'libxml-parse-html-region) (equal (cdr (assq 'type (car cont))) "text/html")) (progn (setq cont (mml-expand-html-into-multipart-related (car cont))))) (prog1 (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (set-buffer-multibyte nil) (setq message-options options) (cond (... ...) (... ...) (t ...)) (setq options message-options) (buffer-string)) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) (setq message-options options)))
  (let ((cont (mml-parse)) (mml-multipart-number mml-multipart-number) (options message-options)) (if (not cont) nil (if (and (consp (car cont)) (= (length cont) 1) content-type) (progn (setcdr (assq 'type (cdr (car cont))) content-type))) (if (and (consp (car cont)) (= (length cont) 1) (fboundp 'libxml-parse-html-region) (equal (cdr (assq 'type (car cont))) "text/html")) (progn (setq cont (mml-expand-html-into-multipart-related (car cont))))) (prog1 (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (set-buffer-multibyte nil) (setq message-options options) (cond ... ... ...) (setq options message-options) (buffer-string)) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) (setq message-options options))))
  mml-generate-mime(nil nil)
  message-encode-message-body()
  mml-to-mime()
  (progn (goto-char (point-min)) (mml-to-mime) nil)
  (condition-case nil (progn (goto-char (point-min)) (mml-to-mime) nil) (error t))
  (or (condition-case nil (progn (goto-char (point-min)) (mml-to-mime) nil) (error t)) (cl--assertion-failed '(condition-case nil (progn (goto-char (point-min)) (mml-to-mime) nil) (error t))))
  eval-buffer(#<buffer  *load*> nil "/home/npostavs/src/emacs/bug-39884-bad-mml-parsing..." nil t)  ; Reading at buffer position 2861
  load-with-code-conversion("/home/npostavs/src/emacs/bug-39884-bad-mml-parsing..." "/home/npostavs/src/emacs/bug-39884-bad-mml-parsing..." nil nil)
  load("/home/npostavs/src/emacs/bug-39884-bad-mml-parsing..." nil nil t)
  load-file("~/src/emacs/bug-39884-bad-mml-parsing.el")
  funcall-interactively(load-file "~/src/emacs/bug-39884-bad-mml-parsing.el")
  call-interactively(load-file record nil)
  command-execute(load-file record)
  execute-extended-command(nil "load-file" "load-fi")
  funcall-interactively(execute-extended-command nil "load-file" "load-fi")
  call-interactively(execute-extended-command nil nil)
  command-execute(execute-extended-command)

[-- Attachment #5: Type: text/plain, Size: 263 bytes --]


The fix is simply to make a fresh cons instead of using a quoted literal
(your backquote fix macroexpands to the same thing, but it's not
sufficiently obvious enough for a human reader to realize that), this
should be safe enough to put on the emacs-27 branch:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: patch --]
[-- Type: text/x-diff, Size: 845 bytes --]

From 16c77ed31d836c374b37cbdf03947567fc7b8581 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Thu, 16 Apr 2020 20:24:26 -0400
Subject: [PATCH] Don't let a code literal get modified in mml parsing
 (Bug#39884)

* lisp/gnus/mml.el (mml-parse-1): Make a fresh cons for the tag type,
because 'mml-generate-mime' destructively modifies it.
---
 lisp/gnus/mml.el | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index cdd8f3d3a5..556cf0804a 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -281,7 +281,7 @@ mml-parse-1
 	    (setq tag (mml-read-tag)
 		  no-markup-p nil
 		  warn nil)
-	  (setq tag (list 'part '(type . "text/plain"))
+	  (setq tag (list 'part (cons 'type "text/plain"))
 		no-markup-p t
 		warn t))
 	(setq raw (cdr (assq 'raw tag))
-- 
2.11.0