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:
@@ -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 =
|
||||
|
||||
Reference in New Issue
Block a user