dream: multipart/form-data parsing + 9 tests

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>

lib/dream/form.sx

@@ -58,6 +58,20 @@
       ((s2 (replace s "+" " ")))
       (dr/url-decode-loop s2 0 (string-length s2) ""))))
 
+;; ── substring splitter (split primitive is char-class based) ───────
+(define
+  dr/split-on
+  (fn
+    (s sep)
+    (let
+      ((i (index-of s sep)))
+      (if
+        (< i 0)
+        (list s)
+        (cons
+          (substr s 0 i)
+          (dr/split-on (substr s (+ i (string-length sep))) sep))))))
+
 ;; ── urlencoded body parsing ────────────────────────────────────────
 (define
   dr/parse-form-body
@@ -226,3 +240,127 @@
 (define
   dream-csrf-protect
   (fn (secret) (dream-csrf-protect-with secret dream-csrf-sign-default)))
+
+;; ── multipart/form-data parsing ────────────────────────────────────
+;; In-memory (not yet streaming): parses the whole body into parts, each
+;; {:name :filename :content-type :content}. Returns Ok parts | Err :not-multipart.
+(define
+  dr/multipart-boundary
+  (fn
+    (ctype)
+    (let
+      ((i (index-of ctype "boundary=")))
+      (if
+        (< i 0)
+        ""
+        (let
+          ((raw (trim (substr ctype (+ i 9)))))
+          (if
+            (starts-with? raw "\"")
+            (substr raw 1 (- (string-length raw) 2))
+            raw))))))
+
+;; strip one leading and one trailing CRLF
+(define
+  dr/strip-edges
+  (fn
+    (s)
+    (let
+      ((s1 (if (starts-with? s "\r\n") (substr s 2) s)))
+      (if
+        (ends-with? s1 "\r\n")
+        (substr s1 0 (- (string-length s1) 2))
+        s1))))
+
+;; value of attr="..." within a header block
+(define
+  dr/cd-attr
+  (fn
+    (block attr)
+    (let
+      ((key (str attr "=\"")))
+      (let
+        ((i (index-of block key)))
+        (if
+          (< i 0)
+          nil
+          (let
+            ((rest (substr block (+ i (string-length key)))))
+            (substr rest 0 (index-of rest "\""))))))))
+
+;; value of a named header line within a header block
+(define
+  dr/block-header
+  (fn
+    (block name)
+    (reduce
+      (fn
+        (acc line)
+        (if
+          (and
+            (nil? acc)
+            (starts-with? (lower line) (str (lower name) ":")))
+          (trim (substr line (+ (index-of line ":") 1)))
+          acc))
+      nil
+      (dr/split-on block "\r\n"))))
+
+(define
+  dr/parse-part
+  (fn
+    (seg)
+    (let
+      ((s (dr/strip-edges seg)))
+      (let
+        ((sp (index-of s "\r\n\r\n")))
+        (if
+          (< sp 0)
+          nil
+          (let
+            ((block (substr s 0 sp))
+              (content (substr s (+ sp 4))))
+            {:name (dr/cd-attr block "name") :filename (dr/cd-attr block "filename") :content-type (dr/block-header block "content-type") :content content}))))))
+
+(define
+  dream-multipart
+  (fn
+    (req)
+    (let
+      ((boundary (dr/multipart-boundary (or (dream-header req "content-type") ""))))
+      (if
+        (= boundary "")
+        (dream-err :not-multipart)
+        (let
+          ((segs (dr/split-on (dream-body req) (str "--" boundary))))
+          (dream-ok
+            (filter
+              (fn (p) (not (nil? p)))
+              (map
+                dr/parse-part
+                (filter (fn (seg) (starts-with? seg "\r\n")) segs)))))))))
+
+;; accessors over a parts list
+(define
+  dream-multipart-field
+  (fn
+    (parts name)
+    (reduce
+      (fn
+        (acc p)
+        (if (and (nil? acc) (= (get p :name) name)) (get p :content) acc))
+      nil
+      parts)))
+
+(define
+  dream-multipart-file
+  (fn
+    (parts name)
+    (reduce
+      (fn
+        (acc p)
+        (if
+          (and (nil? acc) (= (get p :name) name) (get p :filename))
+          p
+          acc))
+      nil
+      parts)))