From 55b52658470322a701000e88728d096a03b7c8ca Mon Sep 17 00:00:00 2001 From: Katsumi Yamaoka Date: Thu, 12 Jan 2017 23:32:41 +0000 Subject: [PATCH] Remove garbage from Content-Transfer-Encoding value (bug#25420) * lisp/mail/ietf-drums.el (ietf-drums-strip-cte): New function. (ietf-drums-remove-garbage): New function. (ietf-drums-remove-whitespace): Remove CR as well. * lisp/mail/mail-parse.el (mail-header-strip-cte): Alias to ietf-drums-strip-cte. * lisp/gnus/gnus-art.el (article-decode-charset): * lisp/gnus/gnus-sum.el (gnus-summary-enter-digest-group): * lisp/gnus/mm-decode.el (mm-dissect-buffer): * lisp/gnus/nndoc.el (nndoc-decode-content-transfer-encoding) (nndoc-rfc822-forward-generate-article): * lisp/mh-e/mh-mime.el (mh-decode-message-body): Replace mail-header-strip with mail-header-strip-cte. --- lisp/gnus/gnus-art.el | 5 ++--- lisp/gnus/gnus-sum.el | 2 +- lisp/gnus/mm-decode.el | 6 +++--- lisp/gnus/nndoc.el | 4 ++-- lisp/mail/ietf-drums.el | 15 ++++++++++++++- lisp/mail/mail-parse.el | 1 + lisp/mh-e/mh-mime.el | 7 +++---- 7 files changed, 26 insertions(+), 14 deletions(-) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 920ef1e2494..e1af859516c 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -2508,7 +2508,7 @@ If PROMPT (the prefix), prompt for a coding system to use." (mail-content-type-get ctl 'charset))) format (and ctl (mail-content-type-get ctl 'format))) (when cte - (setq cte (mail-header-strip cte))) + (setq cte (mail-header-strip-cte cte))) (if (and ctl (not (string-match "/" (car ctl)))) (setq ctl nil)) (goto-char (point-max))) @@ -2523,8 +2523,7 @@ If PROMPT (the prefix), prompt for a coding system to use." (equal (car ctl) "text/plain")) (not format)) ;; article with format will decode later. (mm-decode-body - charset (and cte (intern (downcase - (gnus-strip-whitespace cte)))) + charset (and cte (intern (downcase cte))) (car ctl))))))) (defun article-decode-encoded-words () diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index c28557af765..72e902a11f8 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -9211,7 +9211,7 @@ To control what happens when you exit the group, see the (widen) (narrow-to-region (point) (point-max)) (mm-decode-content-transfer-encoding - (intern (downcase (mail-header-strip encoding)))))) + (intern (downcase (mail-header-strip-cte encoding)))))) (widen)) (unwind-protect (if (let ((gnus-newsgroup-ephemeral-charset diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index c3fdc75a4cc..579222f0f65 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -655,9 +655,9 @@ MIME-Version header before proceeding." description))))) (if (or (not ctl) (not (string-match "/" (car ctl)))) - (mm-dissect-singlepart + (mm-dissect-singlepart (list mm-dissect-default-type) - (and cte (intern (downcase (mail-header-strip cte)))) + (and cte (intern (downcase (mail-header-strip-cte cte)))) no-strict-mime (and cd (mail-header-parse-content-disposition cd)) description) @@ -690,7 +690,7 @@ MIME-Version header before proceeding." (mm-possibly-verify-or-decrypt (mm-dissect-singlepart ctl - (and cte (intern (downcase (mail-header-strip cte)))) + (and cte (intern (downcase (mail-header-strip-cte cte)))) no-strict-mime (and cd (mail-header-parse-content-disposition cd)) description id) diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el index f32a3e70c99..ede118d6eb6 100644 --- a/lisp/gnus/nndoc.el +++ b/lisp/gnus/nndoc.el @@ -495,7 +495,7 @@ from the document.") (save-restriction (narrow-to-region (point) (point-max)) (mm-decode-content-transfer-encoding - (intern (downcase (mail-header-strip encoding)))))))) + (intern (downcase (mail-header-strip-cte encoding)))))))) (defun nndoc-babyl-type-p () (when (re-search-forward "\^_\^L *\n" nil t) @@ -558,7 +558,7 @@ from the document.") (save-restriction (narrow-to-region begin (point-max)) (mm-decode-content-transfer-encoding - (intern (downcase (mail-header-strip encoding)))))) + (intern (downcase (mail-header-strip-cte encoding)))))) (when head (goto-char begin) (when (search-forward "\n\n" nil t) diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el index 8c84158a51a..a3e53cfe793 100644 --- a/lisp/mail/ietf-drums.el +++ b/lisp/mail/ietf-drums.el @@ -143,7 +143,7 @@ backslash and doublequote.") (forward-sexp 1)) ((eq c ?\() (forward-sexp 1)) - ((memq c '(?\ ?\t ?\n)) + ((memq c '(?\ ?\t ?\n ?\r)) (delete-char 1)) (t (forward-char 1)))) @@ -172,6 +172,19 @@ backslash and doublequote.") "Remove comments and whitespace from STRING." (ietf-drums-remove-whitespace (ietf-drums-remove-comments string))) +(defun ietf-drums-remove-garbage (string) + "Remove some garbage from STRING." + (while (string-match "[][()<>@,;:\\\"/?=]+" string) + (setq string (concat (substring string 0 (match-beginning 0)) + (substring string (match-end 0))))) + string) + +(defun ietf-drums-strip-cte (string) + "Remove comments, whitespace and garbage from STRING. +STRING is assumed to be a string that is extracted from +the Content-Transfer-Encoding header of a mail." + (ietf-drums-remove-garbage (inline (ietf-drums-strip string)))) + (defun ietf-drums-parse-address (string) "Parse STRING and return a MAILBOX / DISPLAY-NAME pair." (with-temp-buffer diff --git a/lisp/mail/mail-parse.el b/lisp/mail/mail-parse.el index 546673db6fd..0578b98c933 100644 --- a/lisp/mail/mail-parse.el +++ b/lisp/mail/mail-parse.el @@ -49,6 +49,7 @@ (defalias 'mail-header-remove-comments 'ietf-drums-remove-comments) (defalias 'mail-header-remove-whitespace 'ietf-drums-remove-whitespace) (defalias 'mail-header-strip 'ietf-drums-strip) +(defalias 'mail-header-strip-cte 'ietf-drums-strip-cte) (defalias 'mail-header-get-comment 'ietf-drums-get-comment) (defalias 'mail-header-parse-address 'ietf-drums-parse-address) (defalias 'mail-header-parse-addresses 'ietf-drums-parse-addresses) diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index 01fa5a18c44..7238de08b9b 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -56,7 +56,7 @@ (autoload 'mail-content-type-get "mail-parse") (autoload 'mail-decode-encoded-word-string "mail-parse") (autoload 'mail-header-parse-content-type "mail-parse") -(autoload 'mail-header-strip "mail-parse") +(autoload 'mail-header-strip-cte "mail-parse") (autoload 'mail-strip-quoted-names "mail-utils") (autoload 'message-options-get "message") (autoload 'message-options-set "message") @@ -580,14 +580,13 @@ If message has been encoded for transfer take that into account." (message-fetch-field "Content-Type" t))) charset (mail-content-type-get ct 'charset) cte (message-fetch-field "Content-Transfer-Encoding"))) - (when (stringp cte) (setq cte (mail-header-strip cte))) + (when (stringp cte) (setq cte (mail-header-strip-cte cte))) (when (or (not ct) (equal (car ct) "text/plain")) (save-restriction (narrow-to-region (min (1+ (mh-mail-header-end)) (point-max)) (point-max)) (mm-decode-body charset - (and cte (intern (downcase - (gnus-strip-whitespace cte)))) + (and cte (intern (downcase cte))) (car ct)))))) (defun mh-mime-display-part (handle) -- 2.11.4.GIT