diff --git a/lib/dream/form.sx b/lib/dream/form.sx index 4f4fe1f1..1593b698 100644 --- a/lib/dream/form.sx +++ b/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))) diff --git a/lib/dream/tests/form.sx b/lib/dream/tests/form.sx index 5ec7503a..8b1e9eb4 100644 --- a/lib/dream/tests/form.sx +++ b/lib/dream/tests/form.sx @@ -1,4 +1,4 @@ -;; lib/dream/tests/form.sx — urlencoded parsing, Ok/Err, CSRF accept/reject. +;; lib/dream/tests/form.sx — urlencoded parsing, Ok/Err, CSRF accept/reject, multipart. (define dream-fo-pass 0) (define dream-fo-fail 0) @@ -100,14 +100,12 @@ (define dream-fo-backend (dream-memory-sessions)) (define dream-fo-sid (dream-fo-backend {:op "session/create"})) ;; s1 -;; build a request already carrying the session cookie + csrf middleware applied (define dream-fo-stack (fn (handler) ((dream-sessions dream-fo-backend) ((dream-csrf "topsecret") handler)))) -;; a handler that emits its csrf tag (define dream-fo-tag-out (dream-resp-body @@ -122,7 +120,6 @@ (contains? dream-fo-tag-out "name=\"dream.csrf\"") true) -;; valid token (signed for s1) -> dream-form Ok (define dream-fo-good-token (dr/csrf-make-token dream-csrf-sign-default "topsecret" "s1")) @@ -178,4 +175,52 @@ (str "dream.csrf=" dream-fo-good-token)))) "reached") +;; ── multipart/form-data ──────────────────────────────────────────── +(define + dream-fo-mp-body + (str + "--B1\r\n" + "Content-Disposition: form-data; name=\"title\"\r\n\r\n" + "Hello\r\n" + "--B1\r\n" + "Content-Disposition: form-data; name=\"file\"; filename=\"a.txt\"\r\nContent-Type: text/plain\r\n\r\n" + "line1\r\nline2\r\n" + "--B1--\r\n")) +(define + dream-fo-mp-req + (dream-request "POST" "/upload" {:Content-Type "multipart/form-data; boundary=B1"} dream-fo-mp-body)) +(define dream-fo-mp (dream-multipart dream-fo-mp-req)) +(dream-fo-test "multipart is Ok" (dream-ok? dream-fo-mp) true) +(define dream-fo-parts (dream-ok-value dream-fo-mp)) +(dream-fo-test "two parts" (len dream-fo-parts) 2) +(dream-fo-test + "field value" + (dream-multipart-field dream-fo-parts "title") + "Hello") +(dream-fo-test + "file part filename" + (get (dream-multipart-file dream-fo-parts "file") :filename) + "a.txt") +(dream-fo-test + "file content-type" + (get (dream-multipart-file dream-fo-parts "file") :content-type) + "text/plain") +(dream-fo-test + "file content keeps inner CRLF" + (get (dream-multipart-file dream-fo-parts "file") :content) + "line1\r\nline2") +(dream-fo-test + "field is not a file" + (get (dream-multipart-file dream-fo-parts "title") :filename) + nil) +(dream-fo-test + "non-multipart is Err" + (dream-err? (dream-multipart (dream-request "POST" "/x" {:Content-Type "text/plain"} "hi"))) + true) +(dream-fo-test + "quoted boundary parsed" + (dream-ok? + (dream-multipart (dream-request "POST" "/u" {:Content-Type "multipart/form-data; boundary=\"B1\""} dream-fo-mp-body))) + true) + (define dream-fo-tests-run! (fn () {:total (+ dream-fo-pass dream-fo-fail) :passed dream-fo-pass :failed dream-fo-fail :fails dream-fo-fails})) diff --git a/plans/dream-on-sx.md b/plans/dream-on-sx.md index 3df906f8..dc15f3f1 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -64,9 +64,9 @@ The five types: `request`, `response`, `handler = request -> response`, `middlew - `dream-flash-middleware` — single-request cookie store. - `dream-add-flash-message req category msg`. - `dream-flash-messages req` — returns list of `(category, msg)`. -- [~] **Forms + CSRF** in `lib/dream/form.sx`: +- [x] **Forms + CSRF** in `lib/dream/form.sx`: - [x] `dream-form req` — returns `(Ok fields)` or `(Err :csrf-token-invalid)`. - - [ ] `dream-multipart req` — streaming multipart form data. *(next commit)* + - [x] `dream-multipart req` — multipart form data (in-memory, not yet streaming). - [x] CSRF middleware: stateless signed tokens, session-scoped. - [x] `dream-csrf-tag req` — returns hidden input fragment for SX templates. - [ ] **WebSockets** in `lib/dream/websocket.sx`: @@ -164,6 +164,16 @@ Confirm scope before starting; some of these may be addable as Dream-internal he `Err :csrf-token-invalid`; `dream-csrf-protect` auto-rejects unsafe methods (403) lacking a valid token. Full session→csrf→form stack verified accept + reject. Multipart deferred to the next commit. +- **2026-06-07 — Multipart** (`lib/dream/form.sx` +9 tests, 35 total). `dream-multipart + req` parses `multipart/form-data` into parts `{:name :filename :content-type + :content}`, returns `Ok parts | Err :not-multipart`. Needed a substring splitter + `dr/split-on` because the `split` primitive is **character-class** based (multi-char + separators split on every char) — important gotcha. Boundary from the Content-Type + (handles quoted form); segments filtered to those starting with CRLF; each split on + the first `\r\n\r\n` into headers/content with one edge CRLF stripped (inner CRLFs + in file content preserved). `dream-multipart-field` / `dream-multipart-file` + accessors. In-memory, not streaming (noted for future). `\r`/`\n` string escapes + work in SX literals. ## Blockers