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.

diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 920ef1e2494cea97baee71aebb4a19b0d4c4a0dc..e1af859516c00c46f6005074b94a9a47de2b67e0 100644 (file)
--- 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 c28557af765381e5f83edd527c32c2dd45acf2b0..72e902a11f8493fb3f43d7f61c92c54d74436bd7 100644 (file)
--- 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 c3fdc75a4ccaf05f039b2e6d22b27267b712e7aa..579222f0f6538cfd388b6d49a962f1ae0d75b69c 100644 (file)
--- 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 f32a3e70c99b300e5c36c641ad13a9c5a57e8310..ede118d6eb660d0663d98a9948464f541b785a3f 100644 (file)
--- 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 8c84158a51aaf5c193858b9a87f026660633c6d5..a3e53cfe7930f23cf8d31be2c23911d9a40e0549 100644 (file)
--- 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 546673db6fda6184a6f3da1b5933edea98581f3d..0578b98c9339e51419f13c49e9e6670f00014627 100644 (file)
--- 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 01fa5a18c446c80f5c7d61ad7a5e1ac3fe4afda8..7238de08b9bf49ffa71b318667c80209496110a3 100644 (file)
--- 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)