From 7d9dddcc804668d72fb61aaeca32c11711f2ef90 Mon Sep 17 00:00:00 2001 From: giles Date: Mon, 18 May 2026 18:25:24 +0000 Subject: [PATCH] =?UTF-8?q?fed-prims:=20Phase=20H=20=E2=80=94=20native-onl?= =?UTF-8?q?y=20http-listen=20HTTP/1.1=20server=20+=20curl=20test?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-Authored-By: Claude Opus 4.7 (1M context) --- hosts/ocaml/bin/sx_server.ml | 133 ++++++++++++++++++++++++++++++++ hosts/ocaml/bin/test_http.sh | 49 ++++++++++++ plans/fed-sx-host-primitives.md | 10 ++- 3 files changed, 191 insertions(+), 1 deletion(-) create mode 100755 hosts/ocaml/bin/test_http.sh diff --git a/hosts/ocaml/bin/sx_server.ml b/hosts/ocaml/bin/sx_server.ml index 40de7b49..1fb6594d 100644 --- a/hosts/ocaml/bin/sx_server.ml +++ b/hosts/ocaml/bin/sx_server.ml @@ -708,6 +708,139 @@ let setup_evaluator_bridge env = match args with | [e; expr] -> Sx_ref.eval_expr expr e | _ -> raise (Eval_error "eval-in-env: (env expr)")); + + (* fed-sx Milestone 1 Step 8 transport. NATIVE ONLY — sockets + + threads; deliberately absent from the WASM kernel (registered + here in bin/, never in lib/sx_primitives.ml). Minimal HTTP/1.1, + Connection: close. handler : req-dict -> resp-dict where + req = {:method :path :query :headers :body}, + resp = {:status :headers :body}. Never returns. *) + Sx_primitives.register "http-listen" (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 + | [port_v; handler] -> + let port = match port_v with + | Integer n -> n + | Number f -> int_of_float f + | _ -> raise (Eval_error "http-listen: (port handler)") in + let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in + Unix.setsockopt sock Unix.SO_REUSEADDR true; + Unix.bind sock + (Unix.ADDR_INET (Unix.inet_addr_loopback, port)); + Unix.listen sock 64; + (* SX runtime is shared across threads — serialize handler calls. *) + let mtx = Mutex.create () in + let reason = function + | 200 -> "OK" | 201 -> "Created" | 204 -> "No Content" + | 301 -> "Moved Permanently" | 302 -> "Found" + | 400 -> "Bad Request" | 401 -> "Unauthorized" + | 403 -> "Forbidden" | 404 -> "Not Found" + | 405 -> "Method Not Allowed" | 500 -> "Internal Server Error" + | _ -> "OK" in + let handle fd = + (try + let ic = Unix.in_channel_of_descr fd in + let oc = Unix.out_channel_of_descr fd in + let reqline = strip_cr (input_line ic) in + (match String.split_on_char ' ' reqline with + | meth :: target :: _ -> + let path, query = + match String.index_opt target '?' with + | Some i -> + String.sub target 0 i, + String.sub target (i + 1) + (String.length target - i - 1) + | None -> target, "" in + let headers = Sx_types.make_dict () in + let clen = ref 0 in + let rec rdh () = + let h = strip_cr (input_line ic) 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 headers name (String value); + if name = "content-length" then + (try clen := int_of_string value with _ -> ()) + | None -> ()); + rdh () + end in + rdh (); + let body = + if !clen > 0 then begin + let b = Bytes.create !clen in + really_input ic b 0 !clen; + Bytes.unsafe_to_string b + end else "" in + let req = Sx_types.make_dict () in + Hashtbl.replace req "method" (String meth); + Hashtbl.replace req "path" (String path); + Hashtbl.replace req "query" (String query); + Hashtbl.replace req "headers" (Dict headers); + Hashtbl.replace req "body" (String body); + Mutex.lock mtx; + let resp = + (try Sx_runtime.sx_call handler [Dict req] + with e -> Mutex.unlock mtx; raise e) in + Mutex.unlock mtx; + let getk k = match resp with + | Dict h -> Hashtbl.find_opt h k | _ -> None in + let status = match getk "status" with + | Some (Integer n) -> n + | Some (Number f) -> int_of_float f + | _ -> 200 in + let rbody = match getk "body" with + | Some (String s) -> s + | Some v -> Sx_types.value_to_string v + | None -> "" in + let rhdrs = match getk "headers" with + | Some (Dict h) -> + Hashtbl.fold (fun k v acc -> + (k, (match v with + | String s -> s + | v -> Sx_types.value_to_string v)) :: acc) + h [] + | _ -> [] in + let buf = Buffer.create 256 in + Buffer.add_string buf + (Printf.sprintf "HTTP/1.1 %d %s\r\n" status + (reason status)); + List.iter (fun (k, v) -> + Buffer.add_string buf + (Printf.sprintf "%s: %s\r\n" k v)) rhdrs; + if not (List.exists + (fun (k, _) -> + String.lowercase_ascii k = "content-type") + rhdrs) + then Buffer.add_string buf + "Content-Type: text/plain\r\n"; + Buffer.add_string buf + (Printf.sprintf "Content-Length: %d\r\n" + (String.length rbody)); + Buffer.add_string buf "Connection: close\r\n\r\n"; + Buffer.add_string buf rbody; + output_string oc (Buffer.contents buf); + flush oc + | _ -> ()) + with _ -> ()); + (try Unix.close fd with _ -> ()) + in + while true do + let fd, _ = Unix.accept sock in + ignore (Thread.create handle fd) + done; + Nil + | _ -> raise (Eval_error "http-listen: (port handler)")); bind "trampoline" (fun args -> match args with | [v] -> diff --git a/hosts/ocaml/bin/test_http.sh b/hosts/ocaml/bin/test_http.sh new file mode 100755 index 00000000..46ca6cab --- /dev/null +++ b/hosts/ocaml/bin/test_http.sh @@ -0,0 +1,49 @@ +#!/usr/bin/env bash +# Phase H test — native-only http-listen primitive. +# Starts sx_server with a tiny SX echo handler, drives it with curl +# (GET / POST / 404 / custom header), asserts, then kills it. +set -u +cd "$(dirname "$0")/.." + +SRV=_build/default/bin/sx_server.exe +PORT=${HTTP_TEST_PORT:-8911} +PASS=0 +FAIL=0 +ok() { echo " PASS: $1"; PASS=$((PASS+1)); } +bad() { echo " FAIL: $1 — $2"; FAIL=$((FAIL+1)); } + +if [ ! -x "$SRV" ]; then + echo "build sx_server.exe first (dune build bin/sx_server.exe)"; exit 1 +fi + +H='(begin (define (h req) (if (= (get req "path") "/echo") {:status 200 :headers {"X-Echo" (get req "method")} :body (str "M=" (get req "method") " P=" (get req "path") " Q=" (get req "query") " B=" (get req "body"))} {:status 404 :body "nope"})) (http-listen '"$PORT"' h))' +ESC=${H//\"/\\\"} + +{ printf '(epoch 1)\n(eval "%s")\n' "$ESC"; sleep 30; } | "$SRV" >/tmp/test_http_srv.out 2>&1 & +SVPID=$! +trap 'kill $SVPID 2>/dev/null; wait 2>/dev/null' EXIT + +up=0 +for _ in $(seq 1 50); do + curl -s -o /dev/null "http://127.0.0.1:$PORT/echo" 2>/dev/null && { up=1; break; } + sleep 0.2 +done +[ "$up" = 1 ] || { echo " FAIL: server did not start"; cat /tmp/test_http_srv.out; exit 1; } + +# GET with query + custom response header. +g=$(curl -s -i "http://127.0.0.1:$PORT/echo?x=1" | tr -d '\r') +echo "$g" | grep -q '^HTTP/1.1 200 OK' && ok "GET status 200" || bad "GET status" "$g" +echo "$g" | grep -q '^X-Echo: GET' && ok "GET custom header" || bad "GET header" "$g" +echo "$g" | grep -q '^M=GET P=/echo Q=x=1 B=$' && ok "GET echo body" || bad "GET body" "$g" + +# POST with body. +p=$(curl -s -X POST --data 'hello' "http://127.0.0.1:$PORT/echo") +[ "$p" = 'M=POST P=/echo Q= B=hello' ] && ok "POST body echoed" || bad "POST body" "$p" + +# 404 path. +n=$(curl -s -i "http://127.0.0.1:$PORT/missing" | tr -d '\r') +echo "$n" | grep -q '^HTTP/1.1 404 Not Found' && ok "404 status" || bad "404 status" "$n" +echo "$n" | grep -q '^nope$' && ok "404 body" || bad "404 body" "$n" + +echo "Results: $PASS passed, $FAIL failed" +[ "$FAIL" = 0 ] diff --git a/plans/fed-sx-host-primitives.md b/plans/fed-sx-host-primitives.md index 47c02601..014356ce 100644 --- a/plans/fed-sx-host-primitives.md +++ b/plans/fed-sx-host-primitives.md @@ -132,7 +132,7 @@ check** → tests → commit → tick box → Progress-log line → push. - **Acceptance:** passes; WASM build still links (Sys.readdir is stubbed there). Satisfies fed-sx Step 3 segment replay. -### Phase H — HTTP/1.1 server, **native-only** (`bin/sx_server.ml`) +### Phase H — HTTP/1.1 server, **native-only** (`bin/sx_server.ml`) ✅ DONE - Minimal threaded HTTP/1.1: accept loop (`Unix` + `Thread`), parse request line + headers + body (Content-Length), build an SX request dict `{:method :path :query :headers :body}`, call the SX handler callable, take an @@ -205,6 +205,14 @@ printf '(epoch 1)\n(crypto-sha256 "abc")\n' | \ _Newest first._ +- 2026-05-18 — Phase H: `http-listen` primitive in `bin/sx_server.ml` + (NATIVE ONLY — Unix sockets + Thread per connection, Mutex around + the shared-runtime handler call; HTTP/1.1, Connection: close; + req {:method :path :query :headers :body} → resp {:status :headers + :body}). Test `bin/test_http.sh`: curl GET+query / POST+body / 404 + / custom header — 6/6. NOT in lib, so WASM kernel untouched (boot + green); run_tests 4897 unchanged; Erlang 530/530. Satisfies fed-sx + Milestone 1 Step 8 transport. - 2026-05-18 — Phase G: `file-list-dir` primitive in `lib/sx_primitives.ml` (Sys.readdir → sorted names, no "."/".."; Sys_error prefixed like file-read, msg carries enoent/enotdir).