host: malformed posts degrade instead of 502 (parse-safe + 500 boundary)
A post whose sx_content is malformed SX (e.g. "<h1 ...)" — a typo'd paren) made GET /<slug>/ return 502, surfaced as a Cloudflare error page. Root cause: the kernel `parse` raises a native Parse_error that an SX (guard ...) cannot catch (guard only traps SX conditions), so host/blog-render's guard around (parse sx) was ineffective; the exception escaped to the http-listen loop, which swallowed it and wrote NO response — a dropped connection that Caddy/Cloudflare relay as 502. - kernel: add `parse-safe` — like parse but returns nil on malformed input (value-returning, so untrusted text can be handled without a host exception). - kernel: http-listen now synthesises a 500 response on ANY handler exception instead of dropping the connection, so the origin stays responsive (no more proxy 502 / branded error page) and the error is logged. This is also the only place a native exception can be trapped, since SX guard can't. - blog: host/blog-render uses (parse-safe sx) — malformed bodies render the existing "(unparseable content)" placeholder; the per-block render guard already covers unknown components (~kg-*), so /mddddd/ recovers too. Verified live: /try-thus/ and /mddddd/ now 200 with placeholders; working posts, home, and login unaffected. 193/193 conformance. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
@@ -817,14 +817,28 @@ let setup_evaluator_bridge env =
|
||||
(* Run the handler through the IO-aware CEK runner (not bare
|
||||
sx_call) so request handlers can perform per-request IO —
|
||||
durable store reads/writes resolve via cek_run_with_io's
|
||||
suspension loop instead of returning an unresolved suspension. *)
|
||||
suspension loop instead of returning an unresolved suspension.
|
||||
On ANY handler exception, synthesise a 500 response rather than
|
||||
letting it escape: an escaped exception drops the connection
|
||||
with no bytes written, which a reverse proxy (Caddy/Cloudflare)
|
||||
surfaces as a 502 error page. A real 500 keeps the origin
|
||||
responsive and debuggable. Note: a native exception (e.g. the
|
||||
parser's Parse_error) cannot be caught by an SX (guard ...), so
|
||||
this boundary is the only place it can be trapped. *)
|
||||
(try
|
||||
let st = Sx_ref.continue_with_call handler
|
||||
(List [Dict req]) (Env (Sx_types.make_env ()))
|
||||
(List [Dict req]) (List []) in
|
||||
cek_run_with_io st
|
||||
with e -> Mutex.unlock mtx; raise e) in
|
||||
Mutex.unlock mtx;
|
||||
let r = cek_run_with_io st in
|
||||
Mutex.unlock mtx; r
|
||||
with e ->
|
||||
Mutex.unlock mtx;
|
||||
Printf.eprintf "[http-listen] handler error: %s\n%!"
|
||||
(Printexc.to_string e);
|
||||
let d = Sx_types.make_dict () in
|
||||
Hashtbl.replace d "status" (Integer 500);
|
||||
Hashtbl.replace d "body" (String "Internal Server Error");
|
||||
Dict d) in
|
||||
let getk k = match resp with
|
||||
| Dict h -> Hashtbl.find_opt h k | _ -> None in
|
||||
let status = match getk "status" with
|
||||
@@ -1250,6 +1264,20 @@ let setup_type_constructors env =
|
||||
(* Already a value — return as-is *)
|
||||
v
|
||||
| _ -> raise (Eval_error "parse: expected string"));
|
||||
(* Like parse, but returns nil instead of raising on malformed input. The
|
||||
parser raises a native Parse_error that an SX-level (guard ...) cannot catch
|
||||
(guard only traps SX conditions, not host exceptions), so code that handles
|
||||
untrusted text — e.g. a stored post body — needs a value-returning parse to
|
||||
degrade gracefully rather than crash the request. *)
|
||||
bind "parse-safe" (fun args ->
|
||||
match args with
|
||||
| [String s] | [SxExpr s] ->
|
||||
(try
|
||||
let exprs = Sx_parser.parse_all s in
|
||||
(match exprs with [e] -> e | _ -> List exprs)
|
||||
with _ -> Nil)
|
||||
| [v] -> v
|
||||
| _ -> Nil);
|
||||
(* Native bytecode compiler — bootstrapped from lib/compiler.sx *)
|
||||
bind "compile" (fun args ->
|
||||
match args with [expr] -> Sx_compiler.compile expr | _ -> Nil);
|
||||
|
||||
@@ -76,7 +76,7 @@
|
||||
(fn (record)
|
||||
(let ((sx (get record :sx-content)))
|
||||
(if (and sx (not (= sx "")))
|
||||
(let ((tree (guard (e (true nil)) (parse sx))))
|
||||
(let ((tree (parse-safe sx)))
|
||||
(cond
|
||||
((nil? tree) "<p><em>(unparseable content)</em></p>")
|
||||
((and (= (type-of tree) "list") (> (len tree) 0)
|
||||
|
||||
Reference in New Issue
Block a user