2021-08-02 15:13:05 +02:00
|
|
|
(in-package :mblog)
|
|
|
|
|
(declaim (optimize (safety 3)))
|
|
|
|
|
|
|
|
|
|
;;; util
|
|
|
|
|
|
|
|
|
|
(defun html-escape-stream (in out)
|
|
|
|
|
"Escape characters read from stream IN and write them to
|
|
|
|
|
stream OUT escaped using WHO:ESCAPE-CHAR-MINIMAL."
|
|
|
|
|
(loop for char = (read-char in nil nil)
|
|
|
|
|
while char
|
|
|
|
|
do (write-string (who:escape-char-minimal char) out)))
|
|
|
|
|
|
|
|
|
|
(defun cid-header-value (cid)
|
|
|
|
|
"Takes a Content-ID as present in Apple Notes' <object> tags and properly
|
|
|
|
|
surrounds them with angle brackets for a MIME header"
|
|
|
|
|
(concatenate 'string "<" cid ">"))
|
|
|
|
|
|
|
|
|
|
;;; main implementation
|
|
|
|
|
|
|
|
|
|
;; TODO(sterni): make this a “parser” instead of a predicate
|
|
|
|
|
(defun apple-note-p (msg)
|
|
|
|
|
"Checks X-Uniform-Type-Identifier of a MIME:MIME-MESSAGE
|
|
|
|
|
to determine if a given mime message is an Apple Note."
|
|
|
|
|
(when-let (uniform-id (assoc "X-Uniform-Type-Identifier"
|
|
|
|
|
(mime:mime-message-headers msg)
|
2022-01-12 18:58:21 +01:00
|
|
|
:test #'string-equal))
|
|
|
|
|
(string-equal (cdr uniform-id) "com.apple.mail-note")))
|
2021-08-02 15:13:05 +02:00
|
|
|
|
|
|
|
|
(defun apple-note-html-fragment (msg out)
|
|
|
|
|
"Takes a MIME:MIME-MESSAGE and writes its text content as HTML to
|
|
|
|
|
the OUT stream. The <object> tags are resolved to <img> which
|
|
|
|
|
refer to the respective attachment's filename as a relative path,
|
|
|
|
|
but extraction of the attachments must be done separately. The
|
|
|
|
|
surrounding <html> and <body> tags are stripped and <head>
|
|
|
|
|
discarded completely, so only a fragment which can be included
|
|
|
|
|
in custom templates remains."
|
|
|
|
|
(let ((text (find-mime-text-part msg)))
|
|
|
|
|
(cond
|
|
|
|
|
;; Sanity checking of the note
|
|
|
|
|
((not (apple-note-p msg))
|
|
|
|
|
(error "Unsupported or missing X-Uniform-Type-Identifier"))
|
|
|
|
|
((not text) (error "Malformed Apple Note: no text part"))
|
|
|
|
|
;; notemap creates text/plain notes we need to handle properly.
|
|
|
|
|
;; Additionally we *could* check X-Mailer which notemap sets
|
2022-01-12 18:58:21 +01:00
|
|
|
((string-equal (mime:mime-subtype text) "plain")
|
2021-08-02 15:13:05 +02:00
|
|
|
(html-escape-stream (mime:mime-body-stream text :binary nil) out))
|
|
|
|
|
;; Notes.app creates text/html parts
|
2022-01-12 18:58:21 +01:00
|
|
|
((string-equal (mime:mime-subtype text) "html")
|
2021-08-02 15:13:05 +02:00
|
|
|
(closure-html:parse
|
|
|
|
|
(mime:mime-body-stream text)
|
|
|
|
|
(make-instance
|
|
|
|
|
'apple-note-transformer
|
|
|
|
|
:cid-lookup
|
|
|
|
|
(lambda (cid)
|
|
|
|
|
(when-let* ((part (mime:find-mime-part-by-id msg (cid-header-value cid)))
|
|
|
|
|
(file (mime:mime-part-file-name part)))
|
|
|
|
|
file))
|
|
|
|
|
:next-handler
|
|
|
|
|
(closure-html:make-character-stream-sink out))))
|
|
|
|
|
(t (error "Malformed Apple Note: unknown mime type")))))
|
