dream: static file serving — mime, etags, 304, ranges, traversal guard + 28 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -29,6 +29,7 @@ MODULES=(
|
|||||||
"lib/dream/flash.sx"
|
"lib/dream/flash.sx"
|
||||||
"lib/dream/form.sx"
|
"lib/dream/form.sx"
|
||||||
"lib/dream/websocket.sx"
|
"lib/dream/websocket.sx"
|
||||||
|
"lib/dream/static.sx"
|
||||||
)
|
)
|
||||||
|
|
||||||
# Suites: NAME RUNNER-FN PATH
|
# Suites: NAME RUNNER-FN PATH
|
||||||
@@ -40,6 +41,7 @@ SUITES=(
|
|||||||
"flash dream-fl-tests-run! lib/dream/tests/flash.sx"
|
"flash dream-fl-tests-run! lib/dream/tests/flash.sx"
|
||||||
"form dream-fo-tests-run! lib/dream/tests/form.sx"
|
"form dream-fo-tests-run! lib/dream/tests/form.sx"
|
||||||
"websocket dream-ws-tests-run! lib/dream/tests/websocket.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
|
TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
|
||||||
|
|||||||
182
lib/dream/static.sx
Normal file
182
lib/dream/static.sx
Normal file
@@ -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)))
|
||||||
125
lib/dream/tests/static.sx
Normal file
125
lib/dream/tests/static.sx
Normal file
@@ -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 "<h1>Hi</h1>"})
|
||||||
|
(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}))
|
||||||
@@ -72,7 +72,7 @@ The five types: `request`, `response`, `handler = request -> response`, `middlew
|
|||||||
- [x] **WebSockets** in `lib/dream/websocket.sx`:
|
- [x] **WebSockets** in `lib/dream/websocket.sx`:
|
||||||
- `dream-websocket handler` — upgrades request; handler `(fn (ws) ...)`.
|
- `dream-websocket handler` — upgrades request; handler `(fn (ws) ...)`.
|
||||||
- `dream-send ws msg`, `dream-receive ws`, `dream-close 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 ...)`.
|
- [ ] **`dream-run`**: wires root handler into SX's `perform (:http-listen ...)`.
|
||||||
- [ ] **Demos** in `lib/dream/demos/`:
|
- [ ] **Demos** in `lib/dream/demos/`:
|
||||||
- `hello.ml` → `lib/dream/demos/hello.sx`: "Hello, World!" route.
|
- `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
|
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
|
cell pattern) with `dream-ws-sent` / `dream-ws-closed?` introspection and
|
||||||
`dream-ws-run` to drive a handler. Echo loop + room broadcast verified.
|
`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
|
## Blockers
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user