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:
parent
81c47da91c
commit
5bc73de59d
7 changed files with 43 additions and 37 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -8,8 +8,6 @@
|
|||
(defpackage :note
|
||||
(:use
|
||||
:common-lisp
|
||||
:babel
|
||||
:babel-encodings
|
||||
:closure-html
|
||||
:cl-date-time-parser
|
||||
:mime4cl)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue