X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Frfc2047.el;h=09de21a8e281bcf14c018e91b009dabbe573148d;hb=2d356801ab1a350e4f51424464e78ebf0f88f59e;hp=4cf36f19cb50532e113942c28cf216698dedebb5;hpb=75880493a6a9dad9607a4002d4c6ab2895b110ca;p=gnus diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index 4cf36f19c..09de21a8e 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -1,6 +1,6 @@ ;;; rfc2047.el --- functions for encoding and decoding rfc2047 messages -;; Copyright (C) 1998, 1999, 2000, 2002, 2003, 2004, +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, ;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -142,6 +142,42 @@ This is either `base64' or `quoted-printable'." (re-search-forward ":[ \t\n]*" nil t) (buffer-substring-no-properties (point) (point-max))))) +(defun rfc2047-quote-special-characters-in-quoted-strings (&optional + encodable-regexp) + "Quote special characters with `\\'s in quoted strings. +Quoting will not be done in a quoted string if it contains characters +matching ENCODABLE-REGEXP." + (goto-char (point-min)) + (let ((tspecials (concat "[" ietf-drums-tspecials "]")) + beg end) + (with-syntax-table (standard-syntax-table) + (while (search-forward "\"" nil t) + (setq beg (match-beginning 0)) + (unless (eq (char-before beg) ?\\) + (goto-char beg) + (setq beg (1+ beg)) + (condition-case nil + (progn + (forward-sexp) + (setq end (1- (point))) + (goto-char beg) + (if (and encodable-regexp + (re-search-forward encodable-regexp end t)) + (goto-char (1+ end)) + (save-restriction + (narrow-to-region beg end) + (while (re-search-forward tspecials nil 'move) + (if (eq (char-before) ?\\) + (if (looking-at tspecials) ;; Already quoted. + (forward-char) + (insert "\\")) + (goto-char (match-beginning 0)) + (insert "\\") + (forward-char)))) + (forward-char))) + (error + (goto-char beg)))))))) + (defvar rfc2047-encoding-type 'address-mime "The type of encoding done by `rfc2047-encode-region'. This should be dynamically bound around calls to @@ -158,8 +194,18 @@ Should be called narrowed to the head of the message." (while (not (eobp)) (save-restriction (rfc2047-narrow-to-field) + (setq method nil + alist rfc2047-header-encoding-alist) + (while (setq elem (pop alist)) + (when (or (and (stringp (car elem)) + (looking-at (car elem))) + (eq (car elem) t)) + (setq alist nil + method (cdr elem)))) (if (not (rfc2047-encodable-p)) - (prog1 + (prog2 + (when (eq method 'address-mime) + (rfc2047-quote-special-characters-in-quoted-strings)) (if (and (eq (mm-body-7-or-8) '8bit) (mm-multibyte-p) (mm-coding-system-p @@ -180,14 +226,6 @@ Should be called narrowed to the head of the message." (point)) (point-max)))) ;; We found something that may perhaps be encoded. - (setq method nil - alist rfc2047-header-encoding-alist) - (while (setq elem (pop alist)) - (when (or (and (stringp (car elem)) - (looking-at (car elem))) - (eq (car elem) t)) - (setq alist nil - method (cdr elem)))) (re-search-forward "^[^:]+: *" nil t) (cond ((eq method 'address-mime) @@ -318,6 +356,7 @@ Dynamically bind `rfc2047-encoding-type' to change that." (rfc2047-encode start (point)) (goto-char end)))) ;; `address-mime' case -- take care of quoted words, comments. + (rfc2047-quote-special-characters-in-quoted-strings encodable-regexp) (with-syntax-table rfc2047-syntax-table (goto-char (point-min)) (condition-case err ; in case of unbalanced quotes @@ -792,6 +831,29 @@ encoded-word, concatenate them, and decode it by charset. Otherwise, the decoder will fully decode each encoded-word before concatenating them.") +(defun rfc2047-strip-backslashes-in-quoted-strings () + "Strip backslashes in quoted strings. `\\\"' remains." + (goto-char (point-min)) + (let (beg) + (with-syntax-table (standard-syntax-table) + (while (search-forward "\"" nil t) + (unless (eq (char-before) ?\\) + (setq beg (match-end 0)) + (goto-char (match-beginning 0)) + (condition-case nil + (progn + (forward-sexp) + (save-restriction + (narrow-to-region beg (1- (point))) + (goto-char beg) + (while (search-forward "\\" nil 'move) + (unless (memq (char-after) '(?\")) + (delete-backward-char 1)) + (forward-char))) + (forward-char)) + (error + (goto-char beg)))))))) + (defun rfc2047-charset-to-coding-system (charset) "Return coding-system corresponding to MIME CHARSET. If your Emacs implementation can't decode CHARSET, return nil." @@ -806,7 +868,7 @@ If your Emacs implementation can't decode CHARSET, return nil." (cond ((eq cs 'ascii) (setq cs (or (mm-charset-to-coding-system mail-parse-charset) 'raw-text))) - ((setq cs (mm-coding-system-p cs))) + ((mm-coding-system-p cs)) ((and charset (listp mail-parse-ignored-charsets) (memq 'gnus-unknown mail-parse-ignored-charsets)) @@ -822,11 +884,8 @@ ENCODED-WORD)." (let (word charset cs encoding text rest) (while words (setq word (pop words)) - (if (and (or (setq cs (rfc2047-charset-to-coding-system - (setq charset (car word)))) - (progn - (message "Unknown charset: %s" charset) - nil)) + (if (and (setq cs (rfc2047-charset-to-coding-system + (setq charset (car word)))) (condition-case code (cond ((char-equal ?B (nth 1 word)) (setq text (base64-decode-string @@ -872,8 +931,10 @@ ENCODED-WORD)." ;; and worthwhile (is it more correct or not?), e.g. something like ;; `=?iso-8859-1?q?foo?=@'. -(defun rfc2047-decode-region (start end) - "Decode MIME-encoded words in region between START and END." +(defun rfc2047-decode-region (start end &optional address-mime) + "Decode MIME-encoded words in region between START and END. +If ADDRESS-MIME is non-nil, strip backslashes which precede characters +other than `\"' and `\\' in quoted strings." (interactive "r") (let ((case-fold-search t) (eword-regexp (eval-when-compile @@ -884,6 +945,8 @@ ENCODED-WORD)." (save-excursion (save-restriction (narrow-to-region start end) + (when address-mime + (rfc2047-strip-backslashes-in-quoted-strings)) (goto-char (setq b start)) ;; Look for the encoded-words. (while (setq match (re-search-forward eword-regexp nil t)) @@ -969,8 +1032,16 @@ ENCODED-WORD)." (not (eq mail-parse-charset 'gnus-decoded))) (mm-decode-coding-region b (point-max) mail-parse-charset)))))) -(defun rfc2047-decode-string (string) - "Decode the quoted-printable-encoded STRING and return the results." +(defun rfc2047-decode-address-region (start end) + "Decode MIME-encoded words in region between START and END. +Backslashes which precede characters other than `\"' and `\\' in quoted +strings are stripped." + (rfc2047-decode-region start end t)) + +(defun rfc2047-decode-string (string &optional address-mime) + "Decode MIME-encoded STRING and return the result. +If ADDRESS-MIME is non-nil, strip backslashes which precede characters +other than `\"' and `\\' in quoted strings." (let ((m (mm-multibyte-p))) (if (string-match "=\\?" string) (with-temp-buffer @@ -984,8 +1055,16 @@ ENCODED-WORD)." (mm-enable-multibyte)) (insert string) (inline - (rfc2047-decode-region (point-min) (point-max))) + (rfc2047-decode-region (point-min) (point-max) address-mime)) (buffer-string)) + (when address-mime + (setq string + (with-temp-buffer + (when (mm-multibyte-string-p string) + (mm-enable-multibyte)) + (insert string) + (rfc2047-strip-backslashes-in-quoted-strings) + (buffer-string)))) ;; Fixme: As above, `m' here is inappropriate. (if (and m mail-parse-charset @@ -1007,6 +1086,12 @@ ENCODED-WORD)." (mm-decode-coding-string string mail-parse-charset)) (mm-string-as-multibyte string))))) +(defun rfc2047-decode-address-string (string) + "Decode MIME-encoded STRING and return the result. +Backslashes which precede characters other than `\"' and `\\' in quoted +strings are stripped." + (rfc2047-decode-string string t)) + (defun rfc2047-pad-base64 (string) "Pad STRING to quartets." ;; Be more liberal to accept buggy base64 strings. If