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

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

[Rainer Gemulla]

[-- Attachment #1.1: Type: text/plain, Size: 4120 bytes --]

I am composing emails using Emacs message mode. Shortly after switching 
to Emacs 27, some people complained to me that they could not read some 
of emails I sent them. I checked in my local email archive: even my 
archived emails were not readable with Emacs any more. This is a major 
bug, and for this reason I switched back to Emacs 26. It is my current 
understanding that the bug occurs when (1) forwarding messages and (2) 
signing the forwarded messages using GPG. So not everyone seems to be 
affected. Nevertheless, I experienced this bug on multiple machines (in 
fact, on all machines that I tried).

The rest of this email explains where the bug arises and how to 
reproduce it.

Before sending an email, Emacs converts the email text to MIME. This 
conversion process is performed by a function called mml-to-mime. I 
found that this function (or it's interaction with signing) is 
responsible for Emacs 27 destroying emails: the produced MIME can be 
invalid. This happens mostly when there are multiple mml parts in the 
original email, which is the case when forwarding an email.

After some playing around, I found a way to reproduce the bug. It's 
somewhat painful, but the error consistently arises. I first list the 
steps, then the original email, then its correct MIME encoding, and the 
incorrect MIME encoding that Emacs may produce. Note that step 3+4 
encode the message for the first time (all fine), steps 5-7 add signing, 
steps 8-9 encode the orginal message again (without signing, now 
broken).

1. Run: emacs -Q

2. M-x message-mode
3. Clear scratch buffer, paste original message
4. M-: (mml-to-mime) --> gives CORRECT result

5. Clear scratch buffer, paste original 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.
7. M-: (mml-to-mime) --> throws (expected) signer name error

8. Clear scratch buffer, paste original message
9. M-: (mml-to-mime)
   --> broken result (first Content-Type after "text follows..." is 
wrong)

I tried to track down the bug further and found this piece of code in 
mml-parse-1, line 284:

(setq tag (list 'part '(type . "text/plain"))
       no-markup-p t
       warn t)

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 (as in the incorrect result 
below). At this point I gave up, looks like a deeper problem.


ORIGINAL MESSAGE
From: a@b.ce
To: c@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>


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.

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

--=-=-=--


INCORRECT RESULT AFTER 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.

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

--=-=-=--

[-- Attachment #1.2: Type: text/html, Size: 9420 bytes --]

[-- Attachment #2: Type: application/pgp-signature, Size: 876 bytes --]

bug#39884: Simple fix

[Rainer Gemulla]

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

Replacing in function mml-parse-1 (mml.el, line 284):

(setq tag (list 'part '(type . "text/plain"))
       no-markup-p t
       warn t)

with

(setq tag `(part (type . ,"text/plain"))
      no-markup-p t
      warn t)

seems to fix this bug. It's not clear to me why though.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 857 bytes --]

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

[Noam Postavsky]

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

On Wed, 15 Apr 2020 at 03:55, Rainer Gemulla <rgemulla@gmx.de> wrote:
>
> Replacing in function mml-parse-1 (mml.el, line 284):
>
> (setq tag (list 'part '(type . "text/plain"))
>        no-markup-p t
>        warn t)
>
> with
>
> (setq tag `(part (type . ,"text/plain"))
>       no-markup-p t
>       warn t)
>
> seems to fix this bug. It's not clear to me why though.

mml-parse-1 calls nconc on tag, so it's likely some destructive
modification of code literals is happening. However, I'm not able to
reproduce the bug following your instructions on the latest emacs-27
checkout. I'm attaching a lisp file which automates the process (I
also tried doing it manually, in case that makes a difference).

[-- Attachment #2: bug-39884-bad-mml-parsing.el --]
[-- Type: text/x-emacs-lisp, Size: 2613 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-correct-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.

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

--=-=-=--
")

;; 2. M-x message-mode
(message-mode)
;; 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)

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

[Rainer Gemulla]

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

Perhaps just a typo: what's called "39884-correct-results-of-step-9" in your code is actually the incorrect result. I.e., step 9 should also produce bug-39884-correct-result.

I ran your lisp file via "emacs -Q -l bug-39884-bad-mml-parsing.el" using the emacs-27 branch as of this morning. At least on my machines, I am getting the incorrect result. If you don't see the bug, it may be hard to track down. I've seen it on all my machines, but I am only running Ubuntu (different versions though). So it may be related to the environment being used.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 857 bytes --]

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

[Noam Postavsky]

tags 39884 + confirmed
quit

Rainer Gemulla <rgemulla@gmx.de> writes:

> Perhaps just a typo: what's called "39884-correct-results-of-step-9"
> in your code is actually the incorrect result. I.e., step 9 should
> also produce bug-39884-correct-result.

Aha, I misread.

> I ran your lisp file via "emacs -Q -l bug-39884-bad-mml-parsing.el"
> using the emacs-27 branch as of this morning. At least on my machines,
> I am getting the incorrect result.

Yes, me too.  For some reason, I was expecting to get an error on step
9.  Upon re-reading your original report, I can't see how I thought
that.

I'll look into the code later today or tonight.

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

[Noam Postavsky]

[-- 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

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

[Rainer Gemulla]

[-- Attachment #1: Type: text/plain, Size: 308 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:

Thanks! Your patch also works for me.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 857 bytes --]

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

[Rainer Gemulla]

[-- Attachment #1: Type: text/plain, Size: 308 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:

Thanks! Your patch also works for me.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 857 bytes --]

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

[Eli Zaretskii]

> From: Noam Postavsky <npostavs@gmail.com>
> Date: Thu, 16 Apr 2020 20:30:14 -0400
> Cc: 39884@debbugs.gnu.org
> 
> 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:

Fine with me, thanks.

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

[Noam Postavsky]

tags 39884 fixed
close 39884 27.1
quit

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Noam Postavsky <npostavs@gmail.com>
>> Date: Thu, 16 Apr 2020 20:30:14 -0400
>> Cc: 39884@debbugs.gnu.org
>> 
>> 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:
>
> Fine with me, thanks.

Pushed to emacs-27.

[1: 821760fdc4]: 2020-04-25 09:55:36 -0400
  Don't let a code literal get modified in mml parsing (Bug#39884)
  https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=821760fdc439214f57212708e23d5c87088d34ee