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 "