From: yamaoka <yamaoka>
Date: Thu, 16 Feb 2006 08:23:43 +0000 (+0000)
Subject: Synch to No Gnus 200602160823.
X-Git-Tag: t-gnus-6_17_4-quimby-~92
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=64542c6cb9cac0b362b93f89b077db6ac93b5807;p=elisp%2Fgnus.git-

Synch to No Gnus 200602160823.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f22b972..c9854ac 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,10 @@
+2006-02-16  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* rfc2231.el (rfc2231-parse-string): Attempt to parse parameter
+	values which are surrounded with \"...\"; make it never cause a
+	Lisp error; give up parsing of parameters if it failed in
+	extracting type.
+
 2006-02-14  Arne J,Ax(Brgensen  <arne@arnested.dk>
 
 	* smime.el (smime-cert-by-ldap-1): Fix bug where
diff --git a/lisp/rfc2231.el b/lisp/rfc2231.el
index 9fe0194..fe4460b 100644
--- a/lisp/rfc2231.el
+++ b/lisp/rfc2231.el
@@ -47,15 +47,45 @@ The list will be on the form
  `(name (attribute . value) (attribute . value)...)'.
 
 If the optional SIGNAL-ERROR is non-nil, signal an error when this
-function fails in parsing of parameters."
+function fails in parsing of parameters.  Otherwise, this function
+must never cause a Lisp error."
   (with-temp-buffer
     (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"))
 	  c type attribute encoded number prev-attribute vals
 	  prev-encoded parameters value)
-      (ietf-drums-init (mail-header-remove-whitespace
-			(mail-header-remove-comments string)))
+      (ietf-drums-init
+       (condition-case nil
+	   (mail-header-remove-whitespace
+	    (mail-header-remove-comments string))
+	 ;; The most likely cause of an error is unbalanced parentheses
+	 ;; or double-quotes.  If all parentheses and double-quotes are
+	 ;; quoted meaninglessly with backslashes, removing them might
+	 ;; make it parseable.  Let's try...
+	 (error
+	  (let (mod)
+	    (when (and (string-match "\\\\\"" string)
+		       (not (string-match "\\`\"\\|[^\\]\"" string)))
+	      (setq string (mm-replace-in-string string "\\\\\"" "\"")
+		    mod t))
+	    (when (and (string-match "\\\\(" string)
+		       (string-match "\\\\)" string)
+		       (not (string-match "\\`(\\|[^\\][()]" string)))
+	      (setq string (mm-replace-in-string string "\\\\\\([()]\\)" "\\1")
+		    mod t))
+	    (or (and mod
+		     (ignore-errors
+		       (mail-header-remove-whitespace
+			(mail-header-remove-comments string))))
+		;; Finally, attempt to extract only type.
+		(if (string-match
+		     (concat "\\`[\t\n ]*\\([^" ietf-drums-tspecials "\t\n ]+"
+			     "\\(?:/[^" ietf-drums-tspecials
+			     "\t\n ]+\\)?\\)\\(?:[\t\n ;]\\|\\'\\)")
+		     string)
+		    (match-string 1 string)
+		  ""))))))
       (let ((table (copy-syntax-table ietf-drums-syntax-table)))
 	(modify-syntax-entry ?\' "w" table)
 	(modify-syntax-entry ?* " " table)
@@ -67,9 +97,12 @@ function fails in parsing of parameters."
 	(set-syntax-table table))
       (setq c (char-after))
       (when (and (memq c ttoken)
-		 (not (memq c stoken)))
-	(setq type (downcase (buffer-substring
-			      (point) (progn (forward-sexp 1) (point)))))
+		 (not (memq c stoken))
+		 (setq type (ignore-errors
+			      (downcase
+			       (buffer-substring (point) (progn
+							   (forward-sexp 1)
+							   (point)))))))
 	;; Do the params
 	(condition-case err
 	    (progn
@@ -180,8 +213,7 @@ function fails in parsing of parameters."
 	     ;;(message "%s" (error-message-string err))
 	     )))
 
-	(when type
-	  `(,type ,@(nreverse parameters)))))))
+	(cons type (nreverse parameters))))))
 
 (defun rfc2231-decode-encoded-string (string)
   "Decode an RFC2231-encoded string.