fed-prims: Phase H — native-only http-listen HTTP/1.1 server + curl test

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>

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] ->