diff --git a/lib/dream/conformance.sh b/lib/dream/conformance.sh index 3dd4c7df..dadb9a88 100644 --- a/lib/dream/conformance.sh +++ b/lib/dream/conformance.sh @@ -27,6 +27,7 @@ MODULES=( "lib/dream/middleware.sx" "lib/dream/session.sx" "lib/dream/flash.sx" + "lib/dream/form.sx" ) # Suites: NAME RUNNER-FN PATH @@ -36,6 +37,7 @@ SUITES=( "middleware dream-mw-tests-run! lib/dream/tests/middleware.sx" "session dream-ss-tests-run! lib/dream/tests/session.sx" "flash dream-fl-tests-run! lib/dream/tests/flash.sx" + "form dream-fo-tests-run! lib/dream/tests/form.sx" ) TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT diff --git a/lib/dream/form.sx b/lib/dream/form.sx new file mode 100644 index 00000000..4f4fe1f1 --- /dev/null +++ b/lib/dream/form.sx @@ -0,0 +1,228 @@ +;; lib/dream/form.sx — Dream-on-SX forms + CSRF. +;; Parses application/x-www-form-urlencoded bodies; CSRF tokens are stateless, +;; signed, and session-scoped. The signing function is injectable (a pure-SX keyed +;; hash by default — production should swap in a host HMAC). Depends on types.sx + +;; session.sx. dream-form returns an Ok/Err result value. + +;; ── Result (Ok/Err) ──────────────────────────────────────────────── +(define dream-ok (fn (v) {:value v :result "ok"})) +(define dream-err (fn (r) {:reason r :result "err"})) +(define dream-ok? (fn (x) (= (get x :result) "ok"))) +(define dream-err? (fn (x) (= (get x :result) "err"))) +(define dream-ok-value (fn (x) (get x :value))) +(define dream-err-reason (fn (x) (get x :reason))) + +;; ── percent decoding ─────────────────────────────────────────────── +(define + dr/hex-digit + (fn + (c) + (let + ((n (char-code c))) + (cond + ((and (>= n 48) (<= n 57)) (- n 48)) + ((and (>= n 65) (<= n 70)) + (+ 10 (- n 65))) + ((and (>= n 97) (<= n 102)) + (+ 10 (- n 97))) + (else 0))))) + +(define + dr/url-decode-loop + (fn + (s i n acc) + (if + (>= i n) + acc + (let + ((c (char-at s i))) + (if + (and (= c "%") (< (+ i 2) n)) + (dr/url-decode-loop + s + (+ i 3) + n + (str + acc + (char-from-code + (+ + (* 16 (dr/hex-digit (char-at s (+ i 1)))) + (dr/hex-digit (char-at s (+ i 2))))))) + (dr/url-decode-loop s (+ i 1) n (str acc c))))))) + +(define + dr/url-decode + (fn + (s) + (let + ((s2 (replace s "+" " "))) + (dr/url-decode-loop s2 0 (string-length s2) "")))) + +;; ── urlencoded body parsing ──────────────────────────────────────── +(define + dr/parse-form-body + (fn + (body) + (if + (= body "") + {} + (reduce + (fn + (acc pair) + (if + (= pair "") + acc + (let + ((j (index-of pair "="))) + (if + (< j 0) + (assoc acc (dr/url-decode pair) "") + (assoc + acc + (dr/url-decode (substr pair 0 j)) + (dr/url-decode (substr pair (+ j 1)))))))) + {} + (split body "&"))))) + +;; raw fields, no CSRF check +(define dream-form-fields (fn (req) (dr/parse-form-body (dream-body req)))) +(define + dream-form-field + (fn (req name) (get (dream-form-fields req) name))) + +;; ── CSRF signing (injectable; pure-SX keyed hash default) ────────── +(define + dr/poly-hash + (fn (s base seed) (dr/poly-loop s 0 (string-length s) seed base))) +(define + dr/poly-loop + (fn + (s i n h base) + (if + (>= i n) + h + (dr/poly-loop + s + (+ i 1) + n + (mod (+ (* h base) (char-code (char-at s i))) 2147483647) + base)))) + +;; NOTE: not cryptographic — adequate to demonstrate stateless CSRF; production +;; should inject a real HMAC via dream-csrf-with. +(define + dream-csrf-sign-default + (fn + (secret msg) + (let + ((m (str secret "|" msg))) + (str + (dr/poly-hash m 131 7) + "-" + (dr/poly-hash m 137 13))))) + +(define dream-csrf-field-name "dream.csrf") + +(define + dr/csrf-make-token + (fn (sign secret sid) (str sid "." (sign secret sid)))) + +(define + dr/csrf-valid? + (fn + (sign secret sid token) + (if + (or (nil? token) (= token "")) + false + (let + ((dot (index-of token "."))) + (if + (< dot 0) + false + (let + ((tsid (substr token 0 dot)) + (tsig (substr token (+ dot 1)))) + (and (= tsid sid) (= tsig (sign secret sid))))))))) + +;; ── CSRF middleware: attach signing context (needs session upstream) ── +(define + dream-csrf-with + (fn + (secret sign) + (fn (next) (fn (req) (next (assoc req :dream-csrf {:sign sign :sid (dream-session-id req) :secret secret})))))) + +(define + dream-csrf + (fn (secret) (dream-csrf-with secret dream-csrf-sign-default))) + +(define dr/csrf-of (fn (req) (get req :dream-csrf))) + +;; current token + hidden-input tag for templates +(define + dream-csrf-token + (fn + (req) + (let + ((c (dr/csrf-of req))) + (dr/csrf-make-token (get c :sign) (get c :secret) (get c :sid))))) + +(define + dream-csrf-tag + (fn + (req) + (str + ""))) + +;; ── dream-form: parse + verify CSRF -> Ok fields | Err reason ────── +(define + dream-form + (fn + (req) + (let + ((c (dr/csrf-of req))) + (if + (nil? c) + (dream-err :csrf-context-missing) + (let + ((fields (dream-form-fields req))) + (if + (dr/csrf-valid? + (get c :sign) + (get c :secret) + (get c :sid) + (get fields dream-csrf-field-name)) + (dream-ok fields) + (dream-err :csrf-token-invalid))))))) + +;; ── CSRF auto-rejecting middleware (unsafe methods need a valid token) ── +(define + dr/csrf-safe-method? + (fn (m) (or (= m "GET") (= m "HEAD") (= m "OPTIONS")))) + +(define + dream-csrf-protect-with + (fn + (secret sign) + (fn + (next) + (fn + (req) + (let + ((req2 (assoc req :dream-csrf {:sign sign :sid (dream-session-id req) :secret secret}))) + (if + (dr/csrf-safe-method? (dream-method req2)) + (next req2) + (let + ((token (get (dream-form-fields req2) dream-csrf-field-name))) + (if + (dr/csrf-valid? sign secret (dream-session-id req2) token) + (next req2) + (dream-html-status 403 "CSRF token invalid"))))))))) + +(define + dream-csrf-protect + (fn (secret) (dream-csrf-protect-with secret dream-csrf-sign-default))) diff --git a/lib/dream/tests/form.sx b/lib/dream/tests/form.sx new file mode 100644 index 00000000..5ec7503a --- /dev/null +++ b/lib/dream/tests/form.sx @@ -0,0 +1,181 @@ +;; lib/dream/tests/form.sx — urlencoded parsing, Ok/Err, CSRF accept/reject. + +(define dream-fo-pass 0) +(define dream-fo-fail 0) +(define dream-fo-fails (list)) + +(define + dream-fo-test + (fn + (name actual expected) + (if + (= actual expected) + (set! dream-fo-pass (+ dream-fo-pass 1)) + (begin + (set! dream-fo-fail (+ dream-fo-fail 1)) + (append! dream-fo-fails {:name name :actual actual :expected expected}))))) + +;; ── Result ───────────────────────────────────────────────────────── +(dream-fo-test "ok? on ok" (dream-ok? (dream-ok 5)) true) +(dream-fo-test "err? on ok" (dream-err? (dream-ok 5)) false) +(dream-fo-test "ok value" (dream-ok-value (dream-ok {:a 1})) {:a 1}) +(dream-fo-test "err reason" (dream-err-reason (dream-err :bad)) "bad") + +;; ── urlencoded parsing ───────────────────────────────────────────── +(define + dream-fo-req + (fn (body) (dream-request "POST" "/f" {:Content-Type "application/x-www-form-urlencoded"} body))) + +(dream-fo-test + "parse two fields" + (dream-form-fields (dream-fo-req "a=1&b=2")) + {:a "1" :b "2"}) +(dream-fo-test + "url-decoded value" + (dream-form-field (dream-fo-req "name=Ada+Lovelace") "name") + "Ada Lovelace") +(dream-fo-test + "percent decode" + (dream-form-field (dream-fo-req "x=a%20b%21") "x") + "a b!") +(dream-fo-test "empty body" (dream-form-fields (dream-fo-req "")) {}) +(dream-fo-test + "valueless key" + (dream-form-field (dream-fo-req "flag") "flag") + "") +(dream-fo-test + "decoded key" + (dream-form-field (dream-fo-req "first%20name=x") "first name") + "x") + +;; ── CSRF sign + verify ───────────────────────────────────────────── +(dream-fo-test + "sign deterministic" + (= + (dream-csrf-sign-default "secret" "s1") + (dream-csrf-sign-default "secret" "s1")) + true) +(dream-fo-test + "sign secret-sensitive" + (= + (dream-csrf-sign-default "secret" "s1") + (dream-csrf-sign-default "other" "s1")) + false) +(dream-fo-test + "sign session-sensitive" + (= + (dream-csrf-sign-default "secret" "s1") + (dream-csrf-sign-default "secret" "s2")) + false) +(dream-fo-test + "token valid for own session" + (dr/csrf-valid? + dream-csrf-sign-default + "k" + "s1" + (dr/csrf-make-token dream-csrf-sign-default "k" "s1")) + true) +(dream-fo-test + "token invalid for other session" + (dr/csrf-valid? + dream-csrf-sign-default + "k" + "s2" + (dr/csrf-make-token dream-csrf-sign-default "k" "s1")) + false) +(dream-fo-test + "tampered token invalid" + (dr/csrf-valid? dream-csrf-sign-default "k" "s1" "s1.deadbeef") + false) +(dream-fo-test + "empty token invalid" + (dr/csrf-valid? dream-csrf-sign-default "k" "s1" "") + false) +(dream-fo-test + "nil token invalid" + (dr/csrf-valid? dream-csrf-sign-default "k" "s1" nil) + false) + +;; ── full stack: session -> csrf -> handler ───────────────────────── +(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 + ((dream-fo-stack (fn (req) (dream-text (dream-csrf-tag req)))) + (dream-request "GET" "/form" {:Cookie "dream.session=s1"} "")))) +(dream-fo-test + "csrf-tag is hidden input" + (contains? dream-fo-tag-out "type=\"hidden\"") + true) +(dream-fo-test + "csrf-tag names field" + (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")) +(define + dream-fo-submit + (fn + (token) + ((dream-fo-stack (fn (req) (let ((r (dream-form req))) (if (dream-ok? r) (dream-text (str "ok:" (get (dream-ok-value r) "msg"))) (dream-text (str "err:" (dream-err-reason r))))))) + (dream-request + "POST" + "/form" + {:Cookie "dream.session=s1"} + (str "msg=hello&dream.csrf=" token))))) + +(dream-fo-test + "valid csrf -> Ok fields" + (dream-resp-body (dream-fo-submit dream-fo-good-token)) + "ok:hello") +(dream-fo-test + "bad csrf -> Err" + (dream-resp-body (dream-fo-submit "s1.wrong")) + "err:csrf-token-invalid") +(dream-fo-test + "missing csrf -> Err" + (dream-resp-body (dream-fo-submit "")) + "err:csrf-token-invalid") + +;; ── csrf-protect middleware auto-rejects ─────────────────────────── +(define + dream-fo-protected + (fn + (handler) + ((dream-sessions dream-fo-backend) + ((dream-csrf-protect "topsecret") handler)))) +(define dream-fo-ph (dream-fo-protected (fn (req) (dream-text "reached")))) + +(dream-fo-test + "GET passes without token" + (dream-resp-body (dream-fo-ph (dream-request "GET" "/x" {:Cookie "dream.session=s1"} ""))) + "reached") +(dream-fo-test + "POST without token 403" + (dream-status (dream-fo-ph (dream-request "POST" "/x" {:Cookie "dream.session=s1"} ""))) + 403) +(dream-fo-test + "POST with valid token reaches" + (dream-resp-body + (dream-fo-ph + (dream-request + "POST" + "/x" + {:Cookie "dream.session=s1"} + (str "dream.csrf=" dream-fo-good-token)))) + "reached") + +(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 2da05160..3df906f8 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -64,11 +64,11 @@ 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`: - - `dream-form req` — returns `(Ok fields)` or `(Err :csrf-token-invalid)`. - - `dream-multipart req` — streaming multipart form data. - - CSRF middleware: stateless signed tokens, session-scoped. - - `dream-csrf-tag req` — returns hidden input fragment for SX templates. +- [~] **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] 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`: - `dream-websocket handler` — upgrades request; handler `(fn (ws) ...)`. - `dream-send ws msg`, `dream-receive ws`, `dream-close ws`. @@ -151,6 +151,19 @@ Confirm scope before starting; some of these may be addable as Dream-internal he PREVIOUS request's messages) / `dream-flash-of` (by category) / accessors. Cookie codec percent-escapes the `|`/`~`/`%` separators so categories/messages round-trip. Read-after-write verified across request boundaries incl. multi-category. +- **2026-06-07 — Forms + CSRF (urlencoded)** (`lib/dream/form.sx`, 26 tests). Ok/Err + result values (`dream-ok`/`dream-err` + predicates/accessors). `dream-form-fields` + parses `application/x-www-form-urlencoded` with a full percent-decoder + (`%XX` via `char-from-code`, `+`→space). CSRF is stateless + signed + session- + scoped: token = `sid.signature`, verified by recomputing the signature and checking + the session id — no server storage. Signing is **injectable** (`dream-csrf-with`); + the default `dream-csrf-sign-default` is a pure-SX dual-base polynomial keyed hash + (NOT cryptographic — production should inject a host HMAC). `dream-csrf` attaches + context (needs the session middleware upstream for the sid); `dream-csrf-token` / + `dream-csrf-tag` (hidden input for templates); `dream-form` returns `Ok fields` or + `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. ## Blockers