2022-07-09 13:25:32 +02:00
|
|
|
;; SPDX-License-Identifier: GPL-3.0-only
|
2023-03-17 17:36:57 +01:00
|
|
|
;; SPDX-FileCopyrightText: Copyright (C) 2022-2023 by sterni
|
2022-07-09 13:25:32 +02:00
|
|
|
|
2022-01-13 00:33:59 +01:00
|
|
|
(in-package :note)
|
2021-08-02 15:13:05 +02:00
|
|
|
(declaim (optimize (safety 3)))
|
|
|
|
|
|
|
|
|
|
;;; util
|
|
|
|
|
|
|
|
|
|
(defun html-escape-stream (in out)
|
|
|
|
|
"Escape characters read from stream IN and write them to
|
2022-02-01 16:33:54 +01:00
|
|
|
stream OUT escaped using WHO:ESCAPE-STRING-MINIMAL."
|
2023-03-17 17:36:57 +01:00
|
|
|
(let ((buf (make-string config:*general-buffer-size*)))
|
2022-02-01 16:33:54 +01:00
|
|
|
(loop for len = (read-sequence buf in)
|
|
|
|
|
while (> len 0)
|
|
|
|
|
do (write-string (who:escape-string-minimal (subseq buf 0 len)) out))))
|
2021-08-02 15:13:05 +02:00
|
|
|
|
|
|
|
|
(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 ">"))
|
|
|
|
|
|
2022-01-13 00:33:59 +01:00
|
|
|
(defun find-mime-message-date (message)
|
2022-02-01 00:01:59 +01:00
|
|
|
(when-let ((date-string (car (mime:mime-message-header-values "Date" message))))
|
2022-01-13 00:33:59 +01:00
|
|
|
(date-time-parser:parse-date-time date-string)))
|
|
|
|
|
|
2021-08-02 15:13:05 +02:00
|
|
|
;;; main implementation
|
|
|
|
|
|
2022-01-13 00:33:59 +01:00
|
|
|
(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
|
2022-01-28 15:49:16 +01:00
|
|
|
"Representation of a Note created using Apple's Notes via the IMAP backend"))
|
2022-01-13 00:33:59 +01:00
|
|
|
|
2021-08-02 15:13:05 +02:00
|
|
|
(defun apple-note-p (msg)
|
|
|
|
|
"Checks X-Uniform-Type-Identifier of a MIME:MIME-MESSAGE
|
2022-01-13 00:33:59 +01:00
|
|
|
to determine if a given mime message claims to be an Apple Note."
|
2022-02-01 00:01:59 +01:00
|
|
|
(when-let (uniform-id (car (mime:mime-message-header-values
|
|
|
|
|
"X-Uniform-Type-Identifier"
|
|
|
|
|
msg)))
|
|
|
|
|
(string-equal uniform-id "com.apple.mail-note")))
|
2022-01-27 16:06:28 +01:00
|
|
|
|
2022-01-13 00:33:59 +01:00
|
|
|
(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))
|
2022-02-01 00:01:59 +01:00
|
|
|
(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))))
|
2022-01-13 00:33:59 +01:00
|
|
|
(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)))
|
2021-08-02 15:13:05 +02:00
|
|
|
(cond
|
|
|
|
|
;; notemap creates text/plain notes we need to handle properly.
|
|
|
|
|
;; Additionally we *could* check X-Mailer which notemap sets
|
2022-01-13 00:33:59 +01:00
|
|
|
((string-equal (apple-note-mime-subtype note) "plain")
|
refactor(mime4cl): replace *-input-adapter-stream with flexi-streams
The input adapter streams were input streams yielding either binary or
character data that could be constructed from a variable data source.
The stream would take care not to destroy the underlying data
source (i.e. not close it if it was a stream), so similar to with
FILE-PORTIONs, but simpler.
Unfortunately, the implementation was quite inefficient: They are
ultimately defined in terms of a function that retrieves the next
character in the source. This only allows for an implementation of
READ-CHAR (and READ-BYTE). Thanks to cl/8559, READ-SEQUENCE can be used
on e.g. FILE-PORTION, but this was still negated by a input adapter
based on one—then, READ-SEQUENCE would need to fall back on READ-CHAR or
READ-BYTE again.
Luckily, we can replace BINARY-INPUT-ADAPTER-STREAM and
CHARACTER-INPUT-ADAPTER-STREAM with a much simpler abstraction: Instead
of extra stream classes, we have a function, MAKE-INPUT-ADAPTER, which
returns an appropriate instance of FLEXI-STREAM based on a given source.
This way, the need for a distinction between binary and character input
adapter is eliminated, since FLEXI-STREAMS supports both binary and
character reads (external format is not yet handled, though).
Consequently, the :binary keyword argument to MIME-BODY-STREAM can be
dropped.
flexi-streams provides stream classes for everything except a stream
that doesn't close the underlying one. Since we have already implemented
this in POSITIONED-FLEXI-INPUT-STREAM, we can split this functionality
into a new superclass ADAPTER-FLEXI-INPUT-STREAM.
This change also allows addressing the performance regression
encountered in cl/8559: It seems that flexi-streams performs worse when
we are reading byte by byte or char by char. (After this change mblog is
still two times slower than on r/6150.) By eliminating the adapter
streams, we can start utilizing READ-SEQUENCE via decoding code that
supports it (i.e. qbase64) and bring performance on par with r/6150
again. Surely there are also ways to gain back even more performance
which has to be determined using profiling. Buffering more aggressively
seems like a sure bet, though.
Switching to flexi-streams still seems like a no-brainer, as it allows
us to drop a lot of code that was quite hacky (e.g. DELIMITED-INPUT-
STREAM) and implements en/decoding handling we did not support before,
but would need for improved correctness.
Change-Id: Ie2d1f4e42b47512a5660a1ccc0deeec2bff9788d
Reviewed-on: https://cl.tvl.fyi/c/depot/+/8581
Autosubmit: sterni <sternenseemann@systemli.org>
Reviewed-by: sterni <sternenseemann@systemli.org>
Tested-by: BuildkiteCI
2023-05-15 23:36:40 +02:00
|
|
|
(html-escape-stream (mime:mime-body-stream text) out))
|
2021-08-02 15:13:05 +02:00
|
|
|
;; Notes.app creates text/html parts
|
2022-01-13 00:33:59 +01:00
|
|
|
((string-equal (apple-note-mime-subtype note) "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)
|
2022-01-13 00:33:59 +01:00
|
|
|
(when-let* ((part (mime:find-mime-part-by-id note (cid-header-value cid)))
|
2021-08-02 15:13:05 +02:00
|
|
|
(file (mime:mime-part-file-name part)))
|
|
|
|
|
file))
|
|
|
|
|
:next-handler
|
|
|
|
|
(closure-html:make-character-stream-sink out))))
|
2022-01-13 00:33:59 +01:00
|
|
|
(t (error "Internal error: unexpected MIME subtype")))))
|