From 5bc73de59d9f01ec8497ac8ff142506fd7a40876 Mon Sep 17 00:00:00 2001 From: sterni Date: Tue, 1 Feb 2022 00:01:59 +0100 Subject: 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 --- third_party/lisp/mime4cl/default.nix | 1 + third_party/lisp/mime4cl/endec.lisp | 18 ++++++++++++++++-- third_party/lisp/mime4cl/mime.lisp | 14 ++++++++++++++ third_party/lisp/mime4cl/package.lisp | 3 +++ 4 files changed, 34 insertions(+), 2 deletions(-) (limited to 'third_party') diff --git a/third_party/lisp/mime4cl/default.nix b/third_party/lisp/mime4cl/default.nix index a14d695c298e..9d3d6253f480 100644 --- a/third_party/lisp/mime4cl/default.nix +++ b/third_party/lisp/mime4cl/default.nix @@ -6,6 +6,7 @@ depot.nix.buildLisp.library { name = "mime4cl"; deps = [ + depot.third_party.lisp.babel depot.third_party.lisp.sclf depot.third_party.lisp.npg depot.third_party.lisp.trivial-gray-streams diff --git a/third_party/lisp/mime4cl/endec.lisp b/third_party/lisp/mime4cl/endec.lisp index 9f2f9c51c260..020c212e5ec4 100644 --- a/third_party/lisp/mime4cl/endec.lisp +++ b/third_party/lisp/mime4cl/endec.lisp @@ -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)))))) diff --git a/third_party/lisp/mime4cl/mime.lisp b/third_party/lisp/mime4cl/mime.lisp index 1b1d98bfaf99..5639aab23641 100644 --- a/third_party/lisp/mime4cl/mime.lisp +++ b/third_party/lisp/mime4cl/mime.lisp @@ -622,6 +622,20 @@ found in STREAM." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun mime-message-header-values (name message &key decode) + "Return all values of the header with NAME in MESSAGE, optionally decoding + it according to RFC2047 if :DECODE is T." + (loop ;; A header may occur multiple times + for header in (mime-message-headers message) + ;; MIME Headers should be case insensitive + ;; https://stackoverflow.com/a/6143644 + when (string-equal (car header) name) + collect (if decode + (decode-RFC2047 (cdr header)) + (cdr header)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defvar *lazy-mime-decode* t "If true don't decode mime bodies in memory.") diff --git a/third_party/lisp/mime4cl/package.lisp b/third_party/lisp/mime4cl/package.lisp index b1217a0b6818..5586bdc390e5 100644 --- a/third_party/lisp/mime4cl/package.lisp +++ b/third_party/lisp/mime4cl/package.lisp @@ -30,6 +30,8 @@ #:process-wait #:process-alive-p #:run-program) + (:import-from :babel :octets-to-string) + (:import-from :babel-encodings :get-character-encoding) (:export #:*lazy-mime-decode* #:print-mime-part #:read-mime-message @@ -61,6 +63,7 @@ #:mime-type-string #:mime-type-parameters #:mime-message-headers + #:mime-message-header-values #:mime= #:find-mime-part-by-path #:find-mime-part-by-id -- cgit 1.4.1