X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Frfc2231.el;h=0b028a08b8330e7ad81d176bc7705187b25ce3f3;hp=b75cf05223e479c258db132f749d47ea2ed7e0a8;hb=79a508f1f7f8e13b242201273ffb8ce266e88b90;hpb=8cd45dfbcd4de44c070e6a71607d4c0f7797151e diff --git a/lisp/rfc2231.el b/lisp/rfc2231.el index b75cf0522..0b028a08b 100644 --- a/lisp/rfc2231.el +++ b/lisp/rfc2231.el @@ -1,25 +1,23 @@ ;;; rfc2231.el --- Functions for decoding rfc2231 headers -;; Copyright (C) 1998, 1999, 2000, 2002, 2003, 2004, 2005, -;; 2006 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -47,15 +45,44 @@ 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))) + c type attribute encoded number parameters value) + (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 +94,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 @@ -109,19 +139,6 @@ function fails in parsing of parameters." (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 vals) - vals)) - parameters) - (setq prev-attribute nil - vals nil - prev-encoded nil)) (unless (eq c ?=) (error "Invalid header: %s" string)) (forward-char 1) @@ -143,45 +160,52 @@ function fails in parsing of parameters." (buffer-substring (point) (progn - (forward-sexp) - ;; We might not have reached at the end of - ;; the value because of non-ascii chars, - ;; so we should jump over them if any. - (while (and (not (eobp)) - (> (char-after) ?\177)) + ;; Jump over asterisk, non-ASCII + ;; and non-boundary characters. + (while (and c + (or (eq c ?*) + (> c ?\177) + (not (eq (char-syntax c) ? )))) (forward-char 1) - (forward-sexp)) + (setq c (char-after))) (point))))) (t (error "Invalid header: %s" string))) - (if number - (progn - (push (cons number value) vals) - (setq prev-attribute attribute - prev-encoded encoded)) - (push (cons attribute - (if encoded - (rfc2231-decode-encoded-string value) - value)) - 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 vals) - vals)) - parameters))) + (push (list attribute value number encoded) + parameters)))) (error (setq parameters nil) - (if signal-error - (signal (car err) (cdr err)) - ;;(message "%s" (error-message-string err)) - ))) + (when signal-error + (signal (car err) (cdr err))))) - (when type - `(,type ,@(nreverse parameters))))))) + ;; Now collect and concatenate continuation parameters. + (let ((cparams nil) + elem) + (loop for (attribute value part encoded) + in (sort parameters (lambda (e1 e2) + (< (or (caddr e1) 0) + (or (caddr e2) 0)))) + do (cond + ;; First part. + ((or (not (setq elem (assq attribute cparams))) + (and (numberp part) + (zerop part))) + (push (list attribute value encoded) cparams)) + ;; Repetition of a part; do nothing. + ((and elem + (null number)) + ) + ;; Concatenate continuation parts. + (t + (setcar (cdr elem) (concat (cadr elem) value))))) + ;; Finally decode encoded values. + (cons type (mapcar + (lambda (elem) + (cons (car elem) + (if (nth 2 elem) + (rfc2231-decode-encoded-string (nth 1 elem)) + (nth 1 elem)))) + (nreverse cparams)))))))) (defun rfc2231-decode-encoded-string (string) "Decode an RFC2231-encoded string. @@ -195,18 +219,18 @@ These look like: (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 + (mm-with-unibyte-buffer (insert value) (goto-char (point-min)) - (while (search-forward "%" nil t) + (while (re-search-forward "%\\([0-9A-Fa-f][0-9A-Fa-f]\\)" nil t) (insert (prog1 - (string-to-number (buffer-substring (point) (+ (point) 2)) 16) - (delete-region (1- (point)) (+ (point) 2))))) + (string-to-number (match-string 1) 16) + (delete-region (match-beginning 0) (match-end 0))))) ;; Decode using the charset, if any. - (unless (memq coding-system '(nil ascii)) - (mm-decode-coding-region (point-min) (point-max) coding-system)) - (buffer-string)))) + (if (memq coding-system '(nil ascii)) + (buffer-string) + (mm-decode-coding-string (buffer-string) coding-system))))) (defun rfc2231-encode-string (param value) "Return and PARAM=VALUE string encoded according to RFC2231. @@ -220,7 +244,7 @@ the result of this function." ;; Don't make lines exceeding 76 column. (limit (- 74 (length param))) spacep encodep charsetp charset broken) - (with-temp-buffer + (mm-with-multibyte-buffer (insert value) (goto-char (point-min)) (while (not (eobp)) @@ -236,6 +260,7 @@ the result of this function." (forward-char 1)) (when charsetp (setq charset (mm-encode-body))) + (mm-disable-multibyte) (cond ((or encodep charsetp (progn @@ -279,5 +304,4 @@ the result of this function." (provide 'rfc2231) -;;; arch-tag: c3ab751d-d108-406a-b301-68882ad8cd63 ;;; rfc2231.el ends here