5789814dec
Non ASCII Subjects will use RFC2047 to encode their content. Using mime4cl's parse-RFC2047-text we obtain a list of ASCII strings and byte vectors tagged with their encoding. Using babel we can then decode the byte sequence, assuming the encoding is named the same in babel and RFC2047 (which it is for UTF-8 at least…). Change-Id: I2840672409452bd194fb1635721e338364d9b484 Reviewed-on: https://cl.tvl.fyi/c/depot/+/5078 Reviewed-by: sterni <sternenseemann@systemli.org> Tested-by: BuildkiteCI
137 lines
5 KiB
Common Lisp
137 lines
5 KiB
Common Lisp
(in-package :note)
|
|
(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 ">"))
|
|
|
|
;; 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)))
|
|
(date-time-parser:parse-date-time date-string)))
|
|
|
|
;;; main implementation
|
|
|
|
(defun apple-note-mime-subtype-p (x)
|
|
(member x '("plain" "html") :test #'string-equal))
|
|
|
|
(deftype apple-note-mime-subtype ()
|
|
'(satisfies apple-note-mime-subtype-p))
|
|
|
|
(defclass apple-note (mime:mime-message)
|
|
((text-part
|
|
:type mime:mime-text
|
|
:initarg :text-part
|
|
:reader apple-note-text-part)
|
|
(subject
|
|
:type string
|
|
:initarg :subject
|
|
:reader apple-note-subject)
|
|
(uuid
|
|
:type string
|
|
:initarg :uuid
|
|
:reader apple-note-uuid)
|
|
(time
|
|
:type integer
|
|
:initarg :time
|
|
:reader apple-note-time)
|
|
(mime-subtype
|
|
:type apple-note-mime-subtype
|
|
:initarg :mime-subtype
|
|
:reader apple-note-mime-subtype))
|
|
(:documentation
|
|
"Representation of a Note created using Apple's Notes using the IMAP backend"))
|
|
|
|
(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)))))
|
|
|
|
(defun make-apple-note (msg)
|
|
(check-type msg mime-message)
|
|
|
|
(unless (apple-note-p msg)
|
|
(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)))
|
|
(string-downcase val)))
|
|
(time (find-mime-message-date msg)))
|
|
;; The idea here is that we don't need to check a lot manually, instead
|
|
;; the type annotation are going to do this for us (with sufficient safety?)
|
|
(change-class msg 'apple-note
|
|
:text-part text-part
|
|
:subject subject
|
|
:uuid uuid
|
|
:time time
|
|
:mime-subtype (mime:mime-subtype text-part))))
|
|
|
|
(defgeneric apple-note-html-fragment (note out)
|
|
(:documentation
|
|
"Takes an APPLE-NOTE 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."))
|
|
|
|
(defmethod apple-note-html-fragment ((note apple-note) (out stream))
|
|
(let ((text (apple-note-text-part note)))
|
|
(cond
|
|
;; notemap creates text/plain notes we need to handle properly.
|
|
;; Additionally we *could* check X-Mailer which notemap sets
|
|
((string-equal (apple-note-mime-subtype note) "plain")
|
|
(html-escape-stream (mime:mime-body-stream text :binary nil) out))
|
|
;; Notes.app creates text/html parts
|
|
((string-equal (apple-note-mime-subtype note) "html")
|
|
(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 note (cid-header-value cid)))
|
|
(file (mime:mime-part-file-name part)))
|
|
file))
|
|
:next-handler
|
|
(closure-html:make-character-stream-sink out))))
|
|
(t (error "Internal error: unexpected MIME subtype")))))
|