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

@ -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

View file

@ -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

View file

@ -8,8 +8,6 @@
(defpackage :note
(:use
:common-lisp
:babel
:babel-encodings
:closure-html
:cl-date-time-parser
:mime4cl)