about summary refs log tree commit diff
path: root/users/sterni
diff options
context:
space:
mode:
authorsterni <sternenseemann@systemli.org>2022-01-27T15·06+0100
committersterni <sternenseemann@systemli.org>2022-02-02T20·47+0000
commit5789814dec3b1a7fe46902a8f477d585b36de6b4 (patch)
tree159b9f55de7569e42b8ebc2add57670a35708491 /users/sterni
parentc3cf66f248d5b721629d3cb5293d6f1bd1358a43 (diff)
fix(users/sterni/mblog): handle RFC2047 in subjects r/3750
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
Diffstat (limited to 'users/sterni')
-rw-r--r--users/sterni/mblog/default.nix1
-rw-r--r--users/sterni/mblog/note.lisp18
-rw-r--r--users/sterni/mblog/packages.lisp2
3 files changed, 20 insertions, 1 deletions
diff --git a/users/sterni/mblog/default.nix b/users/sterni/mblog/default.nix
index f8ba70b90b..cc605d7cd2 100644
--- a/users/sterni/mblog/default.nix
+++ b/users/sterni/mblog/default.nix
@@ -17,6 +17,7 @@ depot.nix.buildLisp.program {
       default = depot.nix.buildLisp.bundled "asdf";
     }
     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
diff --git a/users/sterni/mblog/note.lisp b/users/sterni/mblog/note.lisp
index 0091e97b08..93d9231aa2 100644
--- a/users/sterni/mblog/note.lisp
+++ b/users/sterni/mblog/note.lisp
@@ -66,6 +66,20 @@
                                :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)
 
@@ -73,7 +87,9 @@
     (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))
+        (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)))
diff --git a/users/sterni/mblog/packages.lisp b/users/sterni/mblog/packages.lisp
index 1d5aa07313..7e357f89ff 100644
--- a/users/sterni/mblog/packages.lisp
+++ b/users/sterni/mblog/packages.lisp
@@ -8,6 +8,8 @@
 (defpackage :note
   (:use
    :common-lisp
+   :babel
+   :babel-encodings
    :closure-html
    :who
    :cl-date-time-parser