Fix POST body reading + handler param binding for POST requests

Two fixes in the HTTP server:

1. Read full POST body: the single 8192-byte read() could miss the body
   if it arrived in a separate TCP segment. Now parses Content-Length
   and reads remaining bytes in a loop.

2. Handler param binding: for POST/PUT/PATCH, check request-form before
   request-arg. The old (or (request-arg n) (request-form n)) pattern
   short-circuited on request-arg's "" default (truthy in SX), never
   reaching request-form.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-04-06 14:26:05 +00:00
parent 577d09f443
commit d3ff4f7ef3

View File

@@ -2994,15 +2994,19 @@ let http_mode port =
| Symbol s when s <> "&key" && s <> "&rest" -> Some s
| String s when s <> "&key" && s <> "&rest" -> Some s
| _ -> None) params in
(* Bind handler params in env before aser *)
(* Bind handler params in env before aser.
Try request-form first for POST (request-arg returns "" as default,
which is truthy in SX, preventing or-fallback to request-form). *)
let is_post = req_method = "POST" || req_method = "PUT" || req_method = "PATCH" in
List.iter (fun n ->
let v = try Sx_ref.eval_expr
(List [Symbol "or"; List [Symbol "request-arg"; String n];
List [Symbol "request-form"; String n]]) (Env env)
let v = try
let form_val = Sx_ref.eval_expr (List [Symbol "request-form"; String n]) (Env env) in
let arg_val = Sx_ref.eval_expr (List [Symbol "request-arg"; String n]) (Env env) in
if is_post then (if form_val <> String "" then form_val else arg_val)
else (if arg_val <> Nil then arg_val else form_val)
with _ -> Nil in
ignore (env_bind env n v)
) param_names;
_pending_response_status := 200;
let aser_call = List [Symbol "aser"; List [Symbol "quote"; body]; Env env] in
let body_str = match Sx_ref.eval_expr aser_call (Env env) with
| String s | SxExpr s -> s | v -> Sx_types.inspect v in
@@ -3091,10 +3095,47 @@ let http_mode port =
(* Read request — non-blocking: set a short timeout *)
Unix.setsockopt_float client Unix.SO_RCVTIMEO 5.0;
Unix.setsockopt_float client Unix.SO_SNDTIMEO 10.0;
let buf = Bytes.create 8192 in
let n = try Unix.read client buf 0 8192 with _ -> 0 in
let buf = Buffer.create 8192 in
let tmp = Bytes.create 8192 in
let n = try Unix.read client tmp 0 8192 with _ -> 0 in
Buffer.add_subbytes buf tmp 0 n;
(* For POST: ensure full body is read based on Content-Length *)
if n > 0 then begin
let data = Bytes.sub_string buf 0 n in
let initial = Buffer.contents buf in
let header_end =
let rec find s i = if i + 4 > String.length s then -1
else if String.sub s i 4 = "\r\n\r\n" then i + 4
else find s (i + 1) in find initial 0 in
if header_end > 0 then begin
(* Parse Content-Length from headers *)
let headers_str = String.lowercase_ascii (String.sub initial 0 header_end) in
let content_length =
let rec find_cl s i =
if i + 16 > String.length s then 0
else if String.sub s i 16 = "content-length: " then
let start = i + 16 in
let end_ = try String.index_from s start '\r' with Not_found ->
try String.index_from s start '\n' with Not_found -> String.length s in
(try int_of_string (String.trim (String.sub s start (end_ - start))) with _ -> 0)
else find_cl s (i + 1) in find_cl headers_str 0 in
let body_so_far = String.length initial - header_end in
let remaining = content_length - body_so_far in
if remaining > 0 then begin
let body_buf = Bytes.create remaining in
let read_so_far = ref 0 in
while !read_so_far < remaining do
let r = try Unix.read client body_buf !read_so_far (remaining - !read_so_far)
with _ -> 0 in
if r = 0 then read_so_far := remaining (* EOF *)
else read_so_far := !read_so_far + r
done;
Buffer.add_subbytes buf body_buf 0 !read_so_far
end
end
end;
let n = Buffer.length buf in
if n > 0 then begin
let data = Buffer.contents buf in
let is_ajax = is_sx_request data in
if is_ajax then Printf.eprintf "[sx-http] AJAX request detected\n%!";
let handled =