diff options
Diffstat (limited to 'users/sterni/mblog/note.lisp')
| -rw-r--r-- | users/sterni/mblog/note.lisp | 101 |
1 files changed, 81 insertions, 20 deletions
diff --git a/users/sterni/mblog/note.lisp b/users/sterni/mblog/note.lisp index 660b4826b1..0091e97b08 100644 --- a/users/sterni/mblog/note.lisp +++ b/users/sterni/mblog/note.lisp @@ -1,4 +1,4 @@ -(in-package :mblog) +(in-package :note) (declaim (optimize (safety 3))) ;;; util @@ -15,46 +15,107 @@ 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 -;; TODO(sterni): make this a “parser” instead of a predicate +(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 is an Apple Note." + 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 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))) +(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 (find-mime-message-header "Subject" msg)) + (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 - ;; 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 - ((string-equal (mime:mime-subtype text) "plain") + ((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 (mime:mime-subtype text) "html") + ((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 msg (cid-header-value 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 "Malformed Apple Note: unknown mime type"))))) + (t (error "Internal error: unexpected MIME subtype"))))) |