about summary refs log tree commit diff
path: root/third_party/lisp/mime4cl/mime.lisp
diff options
context:
space:
mode:
authorsterni <sternenseemann@systemli.org>2023-05-03T16·19+0200
committerclbot <clbot@tvl.fyi>2023-05-18T16·14+0000
commitb379e44dfb871100546b3d60bd3c77fbeac61adc (patch)
treefc191184ca069f55e74fd1c59000a507ac144681 /third_party/lisp/mime4cl/mime.lisp
parenta1324513ad8c6d8b9cce2881fe90b890541a9b77 (diff)
refactor(3p/lisp/mime4cl): use flexi-streams and binary input r/6151
This refactor is driven by the following (ultimate) aims:

- Get rid of as much of the custom stream code in mime4cl which makes
  less code to maintain in the future.

- Lay the groundwork for correct handling of 8bit transfer encoding:
  The mime4cl we inherited assumes that any MIME message can be decoded
  completely by the CL implementation (in SBCL's case using latin1)
  into CHARACTERs. This is not necessarily the case. flexi-streams
  allows changing how the stream is decoded on the fly and also has
  support for reading the underlying bytes which is perfect for the
  requirements decoding MIME has.

- Since flexi-streams uses trivial-gray-streams, it supports
  READ-SEQUENCE. Taking advantage of this may improve decoding
  performance significantly in the future.

This incurs the following changes:

- Naturally we now open given files as binary files in MIME-MESSAGE.
  Given strings are encoded using STRING-TO-OCTETS and then passed on
  to a new octet vector method. Instead of MY-STRING-INPUT-STREAM this
  now uses flexi-streams' WITH-INPUT-FROM-SEQUENCE.

- OPEN-FILE-PORTION and OPEN-DECODED-FILE-PORTION need to be merged,
  since the transfer encoding not only implies an extra decoder stream
  that needs to be attached after file portion stream, but also imply a
  certain encoding of the stream itself (mostly binary vs. ASCII).
  As flexi-streams can change their encoding on the fly this could be
  untangled again, but it is not strictly necessary.

  As before, we use the DATA slot of the file portion to create a fresh
  stream if possible. Instead of strings we now use an vector of octets
  to match MIME-MESSAGE.

  The actual portioned stream relies on POSITIONED-FLEXI-INPUT-STREAM, a
  subclass of the stock FLEXI-INPUT-STREAM class, described below.

- POSITIONED-FLEXI-INPUT-STREAM replaces DELIMITED-INPUT-STREAM. It is
  created using MAKE-POSITIONED-FLEXI-INPUT-STREAM which accepts the
  same arguments as MAKE-FLEXI-STREAMS and, additionally, :IGNORE-CLOSE.
  A POSITIONED-FLEXI-INPUT-STREAM works the same as an
  FLEXI-INPUT-STREAM, but upon creation, the underlying stream is
  rewinded or forwarded to the argument given by :POSITION using
  FILE-POSITION.

  If :IGNORE-CLOSE is T, a call to CLOSE is not forwarded to the
  underlying stream.

Change-Id: I2d48c769bb110ca0b7cf52441bd63c1e1c2ccd04
Reviewed-on: https://cl.tvl.fyi/c/depot/+/8559
Reviewed-by: sterni <sternenseemann@systemli.org>
Autosubmit: sterni <sternenseemann@systemli.org>
Tested-by: BuildkiteCI
Diffstat (limited to 'third_party/lisp/mime4cl/mime.lisp')
-rw-r--r--third_party/lisp/mime4cl/mime.lisp47
1 files changed, 25 insertions, 22 deletions
diff --git a/third_party/lisp/mime4cl/mime.lisp b/third_party/lisp/mime4cl/mime.lisp
index b240b02f717c..ac828216cbcc 100644
--- a/third_party/lisp/mime4cl/mime.lisp
+++ b/third_party/lisp/mime4cl/mime.lisp
@@ -613,18 +613,18 @@ found in STREAM."
 
 (defgeneric decode-mime-body (part input-stream))
 
-(defmethod decode-mime-body ((part mime-part) (stream delimited-input-stream))
- (be base (base-stream stream)
+(defmethod decode-mime-body ((part mime-part) (stream flexi-stream))
+ (be base (flexi-stream-root-stream stream)
    (if *lazy-mime-decode*
        (setf (mime-body part)
              (make-file-portion :data (etypecase base
-                                        (my-string-input-stream
-                                         (stream-string base))
+                                        (vector-stream
+                                         (flexi-streams::vector-stream-vector base))
                                         (file-stream
                                          (pathname base)))
                                 :encoding (mime-encoding part)
-                                :start (file-position stream)
-                                :end (stream-end stream)))
+                                :start (flexi-stream-position stream)
+                                :end (flexi-stream-bound stream)))
        (call-next-method))))
 
 (defmethod decode-mime-body ((part mime-part) (stream file-stream))
@@ -635,12 +635,12 @@ found in STREAM."
                                :start (file-position stream)))
       (call-next-method)))
 
-(defmethod decode-mime-body ((part mime-part) (stream my-string-input-stream))
+(defmethod decode-mime-body ((part mime-part) (stream vector-stream))
   (if *lazy-mime-decode*
       (setf (mime-body part)
-            (make-file-portion :data (stream-string stream)
+            (make-file-portion :data (flexi-streams::vector-stream-vector stream)
                                :encoding (mime-encoding part)
-                               :start (file-position stream)))
+                               :start (flexi-streams::vector-stream-index stream)))
       (call-next-method)))
 
 (defmethod decode-mime-body ((part mime-part) stream)
@@ -658,11 +658,10 @@ list of MIME parts."
                           (be *default-type* (if (eq :digest (mime-subtype part))
                                                  '("message" "rfc822" ())
                                                  '("text" "plain" (("charset" . "us-ascii"))))
-                              in (make-instance 'delimited-input-stream
-                                                :underlying-stream stream
-                                                :dont-close t
-                                                :start start
-                                                :end end)
+                              in (make-positioned-flexi-input-stream stream
+                                                                     :position start
+                                                                     :bound end
+                                                                     :ignore-close t)
                               (read-mime-part in))))
                     offsets)))))
 
@@ -754,17 +753,21 @@ returns a MIME-MESSAGE object."
   msg)
 
 (defmethod mime-message ((msg string))
-  (with-open-stream (in (make-instance 'my-string-input-stream :string msg))
-    (read-mime-message in)))
+  (mime-message (flexi-streams:string-to-octets msg)))
 
-(defmethod mime-message ((msg stream))
-  (read-mime-message msg))
+(defmethod mime-message ((msg vector))
+  (with-input-from-sequence (in msg)
+    (mime-message in)))
 
 (defmethod mime-message ((msg pathname))
-  (let (#+sbcl(sb-impl::*default-external-format* :latin-1)
-        #+sbcl(sb-alien::*default-c-string-external-format* :latin-1))
-    (with-open-file (in msg)
-      (read-mime-message in))))
+  (with-open-file (in msg :element-type '(unsigned-byte 8))
+    (mime-message in)))
+
+(defmethod mime-message ((msg flexi-stream))
+  (read-mime-message msg))
+
+(defmethod mime-message ((msg stream))
+  (read-mime-message (make-flexi-stream msg)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;