(rfc2231-parse-string): Sort segmented parameters; don't decode quoted

 parameters; remove misimported Emacs code.  Suggested by ARISAWA Akihiro
 <ari(at)mbf.ocn.ne.jp>.
(rfc2231-decode-encoded-string): Don't use split-string which behaves
 differently according to Emacs version; use mm-decode-coding-region to convert
 charset to coding-system. Suggested by ARISAWA Akihiro <ari(at)mbf.ocn.ne.jp>.
(rfc2231-encode-string): Remove misimported Emacs code.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 397cc13..3fc9ab1 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,14 @@
+2006-02-08  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * rfc2231.el (rfc2231-parse-string): Sort segmented parameters;
+       don't decode quoted parameters; remove misimported Emacs code.
+       Suggested by ARISAWA Akihiro <ari@mbf.ocn.ne.jp>.
+       (rfc2231-decode-encoded-string): Don't use split-string which
+       behaves differently according to Emacs version; use
+       mm-decode-coding-region to convert charset to coding-system.
+       Suggested by ARISAWA Akihiro <ari@mbf.ocn.ne.jp>.
+       (rfc2231-encode-string): Remove misimported Emacs code.
+
 2006-02-07  Katsumi Yamaoka  <yamaoka@jpl.org>
 
        * gnus-art.el (article-decode-charset): Don't use ignore-errors

diff --git a/lisp/rfc2231.el b/lisp/rfc2231.el
index 31c9f1a..b75cf05 100644 (file)
--- a/lisp/rfc2231.el
+++ b/lisp/rfc2231.el
@@ -52,14 +52,8 @@ function fails in parsing of parameters."
     (let ((ttoken (ietf-drums-token-to-list ietf-drums-text-token))
          (stoken (ietf-drums-token-to-list ietf-drums-tspecials))
          (ntoken (ietf-drums-token-to-list "0-9"))
-         (prev-value "")
-         display-name mailbox c display-string parameters
-         attribute value type subtype number encoded
-         prev-attribute prev-encoded)
-      ;; Some mailer (e.g. Thunderbird 1.5) doesn't terminate each
-      ;; line with semicolon when folding a long parameter value.
-      (while (string-match "\\([^\t\n\r ;]\\)[\t ]*\r?\n[\t ]+" string)
-       (setq string (replace-match "\\1;\n " nil nil string)))
+         c type attribute encoded number prev-attribute vals
+         prev-encoded parameters value)
       (ietf-drums-init (mail-header-remove-whitespace
                        (mail-header-remove-comments string)))
       (let ((table (copy-syntax-table ietf-drums-syntax-table)))
@@ -97,31 +91,36 @@ function fails in parsing of parameters."
                               (point) (progn (forward-sexp 1) (point))))))
                    (error "Invalid header: %s" string))
                  (setq c (char-after))
-                 (when (eq c ?*)
-                   (forward-char 1)
-                   (setq c (char-after))
-                   (if (not (memq c ntoken))
-                       (setq encoded t
-                             number nil)
-                     (setq number
-                           (string-to-number
-                            (buffer-substring
-                             (point) (progn (forward-sexp 1) (point)))))
-                     (setq c (char-after))
-                     (when (eq c ?*)
-                       (setq encoded t)
+                 (if (eq c ?*)
+                     (progn
                        (forward-char 1)
-                       (setq c (char-after)))))
+                       (setq c (char-after))
+                       (if (not (memq c ntoken))
+                           (setq encoded t
+                                 number nil)
+                         (setq number
+                               (string-to-number
+                                (buffer-substring
+                                 (point) (progn (forward-sexp 1) (point)))))
+                         (setq c (char-after))
+                         (when (eq c ?*)
+                           (setq encoded t)
+                           (forward-char 1)
+                           (setq c (char-after)))))
+                   (setq number nil
+                         encoded nil))
                  ;; See if we have any previous continuations.
                  (when (and prev-attribute
                             (not (eq prev-attribute attribute)))
+                   (setq vals
+                         (mapconcat 'cdr (sort vals 'car-less-than-car) ""))
                    (push (cons prev-attribute
                                (if prev-encoded
-                                   (rfc2231-decode-encoded-string prev-value)
-                                 prev-value))
+                                   (rfc2231-decode-encoded-string vals)
+                                 vals))
                          parameters)
                    (setq prev-attribute nil
-                         prev-value ""
+                         vals nil
                          prev-encoded nil))
                  (unless (eq c ?=)
                    (error "Invalid header: %s" string))
@@ -132,7 +131,10 @@ function fails in parsing of parameters."
                    (setq value (buffer-substring (1+ (point))
                                                  (progn
                                                    (forward-sexp 1)
-                                                   (1- (point))))))
+                                                   (1- (point)))))
+                   (when encoded
+                     (setq value (mapconcat (lambda (c) (format "%%%02x" c))
+                                            value ""))))
                   ((and (or (memq c ttoken)
                             ;; EXTENSION: Support non-ascii chars.
                             (> c ?\177))
@@ -153,9 +155,10 @@ function fails in parsing of parameters."
                   (t
                    (error "Invalid header: %s" string)))
                  (if number
-                     (setq prev-attribute attribute
-                           prev-value (concat prev-value value)
-                           prev-encoded encoded)
+                     (progn
+                       (push (cons number value) vals)
+                       (setq prev-attribute attribute
+                             prev-encoded encoded))
                    (push (cons attribute
                                (if encoded
                                    (rfc2231-decode-encoded-string value)
@@ -164,10 +167,11 @@ function fails in parsing of parameters."
 
              ;; Take care of any final continuations.
              (when prev-attribute
+               (setq vals (mapconcat 'cdr (sort vals 'car-less-than-car) ""))
                (push (cons prev-attribute
                            (if prev-encoded
-                               (rfc2231-decode-encoded-string prev-value)
-                             prev-value))
+                               (rfc2231-decode-encoded-string vals)
+                             vals))
                      parameters)))
          (error
           (setq parameters nil)
@@ -181,25 +185,27 @@ function fails in parsing of parameters."
 
 (defun rfc2231-decode-encoded-string (string)
   "Decode an RFC2231-encoded string.
-These look like \"us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\"."
-  (with-temp-buffer
-    (let ((elems (split-string string "'")))
-      ;; The encoded string may contain zero to two single-quote
-      ;; marks.  This should give us the encoded word stripped
-      ;; of any preceding values.
-      (insert (car (last elems)))
+These look like:
+ \"us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\",
+ \"us-ascii''This%20is%20%2A%2A%2Afun%2A%2A%2A\",
+ \"'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\",
+ \"''This%20is%20%2A%2A%2Afun%2A%2A%2A\", or
+ \"This is ***fun***\"."
+  (string-match "\\`\\(?:\\([^']+\\)?'\\([^']+\\)?'\\)?\\(.+\\)" string)
+  (let ((coding-system (mm-charset-to-coding-system (match-string 1 string)))
+       ;;(language (match-string 2 string))
+       (value (match-string 3 string)))
+    (mm-with-multibyte-buffer
+      (insert value)
       (goto-char (point-min))
       (while (search-forward "%" nil t)
        (insert
         (prog1
             (string-to-number (buffer-substring (point) (+ (point) 2)) 16)
           (delete-region (1- (point)) (+ (point) 2)))))
-      ;; Encode using the charset, if any.
-      (when (and (mm-multibyte-p)
-                (> (length elems) 1)
-                (not (equal (intern (downcase (car elems))) 'us-ascii)))
-       (mm-decode-coding-region (point-min) (point-max)
-                                (intern (downcase (car elems)))))
+      ;; Decode using the charset, if any.
+      (unless (memq coding-system '(nil ascii))
+       (mm-decode-coding-region (point-min) (point-max) coding-system))
       (buffer-string))))
 
 (defun rfc2231-encode-string (param value)
@@ -263,12 +269,12 @@ the result of this function."
            (forward-line 1))))
        (spacep
        (goto-char (point-min))
-       (insert "\n " param "=\"")
+       (insert param "=\"")
        (goto-char (point-max))
        (insert "\""))
        (t
        (goto-char (point-min))
-       (insert "\n " param "=")))
+       (insert param "=")))
       (buffer-string))))
 
 (provide 'rfc2231)