From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.ciao.gmane.io!not-for-mail From: Noam Postavsky Newsgroups: gmane.emacs.bugs Subject: bug#39884: 27.0.50; Emacs may destroy outgoing email messages during sending Date: Thu, 16 Apr 2020 20:30:14 -0400 Message-ID: <87mu7b2bu1.fsf@gmail.com> References: Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="==-=-=" Injection-Info: ciao.gmane.io; posting-host="ciao.gmane.io:159.69.161.202"; logging-data="22506"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.90 (gnu/linux) Cc: 39884@debbugs.gnu.org To: "Rainer Gemulla" Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Fri Apr 17 02:31:32 2020 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1jPEup-0005iW-2r for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 17 Apr 2020 02:31:31 +0200 Original-Received: from localhost ([::1]:40598 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jPEun-0007N0-Rt for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 16 Apr 2020 20:31:29 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:56586) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jPEuQ-0007K1-Ud for bug-gnu-emacs@gnu.org; Thu, 16 Apr 2020 20:31:12 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1jPEuM-00025W-9H for bug-gnu-emacs@gnu.org; Thu, 16 Apr 2020 20:31:06 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:56274) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1jPEuL-00025D-Q9 for bug-gnu-emacs@gnu.org; Thu, 16 Apr 2020 20:31:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jPEuL-0005ZZ-Mf for bug-gnu-emacs@gnu.org; Thu, 16 Apr 2020 20:31:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Noam Postavsky Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 17 Apr 2020 00:31:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 39884 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: confirmed Original-Received: via spool by 39884-submit@debbugs.gnu.org id=B39884.158708342921384 (code B ref 39884); Fri, 17 Apr 2020 00:31:01 +0000 Original-Received: (at 39884) by debbugs.gnu.org; 17 Apr 2020 00:30:29 +0000 Original-Received: from localhost ([127.0.0.1]:39587 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jPEtn-0005Xp-NF for submit@debbugs.gnu.org; Thu, 16 Apr 2020 20:30:29 -0400 Original-Received: from mail-qv1-f51.google.com ([209.85.219.51]:42947) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jPEti-0005XT-TV; Thu, 16 Apr 2020 20:30:24 -0400 Original-Received: by mail-qv1-f51.google.com with SMTP id v18so94785qvx.9; Thu, 16 Apr 2020 17:30:22 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=D7qivBy/nKeIMJcLibViUCSJCJfQCr58xrZkb+1uQts=; b=ZKwceTjF3mJRLXH1GzpHO8Ar6uDK2+11sgTvihPgs5PJKWolJduI2UbzopAO4R0DIK FHZle2Ltxo4iOam8opqKfYEHluH0rnPImCC5qhk/ZMM60QpOZ21skYWY6eA1AAUhvwZS 8TyLliCEtPfL9+dgOUYLqIDbNyWxP6R/ZcCsWl1SZUOKfXLBdQpXQA9DGQYHN7eHmXkx TdVdiqRD8+jNgHpwp4cfgezzBJnYZG6xj8ei9kQn1sGNmYuOUB/cwi+YxNP+SGjrpdVi zue/ZqaJElWdioImz3RIVxBNzJDo8xyl7FgEO3NokZPhbpKTeG1zFa6yuJMEiUID6RBq NbYA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version; bh=D7qivBy/nKeIMJcLibViUCSJCJfQCr58xrZkb+1uQts=; b=NhevO26C1IDPPoBtWxM8NX7yoaHscXNqC90zSbHDgZ0JzS2MC8jDEBGq8//V8rEGFe zxOlLRi6J5F4svWA6r2lWBO4E9YaY466Hlvq+uobjlC8oTphCjFlIJ5yIB9kd5jQEyRv 5LVFO4MRmOggtDOs3k5PZJ3t5gxRSrgP+sAnSKxyofWBpvsYzQjMZC+3174yUa8wwxE6 XSJWuRvWUISMHavKz0zDRk/lyeeykiGk1ZYt33KKGvOeDRFty+xCXsTZhH2eFseYmPol aVFxNvdOa7RPdZzPvXdYO90k9xJWMuHaIGqdxLKMxyLHO29U2iRTi2iIRLYLQgOemyPz RABg== X-Gm-Message-State: AGi0PuYiqr2QgHtd3i1Hdn7BZY5/qSKXGDeDiMJKRdkiiekjRB5tZkih GxkgFgCjebEZFPMf+8Dtf5ZKe8XU X-Google-Smtp-Source: APiQypKAFkBxTKM5ZEE97LlwAnMJklRFioPgTaUvdXn2d0dOYYHDHoH1Esd1K2VOogITeuR/bgp+Ug== X-Received: by 2002:a0c:b651:: with SMTP id q17mr277269qvf.135.1587083417198; Thu, 16 Apr 2020 17:30:17 -0700 (PDT) Original-Received: from minid (cbl-45-2-119-47.yyz.frontiernetworks.ca. [45.2.119.47]) by smtp.gmail.com with ESMTPSA id 134sm3090089qki.16.2020.04.16.17.30.15 (version=TLS1_2 cipher=ECDHE-ECDSA-CHACHA20-POLY1305 bits=256/256); Thu, 16 Apr 2020 17:30:16 -0700 (PDT) In-Reply-To: (Rainer Gemulla's message of "Tue, 03 Mar 2020 15:36:37 +0000") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:178484 Archived-At: --==-=-= Content-Type: text/plain tags 39884 + patch quit "Rainer Gemulla" 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. --==-=-= Content-Type: text/plain Content-Disposition: attachment; filename=bug-39884-bad-mml-parsing.el Content-Description: bug reproducer (defconst bug-39884-orig-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> ") (defconst bug-39884-correct-result "\ From: a b.ce To: c 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 b.ce To: c 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) --==-=-= Content-Type: text/plain This gives the backtrace: --==-=-= Content-Type: text/plain Content-Disposition: attachment; filename=setcdr-backtrace.txt Content-Transfer-Encoding: quoted-printable Content-Description: backtrace from the guilty setcdr Debugger entered: nil (progn (debug nil)) (if (eq cell mml-text/plain-tag-literal-constant) (progn (debug nil))) check-setcdr(# (type . "text/plain") "multipart/alternative;= boundary=3D\"=3D=3D=3D=3D-=3D-=3D\"") apply(check-setcdr # ((type . "text/plain") "multipart/alter= native; boundary=3D\"=3D=3D=3D=3D-=3D-=3D\"")) setcdr((type . "text/plain") "multipart/alternative; boundary=3D\"=3D=3D= =3D=3D-=3D-=3D\"") (progn (setcdr (assq 'type (cdr (car cont))) content-type)) (if (and (consp (car cont)) (=3D (length cont) 1) content-type) (progn (s= etcdr (assq 'type (cdr (car cont))) content-type))) (if (not cont) nil (if (and (consp (car cont)) (=3D (length cont) 1) cont= ent-type) (progn (setcdr (assq 'type (cdr (car cont))) content-type))) (if = (and (consp (car cont)) (=3D (length cont) 1) (fboundp 'libxml-parse-html-r= egion) (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 t= emp-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) (opt= ions message-options)) (if (not cont) nil (if (and (consp (car cont)) (=3D = (length cont) 1) content-type) (progn (setcdr (assq 'type (cdr (car cont)))= content-type))) (if (and (consp (car cont)) (=3D (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-multiby= te nil) (setq message-options options) (cond ... ... ...) (setq options mes= sage-options) (buffer-string)) (and (buffer-name temp-buffer) (kill-buffer = temp-buffer))))) (setq message-options options)))) mml-generate-mime(nil "multipart/alternative; boundary=3D\"=3D=3D=3D=3D-= =3D-=3D\"") message-encode-message-body() mml-to-mime() (let ((mml-boundary (mml-compute-boundary cont)) (mml-generate-default-ty= pe "text/plain")) (mml-to-mime) (if mml-inhibit-compute-boundary nil (setcd= r (assoc 'contents cont) (buffer-string)))) (cond ((eq (car cont) 'mml) (let ((mml-boundary (mml-compute-boundary con= t)) (mml-generate-default-type "text/plain")) (mml-to-mime) (if mml-inhibit= -compute-boundary nil (setcdr (assoc 'contents cont) (buffer-string)))) (le= t ((mm-7bit-chars (concat mm-7bit-chars "\33"))) (setq encoding (mm-body-7-= or-8)))) ((string=3D (car (split-string type "/")) "message") (let ((mm-7bi= t-chars (concat mm-7bit-chars "\33"))) (setq encoding (mm-body-7-or-8)))) (= t (let (use-hard-newlines) (if (and mml-enable-flowed (string=3D type "text= /plain") (not (string=3D (cdr ...) "pgp")) (or (null (assq ... cont)) (stri= ng=3D (cdr ...) "flowed")) (setq use-hard-newlines (text-property-any (poin= t-min) (point-max) 'hard 't))) (progn (fill-flowed-encode) (setq flowed (nu= ll (assq ... cont)))))) (if (or charset (not (string=3D type "text/calendar= "))) (setq charset (mm-encode-body charset)) (let ((mm-coding-system-priori= ties (cons 'utf-8 mm-coding-system-priorities))) (setq charset (mm-encode-b= ody)))) (setq encoding (mm-body-encoding charset (cdr (assq 'encoding cont)= ))))) (progn (cond ((cdr (assq 'buffer cont)) (insert-buffer-substring (cdr (as= sq '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-re= striction (narrow-to-region (point) (point)) (insert (cdr (assq 'contents c= ont))) (goto-char (point-min)) (while (re-search-forward "<#!+/?\\(part\\|m= ultipart\\|external\\|mml\\|secure\\)" nil t) (delete-region (+ (match-begi= nning 0) 2) (+ (match-beginning 0) 3)))))) (cond ((eq (car cont) 'mml) (let= ((mml-boundary (mml-compute-boundary cont)) (mml-generate-default-type "te= xt/plain")) (mml-to-mime) (if mml-inhibit-compute-boundary nil (setcdr (ass= oc 'contents cont) (buffer-string)))) (let ((mm-7bit-chars (concat mm-7bit-= chars "\33"))) (setq encoding (mm-body-7-or-8)))) ((string=3D (car (split-s= tring type "/")) "message") (let ((mm-7bit-chars (concat mm-7bit-chars "\33= "))) (setq encoding (mm-body-7-or-8)))) (t (let (use-hard-newlines) (if (an= d mml-enable-flowed (string=3D type "text/plain") (not (string=3D ... "pgp"= )) (or (null ...) (string=3D ... "flowed")) (setq use-hard-newlines (text-p= roperty-any ... ... ... ...))) (progn (fill-flowed-encode) (setq flowed (nu= ll ...))))) (if (or charset (not (string=3D type "text/calendar"))) (setq c= harset (mm-encode-body charset)) (let ((mm-coding-system-priorities (cons .= .. mm-coding-system-priorities))) (setq charset (mm-encode-body)))) (setq e= ncoding (mm-body-encoding charset (cdr (assq 'encoding cont)))))) (setq cod= ed (buffer-string))) (unwind-protect (progn (cond ((cdr (assq 'buffer cont)) (insert-buffer-su= bstring (cdr (assq 'buffer cont)))) ((and filename (not (equal (cdr ...) "y= es"))) (let ((coding-system-for-read coding)) (mm-insert-file-contents file= name))) ((eq 'mml (car cont)) (insert (cdr (assq 'contents cont)))) (t (sav= e-restriction (narrow-to-region (point) (point)) (insert (cdr (assq ... con= t))) (goto-char (point-min)) (while (re-search-forward "<#!+/?\\(part\\|mul= tipart\\|external\\|mml\\|secure\\)" nil t) (delete-region (+ ... 2) (+ ...= 3)))))) (cond ((eq (car cont) 'mml) (let ((mml-boundary (mml-compute-bound= ary cont)) (mml-generate-default-type "text/plain")) (mml-to-mime) (if mml-= inhibit-compute-boundary nil (setcdr (assoc ... cont) (buffer-string)))) (l= et ((mm-7bit-chars (concat mm-7bit-chars "\33"))) (setq encoding (mm-body-7= -or-8)))) ((string=3D (car (split-string type "/")) "message") (let ((mm-7b= it-chars (concat mm-7bit-chars "\33"))) (setq encoding (mm-body-7-or-8)))) = (t (let (use-hard-newlines) (if (and mml-enable-flowed (string=3D type "tex= t/plain") (not ...) (or ... ...) (setq use-hard-newlines ...)) (progn (fill= -flowed-encode) (setq flowed ...)))) (if (or charset (not (string=3D type "= text/calendar"))) (setq charset (mm-encode-body charset)) (let ((mm-coding-= system-priorities ...)) (setq charset (mm-encode-body)))) (setq encoding (m= m-body-encoding charset (cdr (assq ... cont)))))) (setq coded (buffer-strin= g))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (con= d ((cdr (assq 'buffer cont)) (insert-buffer-substring (cdr (assq ... cont))= )) ((and filename (not (equal ... "yes"))) (let ((coding-system-for-read co= ding)) (mm-insert-file-contents filename))) ((eq 'mml (car cont)) (insert (= cdr (assq ... cont)))) (t (save-restriction (narrow-to-region (point) (poin= t)) (insert (cdr ...)) (goto-char (point-min)) (while (re-search-forward "<= #!+/?\\(part\\|multipart\\|external\\|mml\\|secure\\)" nil t) (delete-regio= n ... ...))))) (cond ((eq (car cont) 'mml) (let ((mml-boundary ...) (mml-ge= nerate-default-type "text/plain")) (mml-to-mime) (if mml-inhibit-compute-bo= undary nil (setcdr ... ...))) (let ((mm-7bit-chars ...)) (setq encoding (mm= -body-7-or-8)))) ((string=3D (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-ch= ar ...) (while ... ...)))) (cond ((eq (car cont) 'mml) (let (... ...) (mml-= to-mime) (if mml-inhibit-compute-boundary nil ...)) (let (...) (setq encodi= ng ...))) ((string=3D (car ...) "message") (let (...) (setq encoding ...)))= (t (let (use-hard-newlines) (if ... ...)) (if (or charset ...) (setq chars= et ...) (let ... ...)) (setq encoding (mm-body-encoding charset ...)))) (se= tq 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 ...) (i= nsert-buffer-substring ...)) ((and filename ...) (let ... ...)) ((eq ... ..= .) (insert ...)) (t (save-restriction ... ... ... ...))) (cond ((eq ... ...= ) (let ... ... ...) (let ... ...)) ((string=3D ... "message") (let ... ...)= ) (t (let ... ...) (if ... ... ...) (setq encoding ...))) (setq coded (buff= er-string))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) (= mml-insert-mime-headers cont type charset encoding flowed) (insert "\n") (i= nsert coded)) (if (and (not raw) (member (car (split-string type "/")) '("text" "messag= e"))) (progn (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-cur= rent-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 flowe= d) (insert "\n") (insert coded)) (let ((temp-buffer (generate-new-buffer " = *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (p= rogn (set-buffer-multibyte nil) (cond ((cdr ...) (insert ...)) ((and filena= me ...) (let ... ...) (if charset nil ...)) (t (let ... ...))) (if (setq en= coding (cdr ...)) (setq encoding (intern ...))) (setq encoding (mm-encode-b= uffer 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-encod= ing filename) "application/octet-stream") "text/plain"))) (charset (cdr (as= sq 'charset cont))) (coding (mm-charset-to-coding-system charset)) encoding= flowed coded) (cond ((eq coding 'ascii) (setq charset nil coding nil)) (ch= arset (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 (buf= fer-name temp-buffer) (kill-buffer temp-buffer))))) (mml-insert-mime-header= s cont type charset encoding flowed) (insert "\n") (insert coded)) (let ((t= emp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buff= er 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 (as= sq ... cont)) (if filename (or ... "application/octet-stream") "text/plain"= ))) (charset (cdr (assq 'charset cont))) (coding (mm-charset-to-coding-syst= em charset)) encoding flowed coded) (cond ((eq coding 'ascii) (setq charset= nil coding nil)) (charset (setq charset (or (mm-coding-system-to-mime-char= set coding) (intern ...))))) (if (and (not raw) (member (car (split-string = type "/")) '("text" "message"))) (progn (let ((temp-buffer ...)) (save-curr= ent-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-buffe= r (set-buffer temp-buffer) (unwind-protect (progn ... ... ... ... ...) (and= ... ...)))) (mml-insert-mime-headers cont type charset encoding nil) (inse= rt "\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 na= me) (mml-insert-parameter (mail-header-encode-parameter "name" name) "acces= s-type=3Dlocal-file") (mml-insert-parameter (mail-header-encode-parameter "= name" ...) (mail-header-encode-parameter "site" ...) (mail-header-encode-pa= rameter "directory" ...)) (mml-insert-parameter (concat "access-type=3D" ..= .))))) (if url (progn (mml-insert-parameter (mail-header-encode-parameter "= url" url) "access-type=3Durl"))) (if parameters (progn (mml-insert-paramete= r-string cont '(expiration size permission)))) (insert "\n\n") (insert "Con= tent-Type: " (or (cdr (assq 'type cont)) (if name (or (mm-default-file-enco= ding name) "application/octet-stream") "text/plain")) "\n") (insert "Conten= t-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) (l= et* ((type (or (cdr (assq ... cont)) "mixed")) (mml-generate-default-type (= if (equal type "digest") "message/rfc822" "text/plain")) (handler (assoc ty= pe mml-generate-multipart-alist))) (if handler (funcall (cdr handler) cont)= (let ((mml-boundary (mml-compute-boundary cont))) (insert (format "Content= -Type: multipart/%s; boundary=3D\"%s\"" type mml-boundary) (if (cdr ...) (f= ormat "; start=3D\"%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 f= ilename ... "text/plain"))) (charset (cdr (assq ... cont))) (coding (mm-cha= rset-to-coding-system charset)) encoding flowed coded) (cond ((eq coding 'a= scii) (setq charset nil coding nil)) (charset (setq charset (or ... ...))))= (if (and (not raw) (member (car ...) '...)) (progn (let (...) (save-curren= t-buffer ... ...)) (mml-insert-mime-headers cont type charset encoding flow= ed) (insert "\n") (insert coded)) (let ((temp-buffer ...)) (save-current-bu= ffer (set-buffer temp-buffer) (unwind-protect ... ...))) (mml-insert-mime-h= eaders cont type charset encoding nil) (insert "\n" coded)))) ((eq (car con= t) 'external) (insert "Content-Type: message/external-body") (let ((paramet= ers (mml-parameter-string cont '...)) (name (cdr (assq ... cont))) (url (cd= r (assq ... cont)))) (if name (progn (setq name (mml-parse-file-name name))= (if (stringp name) (mml-insert-parameter ... "access-type=3Dlocal-file") (= mml-insert-parameter ... ... ...) (mml-insert-parameter ...)))) (if url (pr= ogn (mml-insert-parameter (mail-header-encode-parameter "url" url) "access-= type=3Durl"))) (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 "Cont= ent-ID: " (message-make-message-id) "\n") (insert "Content-Transfer-Encodin= g: " (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-multip= art-alist))) (if handler (funcall (cdr handler) cont) (let ((mml-boundary .= ..)) (insert (format "Content-Type: multipart/%s; boundary=3D\"%s\"" type m= ml-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 'mess= age-sender sender))) (if (setq recipients (cdr (assq ... cont))) (message-o= ptions-set 'message-recipients recipients)) (let ((style (mml-signencrypt-s= tyle ...))) (if (and sign-item encrypt-item (equal ... ...) (equal style ..= .)) (funcall (nth 1 encrypt-item) cont t) (if sign-item (progn ...)) (if en= crypt-item (progn ...)))))))) (let ((mm-use-ultra-safe-encoding (or mm-use-ultra-safe-encoding (assq 's= ign cont)))) (save-restriction (narrow-to-region (point) (point)) (mml-twea= k-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) (co= nd ((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 code= d)) (let (...) (save-current-buffer ... ...)) (mml-insert-mime-headers cont= type charset encoding nil) (insert "\n" coded)))) ((eq (car cont) 'externa= l) (insert "Content-Type: message/external-body") (let ((parameters (mml-pa= rameter-string cont ...)) (name (cdr ...)) (url (cdr ...))) (if name (progn= (setq name ...) (if ... ... ... ...))) (if url (progn (mml-insert-paramete= r ... "access-type=3Durl"))) (if parameters (progn (mml-insert-parameter-st= ring 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) 'mul= tipart) (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-sig= n-alist)) (encrypt-item (assoc (cdr (assq ... cont)) mml-encrypt-alist)) se= nder recipients) (if (or sign-item encrypt-item) (progn (if (setq sender (c= dr ...)) (progn (message-options-set ... sender) (message-options-set ... s= ender))) (if (setq recipients (cdr ...)) (message-options-set 'message-reci= pients 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 . "--=3D=3D=3D=3D-=3D-=3D\nContent-Dispos= ition: 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-boundar= y-function (setq mml-multipart-number (1+ mml-multipart-number)))) (throw '= not-unique nil)))) (unwind-protect (progn (mm-enable-multibyte) (let ((mml-inhibit-compute-b= oundary t) (mml-multipart-number 0) mml-sign-alist mml-encrypt-alist) (mml-= generate-mime-1 cont)) (goto-char (point-min)) (if (re-search-forward (conc= at "^--" (regexp-quote mml-boundary)) nil t) (progn (setq mml-boundary (fun= call mml-boundary-function (setq mml-multipart-number (1+ mml-multipart-num= ber)))) (throw 'not-unique nil)))) (and (buffer-name temp-buffer) (kill-buf= fer temp-buffer))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (mm-= enable-multibyte) (let ((mml-inhibit-compute-boundary t) (mml-multipart-num= ber 0) mml-sign-alist mml-encrypt-alist) (mml-generate-mime-1 cont)) (goto-= char (point-min)) (if (re-search-forward (concat "^--" (regexp-quote mml-bo= undary)) nil t) (progn (setq mml-boundary (funcall mml-boundary-function (s= etq mml-multipart-number ...))) (throw 'not-unique nil)))) (and (buffer-nam= e 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-b= uffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-pr= otect (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-b= uffer temp-buffer)))))) ((eq (car cont) 'multipart) (mapc 'mml-compute-boun= dary-1 (cdr (cdr cont))))) mml-compute-boundary-1((mml (type . "message/rfc822") (disposition . "inl= ine") (tag-location . 108) (contents . "--=3D=3D=3D=3D-=3D-=3D\nContent-Dis= position: inline\nMIME-Versio..."))) mapc(mml-compute-boundary-1 ((tag-location . 76) (part (type . "text/plai= n") (contents . "Test\n\n")) (mml (type . "message/rfc822") (disposition . = "inline") (tag-location . 108) (contents . "--=3D=3D=3D=3D-=3D-=3D\nContent= -Disposition: inline\nMIME-Versio...")))) (cond ((member (car cont) '(part mml)) (let ((temp-buffer (generate-new-b= uffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-pr= otect (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-b= uffer temp-buffer)))))) ((eq (car cont) 'multipart) (mapc 'mml-compute-boun= dary-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 . "--=3D= =3D=3D=3D-=3D-=3D\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-nu= mber (1+ mml-multipart-number))))) (if mml-inhibit-compute-boundary nil (wh= ile (not (catch 'not-unique (mml-compute-boundary-1 cont))))) mml-boundary) mml-compute-boundary((multipart (sign . "pgpmime") (tag-location . 76) (p= art (type . "text/plain") (contents . "Test\n\n")) (mml (type . "message/rf= c822") (disposition . "inline") (tag-location . 108) (contents . "--=3D=3D= =3D=3D-=3D-=3D\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 . "--=3D=3D=3D= =3D-=3D-=3D\nContent-Disposition: inline\nMIME-Versio...")))) mml2015-sign((multipart (sign . "pgpmime") (tag-location . 76) (part (typ= e . "text/plain") (contents . "Test\n\n")) (mml (type . "message/rfc822") (= disposition . "inline") (tag-location . 108) (contents . "--=3D=3D=3D=3D-= =3D-=3D\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 . "--=3D= =3D=3D=3D-=3D-=3D\nContent-Disposition: inline\nMIME-Versio...")))) funcall(mml-pgpmime-sign-buffer (multipart (sign . "pgpmime") (tag-locati= on . 76) (part (type . "text/plain") (contents . "Test\n\n")) (mml (type . = "message/rfc822") (disposition . "inline") (tag-location . 108) (contents .= "--=3D=3D=3D=3D-=3D-=3D\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-i= tem (progn (funcall (nth 1 sign-item) cont))) (if encrypt-item (progn (func= all (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-ite= m (progn (funcall (nth 1 sign-item) cont))) (if encrypt-item (progn (funcal= l (nth 1 encrypt-item) cont))))) (progn (if (setq sender (cdr (assq 'sender cont))) (progn (message-option= s-set 'mml-sender sender) (message-options-set 'message-sender sender))) (i= f (setq recipients (cdr (assq 'recipients cont))) (message-options-set 'mes= sage-recipients recipients)) (let ((style (mml-signencrypt-style (car (or s= ign-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 'sende= r cont))) (progn (message-options-set 'mml-sender sender) (message-options-= set 'message-sender sender))) (if (setq recipients (cdr (assq 'recipients c= ont))) (message-options-set 'message-recipients recipients)) (let ((style (= mml-signencrypt-style (car (or sign-item encrypt-item))))) (if (and sign-it= em encrypt-item (equal (car sign-item) (car encrypt-item)) (equal style 'co= mbined)) (funcall (nth 1 encrypt-item) cont t) (if sign-item (progn (funcal= l (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 recipien= ts) (if (or sign-item encrypt-item) (progn (if (setq sender (cdr (assq 'sen= der cont))) (progn (message-options-set 'mml-sender sender) (message-option= s-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 encr= ypt-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 f= ilename ... "text/plain"))) (charset (cdr (assq ... cont))) (coding (mm-cha= rset-to-coding-system charset)) encoding flowed coded) (cond ((eq coding 'a= scii) (setq charset nil coding nil)) (charset (setq charset (or ... ...))))= (if (and (not raw) (member (car ...) '...)) (progn (let (...) (save-curren= t-buffer ... ...)) (mml-insert-mime-headers cont type charset encoding flow= ed) (insert "\n") (insert coded)) (let ((temp-buffer ...)) (save-current-bu= ffer (set-buffer temp-buffer) (unwind-protect ... ...))) (mml-insert-mime-h= eaders cont type charset encoding nil) (insert "\n" coded)))) ((eq (car con= t) 'external) (insert "Content-Type: message/external-body") (let ((paramet= ers (mml-parameter-string cont '...)) (name (cdr (assq ... cont))) (url (cd= r (assq ... cont)))) (if name (progn (setq name (mml-parse-file-name name))= (if (stringp name) (mml-insert-parameter ... "access-type=3Dlocal-file") (= mml-insert-parameter ... ... ...) (mml-insert-parameter ...)))) (if url (pr= ogn (mml-insert-parameter (mail-header-encode-parameter "url" url) "access-= type=3Durl"))) (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 "Cont= ent-ID: " (message-make-message-id) "\n") (insert "Content-Transfer-Encodin= g: " (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-multip= art-alist))) (if handler (funcall (cdr handler) cont) (let ((mml-boundary .= ..)) (insert (format "Content-Type: multipart/%s; boundary=3D\"%s\"" type m= ml-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 'mess= age-sender sender))) (if (setq recipients (cdr (assq ... cont))) (message-o= ptions-set 'message-recipients recipients)) (let ((style (mml-signencrypt-s= tyle ...))) (if (and sign-item encrypt-item (equal ... ...) (equal style ..= .)) (funcall (nth 1 encrypt-item) cont t) (if sign-item (progn ...)) (if en= crypt-item (progn ...)))))))) (let ((mm-use-ultra-safe-encoding (or mm-use-ultra-safe-encoding (assq 's= ign cont)))) (save-restriction (narrow-to-region (point) (point)) (mml-twea= k-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) (co= nd ((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 code= d)) (let (...) (save-current-buffer ... ...)) (mml-insert-mime-headers cont= type charset encoding nil) (insert "\n" coded)))) ((eq (car cont) 'externa= l) (insert "Content-Type: message/external-body") (let ((parameters (mml-pa= rameter-string cont ...)) (name (cdr ...)) (url (cdr ...))) (if name (progn= (setq name ...) (if ... ... ... ...))) (if url (progn (mml-insert-paramete= r ... "access-type=3Durl"))) (if parameters (progn (mml-insert-parameter-st= ring 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) 'mul= tipart) (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-sig= n-alist)) (encrypt-item (assoc (cdr (assq ... cont)) mml-encrypt-alist)) se= nder recipients) (if (or sign-item encrypt-item) (progn (if (setq sender (c= dr ...)) (progn (message-options-set ... sender) (message-options-set ... s= ender))) (if (setq recipients (cdr ...)) (message-options-set 'message-reci= pients 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) (pa= rt (type . "text/plain") (contents . "Test\n\n")) (mml (type . "message/rfc= 822") (disposition . "inline") (tag-location . 108) (contents . "--=3D=3D= =3D=3D-=3D-=3D\nContent-Disposition: inline\nMIME-Versio...")))) (cond ((and (consp (car cont)) (=3D (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)) (=3D (length cont) 1)) (mml-generate-mime-1 (car con= t))) ((eq (car cont) 'multipart) (mml-generate-mime-1 cont)) (t (mml-genera= te-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 o= ptions) (cond ((and (consp (car cont)) (=3D (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-buff= er) (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 (c= ar cont)) (=3D (length cont) 1)) (mml-generate-mime-1 (car cont))) ((eq (ca= r cont) 'multipart) (mml-generate-mime-1 cont)) (t (mml-generate-mime-1 (nc= onc (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 ...) (=3D ... 1)) (mml-g= enerate-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-multiby= te nil) (setq message-options options) (cond ((and ... ...) (mml-generate-m= ime-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)) (=3D (length cont) 1) cont= ent-type) (progn (setcdr (assq 'type (cdr (car cont))) content-type))) (if = (and (consp (car cont)) (=3D (length cont) 1) (fboundp 'libxml-parse-html-r= egion) (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 t= emp-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) (opt= ions message-options)) (if (not cont) nil (if (and (consp (car cont)) (=3D = (length cont) 1) content-type) (progn (setcdr (assq 'type (cdr (car cont)))= content-type))) (if (and (consp (car cont)) (=3D (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-multiby= te nil) (setq message-options options) (cond ... ... ...) (setq options mes= sage-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) (er= ror 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 (p= oint-min)) (mml-to-mime) nil) (error t)))) eval-buffer(# 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-par= sing..." "/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) --==-=-= Content-Type: text/plain 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: --==-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-Don-t-let-a-code-literal-get-modified-in-mml-parsing.patch Content-Description: patch >From 16c77ed31d836c374b37cbdf03947567fc7b8581 Mon Sep 17 00:00:00 2001 From: Noam Postavsky 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 --==-=-=--