From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Katsumi Yamaoka Newsgroups: gmane.emacs.bugs Subject: bug#27141: 26.0.50; mml-generate-mime-1 broken Date: Tue, 30 May 2017 15:09:28 +0900 Organization: Emacsen advocacy group Message-ID: NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1496124678 5068 195.159.176.226 (30 May 2017 06:11:18 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Tue, 30 May 2017 06:11:18 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.0.50 (i686-pc-cygwin) Cc: larsi@gnus.org To: 27141@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Tue May 30 08:11:11 2017 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dFaN4-0000xg-6b for geb-bug-gnu-emacs@m.gmane.org; Tue, 30 May 2017 08:11:10 +0200 Original-Received: from localhost ([::1]:51660 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dFaN6-0006Hl-7l for geb-bug-gnu-emacs@m.gmane.org; Tue, 30 May 2017 02:11:12 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:51772) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dFaN0-0006HB-FZ for bug-gnu-emacs@gnu.org; Tue, 30 May 2017 02:11:07 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dFaMx-00066Q-8J for bug-gnu-emacs@gnu.org; Tue, 30 May 2017 02:11:06 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:41388) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dFaMx-00066K-3H for bug-gnu-emacs@gnu.org; Tue, 30 May 2017 02:11:03 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1dFaMv-00079u-S3 for bug-gnu-emacs@gnu.org; Tue, 30 May 2017 02:11:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Katsumi Yamaoka Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 30 May 2017 06:11:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 27141 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.149612463027478 (code B ref -1); Tue, 30 May 2017 06:11:01 +0000 Original-Received: (at submit) by debbugs.gnu.org; 30 May 2017 06:10:30 +0000 Original-Received: from localhost ([127.0.0.1]:44065 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dFaMQ-000798-5V for submit@debbugs.gnu.org; Tue, 30 May 2017 02:10:30 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:60711) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dFaMP-00078w-6w for submit@debbugs.gnu.org; Tue, 30 May 2017 02:10:29 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dFaMJ-0005yH-9W for submit@debbugs.gnu.org; Tue, 30 May 2017 02:10:24 -0400 Original-Received: from lists.gnu.org ([2001:4830:134:3::11]:39551) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1dFaMJ-0005yD-56 for submit@debbugs.gnu.org; Tue, 30 May 2017 02:10:23 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:51682) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dFaMI-0006Gu-34 for bug-gnu-emacs@gnu.org; Tue, 30 May 2017 02:10:22 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dFaMB-0005xU-OK for bug-gnu-emacs@gnu.org; Tue, 30 May 2017 02:10:22 -0400 Original-Received: from mail-hampton.hostforweb.net ([205.234.186.191]:37186 helo=hampton.hostforweb.net) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1dFaMB-0005bs-IA for bug-gnu-emacs@gnu.org; Tue, 30 May 2017 02:10:15 -0400 Original-Received: from s70.gtokyofl21.vectant.ne.jp ([202.215.75.70]:60000 helo=localhost) by hampton.hostforweb.net with esmtpsa (TLSv1.2:ECDHE-RSA-AES128-GCM-SHA256:128) (Exim 4.89) (envelope-from ) id 1dFaLS-001oAQ-7O; Tue, 30 May 2017 01:09:31 -0500 X-Face: #kKnN,xUnmKia.'[pp`; Omh}odZK)?7wQSl"4o04=EixTF+V[""w~iNbM9ZL+.b*_CxUmFk B#Fu[*?MZZH@IkN:!"\w%I_zt>[$nm7nQosZ<3eu; B:$Q_:p!',P.c0-_Cy[dz4oIpw0ESA^D*1Lw= L&i*6&( Cancel-Lock: sha1:hudDZQbGZP5Axpd67xsf4E682o8= X-OutGoing-Spam-Status: No, score=-2.9 X-AntiAbuse: This header was added to track abuse, please include it with any abuse report X-AntiAbuse: Primary Hostname - hampton.hostforweb.net X-AntiAbuse: Original Domain - gnu.org X-AntiAbuse: Originator/Caller UID/GID - [47 12] / [47 12] X-AntiAbuse: Sender Address Domain - jpl.org X-Get-Message-Sender-Via: hampton.hostforweb.net: authenticated_id: yamaoka/from_h X-Authenticated-Sender: hampton.hostforweb.net: yamaoka@jpl.org X-Source: X-Source-Args: X-Source-Dir: X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x (barebone) [generic] [fuzzy] X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x 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: 208.118.235.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.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:133038 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hi, I noticed this when I forwarded a mail using Gnus. The problem is that non-ASCII letters contained in the header of the original mail will not be encoded properly. The rough outline of what `mml-generate-mime-1' does then are: =E3=83=BBInsert the original mail (decoded) into a unibyte buffer (that with-temp-buffer of mml.el-[line:619] generates). =E3=83=BBDetect the charset of the contents. =E3=83=BBEncode the contents by that detected charset. =E3=83=BBInsert the encoded contsnts into the other unibyte buffer (that with-temp-buffer of mml.el-[line:612] generates). =E3=83=BBRun `mml-to-mime' that encodes the header of the original mail using `mail-encode-encoded-word-buffer' (an alias to `rfc2047-encode-message-header'). rfc2047's encoder expects human readable text, however, there are encoded ones as described above. So, as for at least mail forwarding, `mml-generate-mime-1' is seriously broken. The current code looks like WIP to me. How about reverting it to the emacs-25 version? Slightly modernized[1] one is attached. [1] Don't use old compat functions and string-as-(multi|uni)byte. In GNU Emacs 26.0.50 (build 1, i686-pc-cygwin, GTK+ Version 3.18.9) of 2017-05-30 built on localhost Windowing system distributor 'The Cygwin/X Project', version 11.0.11900000 --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment Content-Transfer-Encoding: quoted-printable (defun mml-generate-mime-1 (cont) (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 (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 ;; The value of `charset' might be a bogus alias that ;; `mm-charset-synonym-alist' provides, like `utf8', ;; so we prefer the MIME charset that Emacs knows for ;; the coding system `coding'. (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 (with-temp-buffer (cond ((cdr (assq 'buffer cont)) (insert-buffer-substring (cdr (assq 'buffer cont)))) ((and filename (not (equal (cdr (assq 'nofile 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))) ;; Remove quotes from quoted tags. (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)) ;; It is necessary for the case where this ;; function is called recursively since ;; `m-g-d-t' will be bound to "message/rfc822" ;; when encoding an article to be forwarded. (mml-generate-default-type "text/plain")) (mml-to-mime) ;; Update handle so mml-compute-boundary can ;; detect collisions with the nested parts. (unless mml-inhibit-compute-boundary (setcdr (assoc 'contents cont) (buffer-string)))) (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b"))) ;; ignore 0x1b, it is part of iso-2022-jp (setq encoding (mm-body-7-or-8)))) ((string=3D (car (split-string type "/")) "message") (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b"))) ;; ignore 0x1b, it is part of iso-2022-jp (setq encoding (mm-body-7-or-8)))) (t ;; Only perform format=3Dflowed filling on text/plain ;; parts where there either isn't a format parameter ;; in the mml tag or it says "flowed" and there ;; actually are hard newlines in the text. (let (use-hard-newlines) (when (and mml-enable-flowed (string=3D type "text/plain") (not (string=3D (cdr (assq 'sign cont)) "pgp")) (or (null (assq 'format cont)) (string=3D (cdr (assq 'format cont)) "flowed")) (setq use-hard-newlines (text-property-any (point-min) (point-max) 'hard 't))) (fill-flowed-encode) ;; Indicate that `mml-insert-mime-headers' should ;; insert a "; format=3Dflowed" string unless the ;; user has already specified it. (setq flowed (null (assq 'format cont))))) ;; Prefer `utf-8' for text/calendar parts. (if (or charset (not (string=3D 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)))))) (setq coded (buffer-string))) (mml-insert-mime-headers cont type charset encoding flowed) (insert "\n") (insert coded)) (with-temp-buffer (set-buffer-multibyte nil) (cond ((cdr (assq 'buffer cont)) ;; multibyte string that inserted to a unibyte buffer ;; will be converted to the unibyte version safely. (insert (with-current-buffer (cdr (assq 'buffer cont)) (buffer-string)))) ((and filename (not (equal (cdr (assq 'nofile cont)) "yes"))) (let ((coding-system-for-read mm-binary-coding-system)) (mm-insert-file-contents filename nil nil nil nil t)) (unless charset (setq charset (mm-coding-system-to-mime-charset (mm-find-buffer-file-coding-system filename))))) (t (let ((contents (cdr (assq 'contents cont)))) (if (if (featurep 'xemacs) (string-match "[^\000-\377]" contents) (multibyte-string-p contents)) (progn (set-buffer-multibyte t) (insert contents) (unless raw (setq charset (mm-encode-body charset)))) (insert contents))))) (if (setq encoding (cdr (assq 'encoding cont))) (setq encoding (intern (downcase encoding)))) (setq encoding (mm-encode-buffer type encoding)) (setq coded (decode-coding-string (buffer-string) 'us-ascii))) (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)))) (when name (setq name (mml-parse-file-name name)) (if (stringp name) (mml-insert-parameter (mail-header-encode-parameter "name" name) "access-type=3Dlocal-file") (mml-insert-parameter (mail-header-encode-parameter "name" (file-name-nondirectory (nth 2 name))) (mail-header-encode-parameter "site" (nth 1 name)) (mail-header-encode-parameter "directory" (file-name-directory (nth 2 name)))) (mml-insert-parameter (concat "access-type=3D" (if (member (nth 0 name) '("ftp@" "anonymous@")) "anon-ftp" "ftp"))))) (when url (mml-insert-parameter (mail-header-encode-parameter "url" url) "access-type=3Durl")) (when parameters (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 'type 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) ;; No specific handler. Use default one. (let ((mml-boundary (mml-compute-boundary cont))) (insert (format "Content-Type: multipart/%s; boundary=3D\"%s\"" type mml-boundary) (if (cdr (assq 'start cont)) (format "; start=3D\"%s\"\n" (cdr (assq 'start cont))) "\n")) (let ((cont cont) part) (while (setq part (pop cont)) ;; Skip `multipart' and attributes. (when (and (consp part) (consp (cdr part))) (insert "\n--" mml-boundary "\n") (mml-generate-mime-1 part) (goto-char (point-max))))) (insert "\n--" mml-boundary "--\n"))))) (t (error "Invalid element: %S" cont))) ;; handle sign & encrypt tags in a semi-smart way. (let ((sign-item (assoc (cdr (assq 'sign cont)) mml-sign-alist)) (encrypt-item (assoc (cdr (assq 'encrypt cont)) mml-encrypt-alist)) sender recipients) (when (or sign-item encrypt-item) (when (setq sender (cdr (assq 'sender cont))) (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 (first (or sign-item encrypt-item))))) ;; check if: we're both signing & encrypting, both methods ;; are the same (why would they be different?!), and that ;; the signencrypt style allows for combined operation. (if (and sign-item encrypt-item (equal (first sign-item) (first encrypt-item)) (equal style 'combined)) (funcall (nth 1 encrypt-item) cont t) ;; otherwise, revert to the old behavior. (when sign-item (funcall (nth 1 sign-item) cont)) (when encrypt-item (funcall (nth 1 encrypt-item) cont))))))))) --=-=-=--