dream: multipart/form-data parsing + 9 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 53s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 53s
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -58,6 +58,20 @@
|
|||||||
((s2 (replace s "+" " ")))
|
((s2 (replace s "+" " ")))
|
||||||
(dr/url-decode-loop s2 0 (string-length s2) ""))))
|
(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 ────────────────────────────────────────
|
;; ── urlencoded body parsing ────────────────────────────────────────
|
||||||
(define
|
(define
|
||||||
dr/parse-form-body
|
dr/parse-form-body
|
||||||
@@ -226,3 +240,127 @@
|
|||||||
(define
|
(define
|
||||||
dream-csrf-protect
|
dream-csrf-protect
|
||||||
(fn (secret) (dream-csrf-protect-with secret dream-csrf-sign-default)))
|
(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)))
|
||||||
|
|||||||
@@ -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-pass 0)
|
||||||
(define dream-fo-fail 0)
|
(define dream-fo-fail 0)
|
||||||
@@ -100,14 +100,12 @@
|
|||||||
(define dream-fo-backend (dream-memory-sessions))
|
(define dream-fo-backend (dream-memory-sessions))
|
||||||
(define dream-fo-sid (dream-fo-backend {:op "session/create"})) ;; s1
|
(define dream-fo-sid (dream-fo-backend {:op "session/create"})) ;; s1
|
||||||
|
|
||||||
;; build a request already carrying the session cookie + csrf middleware applied
|
|
||||||
(define
|
(define
|
||||||
dream-fo-stack
|
dream-fo-stack
|
||||||
(fn
|
(fn
|
||||||
(handler)
|
(handler)
|
||||||
((dream-sessions dream-fo-backend) ((dream-csrf "topsecret") handler))))
|
((dream-sessions dream-fo-backend) ((dream-csrf "topsecret") handler))))
|
||||||
|
|
||||||
;; a handler that emits its csrf tag
|
|
||||||
(define
|
(define
|
||||||
dream-fo-tag-out
|
dream-fo-tag-out
|
||||||
(dream-resp-body
|
(dream-resp-body
|
||||||
@@ -122,7 +120,6 @@
|
|||||||
(contains? dream-fo-tag-out "name=\"dream.csrf\"")
|
(contains? dream-fo-tag-out "name=\"dream.csrf\"")
|
||||||
true)
|
true)
|
||||||
|
|
||||||
;; valid token (signed for s1) -> dream-form Ok
|
|
||||||
(define
|
(define
|
||||||
dream-fo-good-token
|
dream-fo-good-token
|
||||||
(dr/csrf-make-token dream-csrf-sign-default "topsecret" "s1"))
|
(dr/csrf-make-token dream-csrf-sign-default "topsecret" "s1"))
|
||||||
@@ -178,4 +175,52 @@
|
|||||||
(str "dream.csrf=" dream-fo-good-token))))
|
(str "dream.csrf=" dream-fo-good-token))))
|
||||||
"reached")
|
"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}))
|
(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}))
|
||||||
|
|||||||
@@ -64,9 +64,9 @@ The five types: `request`, `response`, `handler = request -> response`, `middlew
|
|||||||
- `dream-flash-middleware` — single-request cookie store.
|
- `dream-flash-middleware` — single-request cookie store.
|
||||||
- `dream-add-flash-message req category msg`.
|
- `dream-add-flash-message req category msg`.
|
||||||
- `dream-flash-messages req` — returns list of `(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)`.
|
- [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] CSRF middleware: stateless signed tokens, session-scoped.
|
||||||
- [x] `dream-csrf-tag req` — returns hidden input fragment for SX templates.
|
- [x] `dream-csrf-tag req` — returns hidden input fragment for SX templates.
|
||||||
- [ ] **WebSockets** in `lib/dream/websocket.sx`:
|
- [ ] **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)
|
`Err :csrf-token-invalid`; `dream-csrf-protect` auto-rejects unsafe methods (403)
|
||||||
lacking a valid token. Full session→csrf→form stack verified accept + reject.
|
lacking a valid token. Full session→csrf→form stack verified accept + reject.
|
||||||
Multipart deferred to the next commit.
|
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
|
## Blockers
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user