security: add opaque http handler errors
Jaime Fournier <jaimef@linbsd.org>
68c3bfbbdcfc61416f17e40ea12f798386f094e8
diff --git a/docs/kimi3-security-recommmendations.md b/docs/kimi3-security-recommmendations.md
index 6439a9f..be7b31f 100644
--- a/docs/kimi3-security-recommmendations.md
+++ b/docs/kimi3-security-recommmendations.md
@@ -777,7 +777,8 @@ they are build-time. Close the runtime loop.
logs before recording events, and tests assert registered secret values are
redacted from both JSONL and human summaries. `(std net grpc)` handler
failures now log internal details server-side and return client-visible
- opaque refs. Remaining work: HTTP/router/MCP/LSP/repl-protocol surfaces need
+ opaque refs; `(std net thread-httpd)` does the same for handler exceptions.
+ Remaining work: router integrations plus MCP/LSP/repl-protocol surfaces need
opaque client error refs, the scanner needs a condition-message HTTP-response
rule, and release artifact path-leak checks still need a gate.
diff --git a/docs/security-reference.md b/docs/security-reference.md
index 924f55b..1ca0260 100644
--- a/docs/security-reference.md
+++ b/docs/security-reference.md
@@ -813,7 +813,7 @@ These modules are implemented but not covered in depth above.
| Module | Purpose |
|--------|---------|
| `(std security sanitize)` | Context-aware sanitization: `sanitize-html`, `sanitize-html-attribute`, `sanitize-url-attribute`, `sql-escape`, `sanitize-path`, `safe-path-join`, `sanitize-header-value`, `sanitize-url`. Raises `&path-traversal`, `&header-injection`, `&url-scheme-violation`. |
-| `(std security errors)` | Error classification (internal vs client-safe). Generates opaque error references for correlation. Prevents leaking internal details in error responses; `(std net grpc)` uses it for handler failures. |
+| `(std security errors)` | Error classification (internal vs client-safe). Generates opaque error references for correlation. Prevents leaking internal details in error responses; `(std net grpc)` and `(std net thread-httpd)` use it for handler failures. |
| `(std security audit)` | Append-only JSONL audit log with SHA-256 hash chain. `audit-log!`, `verify-audit-chain`, `check-capability!/audit`. |
| `(std security audit-log)` | Per-run structured audit records with JSONL/summary rendering, per-log redactors, and `audit-log-use-env-policy!` to scrub `(std security env)` registered secret values before emission. |
| `(std security auth)` | API key stores, session tokens with expiry, auth middleware pattern, rate limiting for auth attempts. |
diff --git a/lib/std/net/thread-httpd.ss b/lib/std/net/thread-httpd.ss
index 54615e9..ea1b25b 100644
--- a/lib/std/net/thread-httpd.ss
+++ b/lib/std/net/thread-httpd.ss
@@ -45,7 +45,12 @@
(import (chezscheme)
(std port-position)
- (only (jerboa core) def defstruct match try catch finally))
+ (only (jerboa core) def defstruct match try catch finally)
+ (only (std security errors)
+ make-safe-error-handler
+ safe-error-response-status
+ safe-error-response-message
+ safe-error-response-reference))
;; ========== libc FFI ==========
@@ -120,6 +125,21 @@
(def *default-header-timeout-ms* 15000)
(def *default-body-timeout-ms* 30000)
(def *max-tracked-peers* 1024)
+(def thread-httpd-safe-error-handler
+ (make-safe-error-handler
+ (lambda (ref class-name exn)
+ (fprintf (current-error-port)
+ "thread-httpd error ref=~a class=~s detail=~s~%"
+ ref class-name exn))))
+
+(def (safe-http-error-response class-name exn)
+ (let ([safe (thread-httpd-safe-error-handler class-name exn)])
+ (respond-text
+ (safe-error-response-status safe)
+ (string-append
+ (safe-error-response-message safe)
+ "\nReference: "
+ (safe-error-response-reference safe)))))
;; sockaddr_in is { sa_family_t sin_family; in_port_t sin_port;
;; struct in_addr sin_addr; char sin_zero[8]; }
@@ -902,10 +922,13 @@
(if (response? resp)
(write-response fd resp)
(write-response fd
- (respond-text 500 "Handler did not return response"))))))
+ (safe-http-error-response
+ 'internal-error
+ "handler did not return response"))))))
(catch (exn)
(try
- (write-response fd (respond-text 500 "Internal Server Error"))
+ (write-response fd
+ (safe-http-error-response 'internal-error exn))
(catch (e) #f)))))
(lambda ()
(c-close fd)
diff --git a/tests/test-thread-httpd-errors.ss b/tests/test-thread-httpd-errors.ss
new file mode 100644
index 0000000..b0cb14d
--- /dev/null
+++ b/tests/test-thread-httpd-errors.ss
@@ -0,0 +1,69 @@
+#!chezscheme
+;;; tests/test-thread-httpd-errors.ss -- HTTP server safe error responses
+
+(import (scheme)
+ (std net thread-httpd)
+ (std net http))
+
+(define pass 0)
+(define fail 0)
+
+(define-syntax test
+ (syntax-rules ()
+ [(_ name expr expected)
+ (guard (exn [#t (set! fail (+ fail 1))
+ (printf "FAIL ~a: ~a~%" name
+ (if (message-condition? exn) (condition-message exn) exn))])
+ (let ([got expr])
+ (if (equal? got expected)
+ (begin (set! pass (+ pass 1)) (printf " ok ~a~%" name))
+ (begin (set! fail (+ fail 1))
+ (printf "FAIL ~a: got ~s expected ~s~%" name got expected)))))]))
+
+(define (contains-substring? s needle)
+ (let ([slen (string-length s)]
+ [nlen (string-length needle)])
+ (let outer ([i 0])
+ (cond
+ [(> (+ i nlen) slen) #f]
+ [else
+ (let inner ([j 0])
+ (cond
+ [(= j nlen) #t]
+ [(char=? (string-ref s (+ i j)) (string-ref needle j))
+ (inner (+ j 1))]
+ [else (outer (+ i 1))]))]))))
+
+(printf "--- thread-httpd safe error responses ---~%~%")
+
+(let* ([secret "secret-token-456"]
+ [server (thread-httpd-start
+ 0
+ (lambda (req)
+ (error 'test-thread-httpd-errors secret)))]
+ [port (thread-httpd-listen-port server)])
+ (dynamic-wind
+ (lambda () #f)
+ (lambda ()
+ (sleep (make-time 'time-duration 100000000 0))
+ (let* ([resp (http-fetch-get
+ (string-append "http://127.0.0.1:"
+ (number->string port)
+ "/boom"))]
+ [body (http-body resp)])
+ (test "status" (http-status resp) 500)
+ (test "body has safe message"
+ (contains-substring? body "Internal server error")
+ #t)
+ (test "body has reference"
+ (contains-substring? body "Reference: ")
+ #t)
+ (test "body hides handler secret"
+ (contains-substring? body secret)
+ #f)))
+ (lambda ()
+ (thread-httpd-stop! server))))
+
+(printf "~%thread-httpd error tests: ~a passed, ~a failed~%" pass fail)
+(when (> fail 0)
+ (exit 1))