diff --git a/lib/dream/conformance.sh b/lib/dream/conformance.sh index 9bc27604..26462fad 100644 --- a/lib/dream/conformance.sh +++ b/lib/dream/conformance.sh @@ -29,6 +29,7 @@ MODULES=( "lib/dream/flash.sx" "lib/dream/form.sx" "lib/dream/websocket.sx" + "lib/dream/static.sx" ) # Suites: NAME RUNNER-FN PATH @@ -40,6 +41,7 @@ SUITES=( "flash dream-fl-tests-run! lib/dream/tests/flash.sx" "form dream-fo-tests-run! lib/dream/tests/form.sx" "websocket dream-ws-tests-run! lib/dream/tests/websocket.sx" + "static dream-st-tests-run! lib/dream/tests/static.sx" ) TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT diff --git a/lib/dream/static.sx b/lib/dream/static.sx new file mode 100644 index 00000000..372019a3 --- /dev/null +++ b/lib/dream/static.sx @@ -0,0 +1,182 @@ +;; lib/dream/static.sx — Dream-on-SX static file serving. +;; dream-static mounts at a ** route and serves files under a root: content-type by +;; extension, ETags + If-None-Match (304), and Range requests (206). The filesystem +;; is injectable: production reads via (perform op); tests pass an in-memory map. +;; Depends on types.sx. + +;; ── filesystem backends ──────────────────────────────────────────── +;; An fs is (fn (op) result); op {:op "file/read" :path p} -> content | nil. +(define dream-static-perform-fs (fn (op) (perform op))) + +;; in-memory fs over a {path -> content} dict (tests + demos) +(define + dream-memory-fs + (fn + (files) + (fn + (op) + (if (= (get op :op) "file/read") (get files (get op :path)) nil)))) + +;; ── content-type by extension ────────────────────────────────────── +(define dr/mime-types {:js "application/javascript" :jpeg "image/jpeg" :css "text/css; charset=utf-8" :ico "image/x-icon" :mjs "application/javascript" :html "text/html; charset=utf-8" :pdf "application/pdf" :jpg "image/jpeg" :json "application/json" :htm "text/html; charset=utf-8" :wasm "application/wasm" :webp "image/webp" :gif "image/gif" :png "image/png" :svg "image/svg+xml" :md "text/markdown; charset=utf-8" :xml "application/xml" :sx "text/plain; charset=utf-8" :txt "text/plain; charset=utf-8"}) + +(define + dr/ext-of + (fn + (path) + (let + ((segs (split path "."))) + (if + (> (len segs) 1) + (lower (nth segs (- (len segs) 1))) + "")))) + +(define + dream-content-type-for + (fn + (path) + (or (get dr/mime-types (dr/ext-of path)) "application/octet-stream"))) + +;; ── ETag (weak content hash) ─────────────────────────────────────── +(define + dr/static-hash + (fn (s) (dr/static-hash-loop s 0 (string-length s) 7))) +(define + dr/static-hash-loop + (fn + (s i n h) + (if + (>= i n) + h + (dr/static-hash-loop + s + (+ i 1) + n + (mod (+ (* h 131) (char-code (char-at s i))) 2147483647))))) +(define + dr/etag-of + (fn + (content) + (str "\"" (dr/static-hash content) "-" (string-length content) "\""))) +(define + dr/etag-match? + (fn (inm etag) (and (not (nil? inm)) (or (= inm "*") (= inm etag))))) + +;; ── path safety ──────────────────────────────────────────────────── +(define + dr/static-relpath + (fn + (req) + (or (dream-param req "**") (substr (dream-path req) 1)))) +(define + dr/unsafe-path? + (fn (rel) (or (contains? rel "..") (starts-with? rel "/")))) +(define + dr/path-join + (fn + (root rel) + (if (ends-with? root "/") (str root rel) (str root "/" rel)))) + +;; ── range requests ───────────────────────────────────────────────── +(define + dr/parse-range + (fn + (header total) + (let + ((eq (index-of header "="))) + (if + (< eq 0) + nil + (let + ((spec (substr header (+ eq 1)))) + (let + ((dash (index-of spec "-"))) + (if + (< dash 0) + nil + (let + ((s (substr spec 0 dash)) + (e (substr spec (+ dash 1)))) + (let + ((start (if (= s "") 0 (parse-int s))) + (end (if (= e "") (- total 1) (parse-int e)))) + (if + (or + (< start 0) + (>= start total) + (> end (- total 1)) + (> start end)) + nil + {:start start :end end})))))))))) + +(define + dr/serve-range + (fn + (req content etag ctype) + (let + ((total (string-length content))) + (let + ((r (dr/parse-range (dream-header req "range") total))) + (if + (nil? r) + (dream-add-header + (dream-response 416 {:content-type ctype} "") + "content-range" + (str "bytes */" total)) + (let + ((start (get r :start)) (end (get r :end))) + (dream-add-header + (dream-add-header + (dream-response + 206 + {:content-type ctype} + (substr content start (+ 1 (- end start)))) + "content-range" + (str "bytes " start "-" end "/" total)) + "etag" + etag))))))) + +;; ── serving ──────────────────────────────────────────────────────── +(define + dr/serve-file + (fn + (req content) + (let + ((rel (dr/static-relpath req))) + (let + ((etag (dr/etag-of content)) (ctype (dream-content-type-for rel))) + (cond + ((dr/etag-match? (dream-header req "if-none-match") etag) + (dream-add-header (dream-empty 304) "etag" etag)) + ((dream-header req "range") + (dr/serve-range req content etag ctype)) + (else + (dream-add-header + (dream-add-header + (dream-response 200 {:content-type ctype} content) + "etag" + etag) + "accept-ranges" + "bytes"))))))) + +(define + dream-static-with + (fn + (root fs) + (fn + (req) + (let + ((rel (dr/static-relpath req))) + (if + (dr/unsafe-path? rel) + (dream-html-status 403 "Forbidden") + (let + ((content (fs {:path (dr/path-join root rel) :op "file/read"}))) + (if + (nil? content) + (dream-not-found) + (dr/serve-file req content)))))))) + +(define + dream-static + (fn (root) (dream-static-with root dream-static-perform-fs))) diff --git a/lib/dream/tests/static.sx b/lib/dream/tests/static.sx new file mode 100644 index 00000000..2df74b5b --- /dev/null +++ b/lib/dream/tests/static.sx @@ -0,0 +1,125 @@ +;; lib/dream/tests/static.sx — content types, etags, 304, ranges, traversal. + +(define dream-st-pass 0) +(define dream-st-fail 0) +(define dream-st-fails (list)) + +(define + dream-st-test + (fn + (name actual expected) + (if + (= actual expected) + (set! dream-st-pass (+ dream-st-pass 1)) + (begin + (set! dream-st-fail (+ dream-st-fail 1)) + (append! dream-st-fails {:name name :actual actual :expected expected}))))) + +;; ── content type + ext ───────────────────────────────────────────── +(dream-st-test "ext css" (dr/ext-of "a/b/style.css") "css") +(dream-st-test "ext multi-dot" (dr/ext-of "a.min.js") "js") +(dream-st-test "ext none" (dr/ext-of "README") "") +(dream-st-test + "ctype css" + (dream-content-type-for "x.css") + "text/css; charset=utf-8") +(dream-st-test + "ctype html" + (dream-content-type-for "x.html") + "text/html; charset=utf-8") +(dream-st-test "ctype png" (dream-content-type-for "x.png") "image/png") +(dream-st-test + "ctype unknown" + (dream-content-type-for "x.bin") + "application/octet-stream") + +;; ── etag ─────────────────────────────────────────────────────────── +(dream-st-test + "etag deterministic" + (= (dr/etag-of "abc") (dr/etag-of "abc")) + true) +(dream-st-test + "etag content-sensitive" + (= (dr/etag-of "abc") (dr/etag-of "abd")) + false) +(dream-st-test + "etag length-sensitive" + (= (dr/etag-of "ab") (dr/etag-of "abc")) + false) + +;; ── serving via router mount ─────────────────────────────────────── +(define dream-st-files {:/srv/app.css "body{color:red}" :/srv/index.html "

Hi

"}) +(define dream-st-fs (dream-memory-fs dream-st-files)) +(define + dream-st-app + (dream-router + (list (dream-get "/static/**" (dream-static-with "/srv" dream-st-fs))))) +(define + dream-st-get + (fn + (target headers) + (dream-st-app (dream-request "GET" target headers "")))) + +(define dream-st-css (dream-st-get "/static/app.css" {})) +(dream-st-test "serve status 200" (dream-status dream-st-css) 200) +(dream-st-test "serve body" (dream-resp-body dream-st-css) "body{color:red}") +(dream-st-test + "serve content-type" + (dream-resp-header dream-st-css "content-type") + "text/css; charset=utf-8") +(dream-st-test + "serve accept-ranges" + (dream-resp-header dream-st-css "accept-ranges") + "bytes") +(dream-st-test + "serve has etag" + (not (nil? (dream-resp-header dream-st-css "etag"))) + true) +(dream-st-test + "missing file 404" + (dream-status (dream-st-get "/static/nope.txt" {})) + 404) +(dream-st-test + "traversal blocked 403" + (dream-status (dream-st-get "/static/../secret" {})) + 403) + +;; ── conditional: If-None-Match -> 304 ────────────────────────────── +(define dream-st-etag (dream-resp-header dream-st-css "etag")) +(define dream-st-304 (dream-st-get "/static/app.css" {:If-None-Match dream-st-etag})) +(dream-st-test "matching etag 304" (dream-status dream-st-304) 304) +(dream-st-test "304 empty body" (dream-resp-body dream-st-304) "") +(dream-st-test + "stale etag 200" + (dream-status (dream-st-get "/static/app.css" {:If-None-Match "\"stale\""})) + 200) +(dream-st-test + "star etag 304" + (dream-status (dream-st-get "/static/app.css" {:If-None-Match "*"})) + 304) + +;; ── range requests ───────────────────────────────────────────────── +(define dream-st-range (dream-st-get "/static/app.css" {:Range "bytes=0-3"})) +(dream-st-test "range status 206" (dream-status dream-st-range) 206) +(dream-st-test "range body slice" (dream-resp-body dream-st-range) "body") +(dream-st-test + "range content-range" + (dream-resp-header dream-st-range "content-range") + "bytes 0-3/15") +(define dream-st-open (dream-st-get "/static/app.css" {:Range "bytes=5-"})) +(dream-st-test "open range body" (dream-resp-body dream-st-open) "color:red}") +(dream-st-test + "open range header" + (dream-resp-header dream-st-open "content-range") + "bytes 5-14/15") +(define dream-st-bad (dream-st-get "/static/app.css" {:Range "bytes=20-30"})) +(dream-st-test + "unsatisfiable range 416" + (dream-status dream-st-bad) + 416) +(dream-st-test + "416 content-range" + (dream-resp-header dream-st-bad "content-range") + "bytes */15") + +(define dream-st-tests-run! (fn () {:total (+ dream-st-pass dream-st-fail) :passed dream-st-pass :failed dream-st-fail :fails dream-st-fails})) diff --git a/plans/dream-on-sx.md b/plans/dream-on-sx.md index 99e49ed2..bd7228f8 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -72,7 +72,7 @@ The five types: `request`, `response`, `handler = request -> response`, `middlew - [x] **WebSockets** in `lib/dream/websocket.sx`: - `dream-websocket handler` — upgrades request; handler `(fn (ws) ...)`. - `dream-send ws msg`, `dream-receive ws`, `dream-close ws`. -- [ ] **Static files:** `dream-static root-path` — serves files, ETags, range requests. +- [x] **Static files:** `dream-static root-path` — serves files, ETags, range requests. - [ ] **`dream-run`**: wires root handler into SX's `perform (:http-listen ...)`. - [ ] **Demos** in `lib/dream/demos/`: - `hello.ml` → `lib/dream/demos/hello.sx`: "Hello, World!" route. @@ -182,6 +182,13 @@ Confirm scope before starting; some of these may be addable as Dream-internal he is `(perform op)`, tests use `dream-mock-ws` (in-memory inbox/outbox/closed via the cell pattern) with `dream-ws-sent` / `dream-ws-closed?` introspection and `dream-ws-run` to drive a handler. Echo loop + room broadcast verified. +- **2026-06-07 — Static files** (`lib/dream/static.sx`, 28 tests). `dream-static root` + mounts at a `**` route and serves files: content-type by extension (mime map), + weak ETag (`"hash-length"`) with `If-None-Match` → 304 (incl. `*`), and `Range: + bytes=` requests → 206 with `Content-Range` (open-ended `bytes=N-` supported, + unsatisfiable → 416). `..`/absolute path traversal → 403; missing → 404; full + responses advertise `Accept-Ranges`. Filesystem is injectable — + `dream-static-perform-fs` (host) vs `dream-memory-fs` (in-memory map for tests). ## Blockers