Harden httpd static file serving
ober
2b3ff46e9c7e4e4eaa7e4a393ffa126c9b0283ef
--- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ *.so *.o .jerbuild-hashes +tests/static/leak new file mode 100644 --- /dev/null +++ b/.jerboa/security.json @@ -0,0 +1,21 @@ +{ + "version": 1, + "repo": "jerboa-https", + "extends": ["jerboa:daemon", "jerboa:network-service", "jerboa:parser", "jerboa:tls"], + "paths": { + "production": ["src/**/*.{ss,sls}", "lib/**/*.{ss,sls}", "Makefile"], + "tests": ["tests/**", "**/*-test.ss"], + "generated": ["lib/**", "*.so", "*.wpo"], + "vendor": ["vendor/**", "third_party/**"], + "docs": ["README.md", "SECURITY.md", "AGENTS.md", "*.md"] + }, + "policy": { + "failOn": ["critical", "high"], + "network": { "requireTimeouts": true, "requireMaxHeaderBytes": true, "requireMaxBodyBytes": true }, + "daemon": { "requirePrivilegeDropBeforeProduction": true, "requireSandboxPlan": true }, + "parser": { "requireMalformedInputCorpus": true, "requireSmugglingTests": true }, + "filesystem": { "staticServingRequiresTraversalTests": true }, + "tls": { "requireModernProtocolDefaults": true } + }, + "suppressions": [] +} --- a/Makefile +++ b/Makefile @@ -14,7 +14,7 @@ else LD_VAR = LD_LIBRARY_PATH endif -.PHONY: all build transpile test test-https test-httpd clean deps +.PHONY: all build transpile test test-https test-httpd security audit fuzz-check verify clean deps all: build @@ -38,5 +38,15 @@ test-httpd: build $(LD_VAR)=$(SSL_DIR) \ $(JERBUILD) exec --libdirs "$(LIBDIRS)" tests/httpd-test.ss +security: + scripts/daemon-security-check.sh + +audit: + @echo "No Cargo workspace in this repo; audit native TLS dependencies separately." + +fuzz-check: test-httpd + +verify: security test fuzz-check audit + clean: rm -rf lib new file mode 100644 --- /dev/null +++ b/SECURITY.md @@ -0,0 +1,28 @@ +# Security Policy + +`jerboa-https` includes HTTP client code and an HTTP/1.1 server module. The +server module listens on external ports and is experimental until hardened. + +## Supported Status + +No public production-support commitment exists yet. Security-sensitive releases +must be cut from a clean checkout after: + +- `make security` +- `make test` +- `make fuzz-check` +- `make audit` +- `make verify` + +## Hardening Expectations + +- Request-line, header, chunked transfer, content-length, and traversal cases + need malformed-input coverage before any production claim. +- Static file serving must remain traversal-resistant. +- Timeout, max header, max body, and slow-client behavior are release gates. +- TLS termination and certificate policy must be documented for deployments. + +## Reporting + +Before public release, report issues privately to the repository owner. After a +public release, add a dedicated advisory contact and disclosure window here. --- a/lib/jerboa-https/httpd.sls +++ b/lib/jerboa-https/httpd.sls @@ -20,6 +20,11 @@ (except (jerboa prelude) string-trim string-prefix? string-index tcp-write-string tcp-write tcp-read tcp-close tcp-accept tcp-listen tcp-connect) + (only (std os exec-id) exec-id-realpath-of) + (only + (std security capability) + make-fs-capability + fs-allowed-path?) (jerboa-ssl)) (def *config* (vector 4 8192 32768 60 120 1048576 128)) (def (cfg-ref i) (vector-ref *config* i)) @@ -46,6 +51,11 @@ [slen (string-length str)]) (and (>= slen plen) (string=? prefix (substring str 0 plen))))) + (def (url-prefix-match? prefix path) + (let ([plen (string-length prefix)] + [path-len (string-length path)]) + (and (<= plen path-len) + (string=? prefix (substring path 0 plen))))) (def (string-ci-contains? haystack needle) (let* ([h (string-downcase haystack)] [n (string-downcase needle)] @@ -381,6 +391,14 @@ [(or (string=? (car parts) "..") (string=? (car parts) ".")) #f] [else (loop (cdr parts))])))) + (def (static-file-authorized? directory file-path) + (and (file-exists? directory) + (file-directory? directory) + (file-exists? file-path) + (let* ([root (exec-id-realpath-of directory)] + [cap (make-fs-capability 'read: #t 'write: #f 'execute: + #f 'paths: (list root))]) + (fs-allowed-path? cap file-path)))) (def (status-text code) (case code [(200) "OK"] @@ -532,15 +550,15 @@ (router-prefix-list-set! router (sort + new (lambda (a b) - (> (string-length (car a)) (string-length (car b)))) - new)))) + (> (string-length (car a)) (string-length (car b)))))))) (def (router-lookup router path) (or (hashtable-ref (router-exact-table router) path #f) (let loop ([prefixes (router-prefix-list router)]) (cond [(null? prefixes) #f] - [(string-prefix? (caar prefixes) path) (cdar prefixes)] + [(url-prefix-match? (caar prefixes) path) (cdar prefixes)] [else (loop (cdr prefixes))])) (router-default router))) (def (handle-connection conn client-addr router) @@ -551,30 +569,34 @@ void (lambda () (let loop () - (let ([req (guard (e [#t #f]) - (read-request reader client-addr))]) - (when req - (let ([handler (router-lookup - router - (http-req-path req))]) - (guard (e - [#t - (guard (e2 [#t (void)]) - (http-respond-error writer 500))]) - (handler req writer))) - (let ([conn-hdr (http-req-header req "connection")] - [version (http-req-version req)]) - (unless (or (and conn-hdr - (header-ci=? conn-hdr "close")) - (and (string? version) - (string=? version "HTTP/1.0") - (not (and conn-hdr - (header-ci=? - conn-hdr - "keep-alive"))))) - (loop))))))) + (let ([req (try (read-request reader client-addr) + (catch (e) 'bad-request))]) + (cond + [(eq? req 'bad-request) + (try (http-respond-error writer 400) + (catch (e) (void)))] + [req + (let ([handler (router-lookup + router + (http-req-path req))]) + (try (handler req writer) + (catch + (e) + (try (http-respond-error writer 500) + (catch (e2) (void)))))) + (let ([conn-hdr (http-req-header req "connection")] + [version (http-req-version req)]) + (unless (or (and conn-hdr + (header-ci=? conn-hdr "close")) + (and (string? version) + (string=? version "HTTP/1.0") + (not (and conn-hdr + (header-ci=? + conn-hdr + "keep-alive"))))) + (loop)))])))) (lambda () - (guard (e [#t (void)]) (ssl-close conn)) + (try (ssl-close conn) (catch (e) (void))) (put-input-buffer! ibuf) (put-output-buffer! obuf)))))) (def (make-work-queue capacity) @@ -621,11 +643,11 @@ (let worker-loop () (let ([job (wq-dequeue! work-queue)]) (unless (eq? job *stop-sentinel*) - (guard (e [#t (void)]) - (handle-connection - (car job) - (cdr job) - router)) + (try (handle-connection + (car job) + (cdr job) + router) + (catch (e) (void))) (worker-loop)))))) threads))))) (def (accept-loop listen-fd work-queue ssl-ctx stop-box) @@ -673,12 +695,16 @@ (string-length url-prefix) (string-length path))] [safe-rel (safe-static-relative-path rel)]) - (if safe-rel - (http-respond-file - writer - req - (string-append directory "/" safe-rel)) - (http-respond-error writer 403)))))) + (cond + [(not safe-rel) (http-respond-error writer 403)] + [else + (let ([file-path (string-append directory "/" safe-rel)]) + (cond + [(not (file-exists? file-path)) + (http-respond-error writer 404)] + [(static-file-authorized? directory file-path) + (http-respond-file writer req file-path)] + [else (http-respond-error writer 403)]))]))))) (def (httpd-start port . args) (ssl-init!) (let ([router (if (and (pair? args) new file mode 100755 --- /dev/null +++ b/scripts/daemon-security-check.sh @@ -0,0 +1,84 @@ +#!/usr/bin/env bash +set -euo pipefail + +ROOT=$(cd "$(dirname "${BASH_SOURCE[0]}")/.." && pwd) +cd "$ROOT" + +fail=0 + +say() { + printf '[daemon-security] %s\n' "$*" +} + +warn() { + printf '[daemon-security] WARN: %s\n' "$*" >&2 +} + +require_file() { + if [ ! -f "$1" ]; then + printf '[daemon-security] missing required file: %s\n' "$1" >&2 + fail=1 + fi +} + +rg_excludes=( + --hidden + --glob '!.git/**' + --glob '!target/**' + --glob '!**/target/**' + --glob '!fuzz/artifacts/**' + --glob '!bench/results/**' + --glob '!*.lock' +) + +say "checking daemon release/security metadata" +require_file ".jerboa/security.json" +require_file "SECURITY.md" + +if command -v rg >/dev/null 2>&1; then + say "running high-confidence secret scan" + if rg -n -S "${rg_excludes[@]}" \ + -e 'BEGIN (RSA |DSA |EC |OPENSSH )?PRIVATE KEY' \ + -e 'OPENAI_API_KEY[[:space:]]*=' \ + -e 'GITHUB_TOKEN[[:space:]]*=' \ + -e 'AWS_SECRET_ACCESS_KEY[[:space:]]*=' \ + -e 'api[_-]?key[[:space:]]*[:=][[:space:]]*"?[A-Za-z0-9_./+=:-]{24,}' \ + -e 'password[[:space:]]*[:=][[:space:]]*"[^"[:space:]]{12,}"' \ + .; then + printf '[daemon-security] high-confidence secret material found\n' >&2 + fail=1 + fi +else + warn "ripgrep not found; skipping secret scan" +fi + +if git rev-parse --is-inside-work-tree >/dev/null 2>&1; then + say "checking for tracked build artifacts" + tracked=$(git ls-files \ + 'target/**' '*/target/**' 'fuzz/artifacts/**' '*.so' '*.wpo' '*.dylib' '*.rlib' 2>/dev/null || true) + if [ -n "$tracked" ]; then + printf '%s\n' "$tracked" >&2 + printf '[daemon-security] tracked generated artifacts found\n' >&2 + fail=1 + fi +fi + +if command -v gitsafe >/dev/null 2>&1; then + say "running gitsafe working-tree scan" + if git rev-parse --is-inside-work-tree >/dev/null 2>&1; then + if ! git ls-files -z -c -o --exclude-standard | xargs -0 gitsafe scan --severity high; then + fail=1 + fi + elif ! find . -type f -not -path './.git/*' -print0 | xargs -0 gitsafe scan --severity high; then + fail=1 + fi +elif command -v gitleaks >/dev/null 2>&1; then + say "running gitleaks working-tree scan" + if ! gitleaks detect --no-git --redact --source "$ROOT"; then + fail=1 + fi +else + warn "gitsafe not found; install ~/mine/jerboa-gitsafe for release-grade secret scanning" +fi + +exit "$fail" --- a/src/jerboa-https/httpd.ss +++ b/src/jerboa-https/httpd.ss @@ -32,6 +32,8 @@ string-trim string-prefix? string-index tcp-write-string tcp-write tcp-read tcp-close tcp-accept tcp-listen tcp-connect) + (only (std os exec-id) exec-id-realpath-of) + (only (std security capability) make-fs-capability fs-allowed-path?) (jerboa-ssl)) ;; ================================================================ @@ -82,6 +84,12 @@ (and (>= slen plen) (string=? prefix (substring str 0 plen))))) + (def (url-prefix-match? prefix path) + (let ([plen (string-length prefix)] + [path-len (string-length path)]) + (and (<= plen path-len) + (string=? prefix (substring path 0 plen))))) + (def (string-ci-contains? haystack needle) (let* ([h (string-downcase haystack)] [n (string-downcase needle)] @@ -486,6 +494,20 @@ #f] [else (loop (cdr parts))])))) + (def (static-file-authorized? directory file-path) + ;; Resolve both sides before serving so symlinks inside the static root + ;; cannot point outside the configured directory. + (and (file-exists? directory) + (file-directory? directory) + (file-exists? file-path) + (let* ([root (exec-id-realpath-of directory)] + [cap (make-fs-capability + 'read: #t + 'write: #f + 'execute: #f + 'paths: (list root))]) + (fs-allowed-path? cap file-path)))) + ;; ================================================================ ;; Response writing ;; ================================================================ @@ -657,10 +679,11 @@ (def (router-add-prefix! router prefix handler) ;; Register a prefix match. Longer prefixes match first. - (let ([new (cons (cons prefix handler) (router-prefix-list router))]) - (router-prefix-list-set! router - (sort (lambda (a b) (> (string-length (car a)) (string-length (car b)))) - new)))) + (let ([new (cons (cons prefix handler) (router-prefix-list router))]) + (router-prefix-list-set! router + (sort new + (lambda (a b) + (> (string-length (car a)) (string-length (car b)))))))) (def (router-lookup router path) ;; Look up handler for path. Exact match first, then prefix, then default. @@ -668,7 +691,7 @@ (let loop ([prefixes (router-prefix-list router)]) (cond [(null? prefixes) #f] - [(string-prefix? (caar prefixes) path) (cdar prefixes)] + [(url-prefix-match? (caar prefixes) path) (cdar prefixes)] [else (loop (cdr prefixes))])) (router-default router))) @@ -686,25 +709,30 @@ void (lambda () (let loop () - (let ([req (guard (e [#t #f]) (read-request reader client-addr))]) - (when req - (let ([handler (router-lookup router (http-req-path req))]) - (guard (e [#t - (guard (e2 [#t (void)]) - (http-respond-error writer 500))]) - (handler req writer))) - ;; Keep-alive check - (let ([conn-hdr (http-req-header req "connection")] - [version (http-req-version req)]) - (unless (or (and conn-hdr (header-ci=? conn-hdr "close")) - (and (string? version) - (string=? version "HTTP/1.0") - (not (and conn-hdr - (header-ci=? conn-hdr "keep-alive"))))) - (loop))))))) + (let ([req (try (read-request reader client-addr) + (catch (e) 'bad-request))]) + (cond + [(eq? req 'bad-request) + (try (http-respond-error writer 400) + (catch (e) (void)))] + [req + (let ([handler (router-lookup router (http-req-path req))]) + (try (handler req writer) + (catch (e) + (try (http-respond-error writer 500) + (catch (e2) (void)))))) + ;; Keep-alive check + (let ([conn-hdr (http-req-header req "connection")] + [version (http-req-version req)]) + (unless (or (and conn-hdr (header-ci=? conn-hdr "close")) + (and (string? version) + (string=? version "HTTP/1.0") + (not (and conn-hdr + (header-ci=? conn-hdr "keep-alive"))))) + (loop)))])))) (lambda () - (guard (e [#t (void)]) - (ssl-close conn)) + (try (ssl-close conn) + (catch (e) (void))) (put-input-buffer! ibuf) (put-output-buffer! obuf)))))) @@ -770,8 +798,8 @@ (let ([job (wq-dequeue! work-queue)]) (unless (eq? job *stop-sentinel*) ;; job is (conn . client-addr) - (guard (e [#t (void)]) ;; don't crash worker on errors - (handle-connection (car job) (cdr job) router)) + (try (handle-connection (car job) (cdr job) router) + (catch (e) (void))) (worker-loop)))))) threads))))) @@ -837,9 +865,18 @@ (let* ([path (http-req-path req)] [rel (substring path (string-length url-prefix) (string-length path))] [safe-rel (safe-static-relative-path rel)]) - (if safe-rel - (http-respond-file writer req (string-append directory "/" safe-rel)) - (http-respond-error writer 403)))))) + (cond + [(not safe-rel) + (http-respond-error writer 403)] + [else + (let ([file-path (string-append directory "/" safe-rel)]) + (cond + [(not (file-exists? file-path)) + (http-respond-error writer 404)] + [(static-file-authorized? directory file-path) + (http-respond-file writer req file-path)] + [else + (http-respond-error writer 403)]))]))))) (def (httpd-start port . args) ;; Start an HTTP server on the given port. --- a/tests/httpd-test.ss +++ b/tests/httpd-test.ss @@ -144,6 +144,12 @@ ;; ================================================================ (define test-port 18085) +(define static-symlink-created? + (guard (e [#t #f]) + (when (file-exists? "tests/static/leak") + (delete-file "tests/static/leak")) + (zero? (system "ln -s ../httpd-test.ss tests/static/leak")))) + (ssl-init!) (httpd-config 'workers: 2) @@ -193,6 +199,8 @@ (bytevector-u8-set! bv i (mod i 256))) (http-respond w 200 '(("Content-Type" . "application/octet-stream")) bv)))) +(httpd-route-static "/static/" "tests/static") + (define server (httpd-start test-port)) (sleep (make-time 'time-duration 100000000 0)) ;; 100ms for threads to start @@ -237,6 +245,23 @@ (let ([r (http-request "GET" "/unknown" test-port)]) (assert-equal (car r) 404 "status")))) +(test "static file route serves files under root" + (lambda () + (let ([r (http-request "GET" "/static/hello.txt" test-port)]) + (assert-equal (car r) 200 "status") + (assert-true (string-contains? (cdr r) "static-ok") "body")))) + +(test "static file route rejects dot-dot traversal" + (lambda () + (let ([r (http-request "GET" "/static/../httpd-test.ss" test-port)]) + (assert-equal (car r) 403 "status")))) + +(test "static file route rejects symlink escape" + (lambda () + (when static-symlink-created? + (let ([r (http-request "GET" "/static/leak" test-port)]) + (assert-equal (car r) 403 "status"))))) + (test "GET /chunked returns chunked response" (lambda () (let ([r (http-request "GET" "/chunked" test-port)]) new file mode 100644 --- /dev/null +++ b/tests/static/hello.txt @@ -0,0 +1 @@ +static-ok