* bug#39884: 27.0.50; Emacs may destroy outgoing email messages during sending
@ 2020-03-03 15:36 Rainer Gemulla
2020-04-15 7:51 ` bug#39884: Simple fix Rainer Gemulla
2020-04-17 0:30 ` Noam Postavsky
0 siblings, 2 replies; 10+ messages in thread
From: Rainer Gemulla @ 2020-03-03 15:36 UTC (permalink / raw)
To: 39884
[-- 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 --]
^ permalink raw reply [flat|nested] 10+ messages in thread
* bug#39884: Simple fix
2020-03-03 15:36 bug#39884: 27.0.50; Emacs may destroy outgoing email messages during sending Rainer Gemulla
@ 2020-04-15 7:51 ` Rainer Gemulla
2020-04-15 12:24 ` bug#39884: 27.0.50; Emacs may destroy outgoing email messages during sending Noam Postavsky
2020-04-17 0:30 ` Noam Postavsky
1 sibling, 1 reply; 10+ messages in thread
From: Rainer Gemulla @ 2020-04-15 7:51 UTC (permalink / raw)
To: 39884
[-- 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 --]
^ permalink raw reply [flat|nested] 10+ messages in thread
* bug#39884: 27.0.50; Emacs may destroy outgoing email messages during sending
2020-04-15 7:51 ` bug#39884: Simple fix Rainer Gemulla
@ 2020-04-15 12:24 ` Noam Postavsky
2020-04-15 12:57 ` Rainer Gemulla
0 siblings, 1 reply; 10+ messages in thread
From: Noam Postavsky @ 2020-04-15 12:24 UTC (permalink / raw)
To: Rainer Gemulla; +Cc: 39884
[-- 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)
^ permalink raw reply [flat|nested] 10+ messages in thread
* bug#39884: 27.0.50; Emacs may destroy outgoing email messages during sending
2020-04-15 12:24 ` bug#39884: 27.0.50; Emacs may destroy outgoing email messages during sending Noam Postavsky
@ 2020-04-15 12:57 ` Rainer Gemulla
2020-04-15 13:11 ` Noam Postavsky
0 siblings, 1 reply; 10+ messages in thread
From: Rainer Gemulla @ 2020-04-15 12:57 UTC (permalink / raw)
To: 39884
[-- 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 --]
^ permalink raw reply [flat|nested] 10+ messages in thread
* bug#39884: 27.0.50; Emacs may destroy outgoing email messages during sending
2020-04-15 12:57 ` Rainer Gemulla
@ 2020-04-15 13:11 ` Noam Postavsky
0 siblings, 0 replies; 10+ messages in thread
From: Noam Postavsky @ 2020-04-15 13:11 UTC (permalink / raw)
To: Rainer Gemulla; +Cc: 39884
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.
^ permalink raw reply [flat|nested] 10+ messages in thread
* bug#39884: 27.0.50; Emacs may destroy outgoing email messages during sending
2020-03-03 15:36 bug#39884: 27.0.50; Emacs may destroy outgoing email messages during sending Rainer Gemulla
2020-04-15 7:51 ` bug#39884: Simple fix Rainer Gemulla
@ 2020-04-17 0:30 ` Noam Postavsky
2020-04-17 7:48 ` Rainer Gemulla
` (2 more replies)
1 sibling, 3 replies; 10+ messages in thread
From: Noam Postavsky @ 2020-04-17 0:30 UTC (permalink / raw)
To: Rainer Gemulla; +Cc: 39884
[-- 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
^ permalink raw reply related [flat|nested] 10+ messages in thread
* bug#39884: 27.0.50; Emacs may destroy outgoing email messages during sending
2020-04-17 0:30 ` Noam Postavsky
@ 2020-04-17 7:48 ` Rainer Gemulla
2020-04-17 7:49 ` Rainer Gemulla
2020-04-17 9:54 ` Eli Zaretskii
2 siblings, 0 replies; 10+ messages in thread
From: Rainer Gemulla @ 2020-04-17 7:48 UTC (permalink / raw)
To: Noam Postavsky; +Cc: 39884
[-- 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 --]
^ permalink raw reply [flat|nested] 10+ messages in thread
* bug#39884: 27.0.50; Emacs may destroy outgoing email messages during sending
2020-04-17 0:30 ` Noam Postavsky
2020-04-17 7:48 ` Rainer Gemulla
@ 2020-04-17 7:49 ` Rainer Gemulla
2020-04-17 9:54 ` Eli Zaretskii
2 siblings, 0 replies; 10+ messages in thread
From: Rainer Gemulla @ 2020-04-17 7:49 UTC (permalink / raw)
To: Noam Postavsky; +Cc: 39884
[-- 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 --]
^ permalink raw reply [flat|nested] 10+ messages in thread
* bug#39884: 27.0.50; Emacs may destroy outgoing email messages during sending
2020-04-17 0:30 ` Noam Postavsky
2020-04-17 7:48 ` Rainer Gemulla
2020-04-17 7:49 ` Rainer Gemulla
@ 2020-04-17 9:54 ` Eli Zaretskii
2020-04-25 13:59 ` Noam Postavsky
2 siblings, 1 reply; 10+ messages in thread
From: Eli Zaretskii @ 2020-04-17 9:54 UTC (permalink / raw)
To: Noam Postavsky; +Cc: 39884, rgemulla
> 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.
^ permalink raw reply [flat|nested] 10+ messages in thread
end of thread, other threads:[~2020-04-25 13:59 UTC | newest]
Thread overview: 10+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2020-03-03 15:36 bug#39884: 27.0.50; Emacs may destroy outgoing email messages during sending Rainer Gemulla
2020-04-15 7:51 ` bug#39884: Simple fix Rainer Gemulla
2020-04-15 12:24 ` bug#39884: 27.0.50; Emacs may destroy outgoing email messages during sending Noam Postavsky
2020-04-15 12:57 ` Rainer Gemulla
2020-04-15 13:11 ` Noam Postavsky
2020-04-17 0:30 ` Noam Postavsky
2020-04-17 7:48 ` Rainer Gemulla
2020-04-17 7:49 ` Rainer Gemulla
2020-04-17 9:54 ` Eli Zaretskii
2020-04-25 13:59 ` Noam Postavsky
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).