;;; rfc2231.el --- Functions for decoding rfc2231 headers
-;; Copyright (C) 1998, 1999, 2000, 2002, 2003, 2004, 2005,
-;; 2006 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2014 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
(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)
+ c type attribute encoded number parameters value)
(ietf-drums-init
(condition-case nil
(mail-header-remove-whitespace
;; 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...
+ ;; make it parsable. Let's try...
(error
(let (mod)
(when (and (string-match "\\\\\"" string)
(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)
(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)))))
- (cons 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.
\"''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)))
+ (let ((coding-system (mm-charset-to-coding-system
+ (match-string 1 string) nil t))
;;(language (match-string 2 string))
(value (match-string 3 string)))
(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.
(if (memq coding-system '(nil ascii))
(buffer-string)
(provide 'rfc2231)
-;;; arch-tag: c3ab751d-d108-406a-b301-68882ad8cd63
;;; rfc2231.el ends here
projects / gnus / blobdiff