fed-prims: Phase J — http-request + 6 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 2m48s

NATIVE-ONLY http-request primitive (bin/sx_server.ml). HTTP/1.1 over
Unix sockets + gethostbyname; inline http:// URL parsing (full
url-parse deferred to Phase K); Connection: close + Host +
Content-Length headers auto-supplied; reads response via
Content-Length or read-to-EOF; chunked transfer-encoding rejected.
Test bin/test_http_client.sh spins a Phase-H echo server and drives
a second sx_server: GET+query, POST+body, 404, custom request
header reflected, non-http scheme rejected, integer status — 6/6.
WASM boot green (prim not in lib); Erlang conformance 530/530.
This commit is contained in:
2026-05-26 19:53:58 +00:00
parent 4548461bfc
commit 46e0653911
3 changed files with 290 additions and 0 deletions

View File

@@ -841,6 +841,164 @@ let setup_evaluator_bridge env =
done;
Nil
| _ -> raise (Eval_error "http-listen: (port handler)"));
(* fed-sx Milestone 1 client direction (Phase J). NATIVE ONLY —
Unix sockets + DNS; absent from the WASM kernel. HTTP/1.1
request: TCP connect, write request line + headers + body,
read status + headers + body, return {:status :headers :body}.
URL must be http://...; HTTPS is a later phase (needs TLS).
Body read: Content-Length first, else read to EOF (we send
Connection: close). Transfer-Encoding: chunked is rejected —
fed-sx Phase 8 wires this for inter-server POSTs which will
all carry Content-Length. *)
Sx_primitives.register "http-request" (fun args ->
let strip_cr s =
let n = String.length s in
if n > 0 && s.[n - 1] = '\r' then String.sub s 0 (n - 1) else s
in
match args with
| [String meth; String url; headers_v; body_v] ->
let body = match body_v with
| String s -> s
| Nil -> ""
| v -> Sx_types.value_to_string v in
let prefix = "http://" in
let plen = String.length prefix in
let ulen = String.length url in
if ulen < plen || String.sub url 0 plen <> prefix
then raise (Eval_error "http-request: URL must start with http://");
let rest = String.sub url plen (ulen - plen) in
let host_port, path =
match String.index_opt rest '/' with
| Some i ->
String.sub rest 0 i,
String.sub rest i (String.length rest - i)
| None -> rest, "/" in
if host_port = "" then
raise (Eval_error "http-request: missing host");
let host, port =
match String.index_opt host_port ':' with
| Some i ->
let h = String.sub host_port 0 i in
let ps = String.sub host_port (i + 1)
(String.length host_port - i - 1) in
(h,
(try int_of_string ps with _ ->
raise (Eval_error "http-request: bad port")))
| None -> host_port, 80 in
let addr =
(try (Unix.gethostbyname host).h_addr_list.(0)
with Not_found ->
raise (Eval_error ("http-request: dns: " ^ host))) in
let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
let cleanup () = try Unix.close sock with _ -> () in
let result =
(try
(try Unix.connect sock (Unix.ADDR_INET (addr, port))
with Unix.Unix_error (e, _, _) ->
raise (Eval_error
("http-request: connect: " ^ Unix.error_message e)));
let oc = Unix.out_channel_of_descr sock in
let ic = Unix.in_channel_of_descr sock in
let buf = Buffer.create 256 in
Buffer.add_string buf
(Printf.sprintf "%s %s HTTP/1.1\r\n" meth path);
let host_hdr_sent = ref false in
let clen_sent = ref false in
let conn_sent = ref false in
(match headers_v with
| Dict h ->
Hashtbl.iter (fun k v ->
let kl = String.lowercase_ascii k in
if kl = "host" then host_hdr_sent := true;
if kl = "content-length" then clen_sent := true;
if kl = "connection" then conn_sent := true;
let vs = match v with
| String s -> s
| x -> Sx_types.value_to_string x in
Buffer.add_string buf
(Printf.sprintf "%s: %s\r\n" k vs)) h
| Nil -> ()
| _ -> raise (Eval_error "http-request: headers must be dict"));
if not !host_hdr_sent then
Buffer.add_string buf
(Printf.sprintf "Host: %s\r\n" host_port);
if not !clen_sent then
Buffer.add_string buf
(Printf.sprintf "Content-Length: %d\r\n"
(String.length body));
if not !conn_sent then
Buffer.add_string buf "Connection: close\r\n";
Buffer.add_string buf "\r\n";
Buffer.add_string buf body;
output_string oc (Buffer.contents buf);
flush oc;
let sl =
(try strip_cr (input_line ic)
with End_of_file ->
raise (Eval_error
"http-request: connection closed before status")) in
let status =
match String.split_on_char ' ' sl with
| _ver :: code :: _ ->
(try int_of_string code with _ ->
raise (Eval_error "http-request: bad status code"))
| _ -> raise (Eval_error "http-request: bad status line") in
let rhdrs = Sx_types.make_dict () in
let clen = ref (-1) in
let chunked = ref false in
let rec rdh () =
let h =
(try strip_cr (input_line ic)
with End_of_file -> "") in
if h = "" then ()
else begin
(match String.index_opt h ':' with
| Some i ->
let name =
String.lowercase_ascii
(String.trim (String.sub h 0 i)) in
let value =
String.trim
(String.sub h (i + 1)
(String.length h - i - 1)) in
Hashtbl.replace rhdrs name (String value);
if name = "content-length" then
(try clen := int_of_string value with _ -> ())
else if name = "transfer-encoding" &&
String.lowercase_ascii value = "chunked"
then chunked := true
| None -> ());
rdh ()
end in
rdh ();
if !chunked then
raise (Eval_error
"http-request: chunked transfer-encoding not supported");
let rbody =
if !clen >= 0 then begin
let b = Bytes.create !clen in
really_input ic b 0 !clen;
Bytes.unsafe_to_string b
end else begin
let b = Buffer.create 256 in
(try
while true do
Buffer.add_channel b ic 4096
done; assert false
with End_of_file -> ());
Buffer.contents b
end in
let resp = Sx_types.make_dict () in
Hashtbl.replace resp "status" (Integer status);
Hashtbl.replace resp "headers" (Dict rhdrs);
Hashtbl.replace resp "body" (String rbody);
Dict resp
with e -> cleanup (); raise e) in
cleanup ();
result
| _ -> raise (Eval_error "http-request: (method url headers body)"));
bind "trampoline" (fun args ->
match args with
| [v] ->