feat: move mblog header handling into mime4cl

Accessing the headers of a MIME message feels like something mime4cl
should handle. We implemented this ad hoc in mblog before in order to
not need to worry about doing it in a sensible way. Now we introduce a
decent-ish interface for getting a header from a MIME message,
mime-message-header-values:

* It returns a list because MIME message headers may appear multiple
  times.

* It decodes RFC2047 only upon request, as you may want to be stricter
  about parsing certain fields.

* It checks header name equality case insensitively.

The code for decoding the RFC2047 string is retained and still uses
babel for doing the actual decoding.

Change-Id: I58bbbe4b46dbded04160b481a28a40d14775673d
Reviewed-on: https://cl.tvl.fyi/c/depot/+/5150
Tested-by: BuildkiteCI
Reviewed-by: sterni <sternenseemann@systemli.org>
This commit is contained in:
sterni 2022-02-01 00:01:59 +01:00
parent 81c47da91c
commit 5bc73de59d
7 changed files with 43 additions and 37 deletions

View file

@ -644,7 +644,7 @@ method of RFC2047 and return a sequence of bytes."
(vector-push-extend (char-code c) output-sequence)))
finally (return output-sequence)))
(defun decode-RFC2047-string (encoding string &key (start 0) (end (length string)))
(defun decode-RFC2047-part (encoding string &key (start 0) (end (length string)))
"Decode STRING according to RFC2047 and return a sequence of
bytes."
(gcase (encoding string-equal)
@ -674,10 +674,24 @@ sequence, a charset string indicating the original coding."
(push (subseq text previous-end start)
result))
(setf previous-end (+ end 2))
(push (cons (decode-RFC2047-string encoding text :start (1+ second-?) :end end)
(push (cons (decode-RFC2047-part encoding text :start (1+ second-?) :end end)
charset)
result))
finally (unless (= previous-end (length text))
(push (subseq text previous-end (length text))
result))
(return (nreverse result))))
(defun decode-RFC2047 (text)
"Decode TEXT into a fully decoded string. Whenever a non ASCII part is
encountered, try to decode it using babel, otherwise signal an error."
(flet ((decode-part (part)
(etypecase part
(cons (babel:octets-to-string
(car part)
:encoding (babel-encodings:get-character-encoding
(intern (string-upcase (cdr part)) 'keyword))))
(string part))))
(apply #'concatenate
(cons 'string
(mapcar #'decode-part (mime:parse-RFC2047-text text))))))