procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Remove garbage from Content-Transfer-Encoding value (bug#25420)

Browse source 
* 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.
This commit is contained in:
Katsumi Yamaoka 2017-01-12 23:32:41 +00:00
parent 70d6f2d14f
commit 55b5265847
7 changed files with 26 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
lisp/gnus/gnus-art.el
View file

@ -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 ()

2
lisp/gnus/gnus-sum.el
View file

@ -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

6
lisp/gnus/mm-decode.el
View file

@ -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)

4
lisp/gnus/nndoc.el
View file

@ -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)

15
lisp/mail/ietf-drums.el
View file

@ -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

1
lisp/mail/mail-parse.el
View file

@ -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)

7
lisp/mh-e/mh-mime.el
View file

@ -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)