diff options
author | sterni <sternenseemann@systemli.org> | 2022-01-31T23·01+0100 |
---|---|---|
committer | sterni <sternenseemann@systemli.org> | 2022-02-02T20·47+0000 |
commit | 5bc73de59d9f01ec8497ac8ff142506fd7a40876 (patch) | |
tree | f5cc93f2c22739091be3f9878c3b8c8cba72d6fd /users/sterni | |
parent | 81c47da91c90fd8bac96c6088112f71a11964131 (diff) |
feat: move mblog header handling into mime4cl r/3754
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>
Diffstat (limited to '')
-rw-r--r-- | users/sterni/mblog/default.nix | 1 | ||||
-rw-r--r-- | users/sterni/mblog/note.lisp | 41 | ||||
-rw-r--r-- | users/sterni/mblog/packages.lisp | 2 |
3 files changed, 9 insertions, 35 deletions
diff --git a/users/sterni/mblog/default.nix b/users/sterni/mblog/default.nix index 00e8b39ada0d..607d198930d1 100644 --- a/users/sterni/mblog/default.nix +++ b/users/sterni/mblog/default.nix @@ -19,7 +19,6 @@ } depot.lisp.klatre depot.third_party.lisp.alexandria - depot.third_party.lisp.babel depot.third_party.lisp.closure-html depot.third_party.lisp.cl-date-time-parser depot.third_party.lisp.cl-who diff --git a/users/sterni/mblog/note.lisp b/users/sterni/mblog/note.lisp index f953d6b1e662..45be0f4e88a8 100644 --- a/users/sterni/mblog/note.lisp +++ b/users/sterni/mblog/note.lisp @@ -19,15 +19,8 @@ surrounds them with angle brackets for a MIME header" (concatenate 'string "<" cid ">")) -;; TODO(sterni): move into mime4cl -(defun find-mime-message-header (header-name message) - (when-let ((header (assoc header-name - (mime:mime-message-headers message) - :test #'string-equal))) - (cdr header))) - (defun find-mime-message-date (message) - (when-let ((date-string (find-mime-message-header "Date" message))) + (when-let ((date-string (car (mime:mime-message-header-values "Date" message)))) (date-time-parser:parse-date-time date-string))) ;;; main implementation @@ -65,24 +58,10 @@ (defun apple-note-p (msg) "Checks X-Uniform-Type-Identifier of a MIME:MIME-MESSAGE to determine if a given mime message claims to be an Apple Note." - (when-let (uniform-id (assoc "X-Uniform-Type-Identifier" - (mime:mime-message-headers msg) - :test #'string-equal)) - (string-equal (cdr uniform-id) "com.apple.mail-note"))) - -(defun decode-RFC2047-to-string (input) - (apply - #'concatenate - (cons 'string - (mapcar - (lambda (el) - (etypecase el - (cons (babel:octets-to-string - (car el) - :encoding (babel-encodings:get-character-encoding - (intern (string-upcase (cdr el)) 'keyword)))) - (string el))) - (mime:parse-RFC2047-text input))))) + (when-let (uniform-id (car (mime:mime-message-header-values + "X-Uniform-Type-Identifier" + msg))) + (string-equal uniform-id "com.apple.mail-note"))) (defun make-apple-note (msg) (check-type msg mime-message) @@ -91,12 +70,10 @@ (error "Passed message is not an Apple Note according to headers")) (let ((text-part (mime:find-mime-text-part msg)) - (subject (when-let ((val (find-mime-message-header "Subject" msg))) - ;; TODO(sterni): mime4cl should do this - (decode-RFC2047-to-string val))) - (uuid (when-let ((val (find-mime-message-header - "X-Universally-Unique-Identifier" - msg))) + (subject (car (mime:mime-message-header-values "Subject" msg :decode t))) + (uuid (when-let ((val (car (mime:mime-message-header-values + "X-Universally-Unique-Identifier" + msg)))) (string-downcase val))) (time (find-mime-message-date msg))) ;; The idea here is that we don't need to check a lot manually, instead diff --git a/users/sterni/mblog/packages.lisp b/users/sterni/mblog/packages.lisp index 94fce16d40cf..e4fcb4672828 100644 --- a/users/sterni/mblog/packages.lisp +++ b/users/sterni/mblog/packages.lisp @@ -8,8 +8,6 @@ (defpackage :note (:use :common-lisp - :babel - :babel-encodings :closure-html :cl-date-time-parser :mime4cl) |