tcl: Phase 5c TCP sockets — client + server
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m4s

Three new SX primitives wrapping Unix socket APIs:
- socket-connect host port → "sockN" (TCP client)
- socket-server ?host? port → "sockN" listening socket (SO_REUSEADDR, backlog 8)
- socket-accept server-chan → {:channel :host :port}

Sockets reuse the channel_table from Phase 5, so existing channel-read/
write/close/select all work on them. Host arg supports localhost,
0.0.0.0, IPv4 literal, or gethostbyname lookup.

Tcl `socket` command:
- socket host port → TCP client
- socket -server cb port → listening socket; auto-registers a fileevent
  on the server channel that fires `_sock-do-accept SRV CB` per readable
  event. _sock-do-accept (internal) accepts the pending client and calls
  the user's callback as `cb client-chan host port`.

puts channel detection now also recognizes "sockN" prefix (was only
"fileN") and dispatches to channel-write.

+4 idiom tests: socket-server-fires-callback, socket-client-server-
roundtrip, socket-server-peer-host, socket-multiple-connections.
358/358 green.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
2026-05-07 16:50:06 +00:00
parent 64d36fa66e
commit c8b232d40e
3 changed files with 176 additions and 3 deletions

View File

@@ -3264,6 +3264,86 @@ let () =
Nil
| _ -> raise (Eval_error "channel-set-blocking!: (channel bool)"));
(* === Sockets === wrapping Unix.socket/connect/bind/listen/accept *)
let resolve_inet_addr host =
if host = "" || host = "0.0.0.0" then Unix.inet_addr_any
else if host = "localhost" then Unix.inet_addr_loopback
else
try Unix.inet_addr_of_string host
with _ ->
try
let entry = Unix.gethostbyname host in
if Array.length entry.Unix.h_addr_list = 0 then
raise (Eval_error ("socket: cannot resolve " ^ host))
else entry.Unix.h_addr_list.(0)
with Not_found -> raise (Eval_error ("socket: cannot resolve " ^ host))
in
let port_of v = match v with
| Integer n -> n
| Number n -> int_of_float n
| _ -> raise (Eval_error "socket: port must be a number")
in
let alloc_chan_name () =
let id = !channel_next_id in
incr channel_next_id;
Printf.sprintf "sock%d" id
in
register "socket-connect" (fun args ->
match args with
| [String host; port_v] ->
let port = port_of port_v in
let addr = Unix.ADDR_INET (resolve_inet_addr host, port) in
let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
(try Unix.connect sock addr
with Unix.Unix_error (e, _, _) ->
(try Unix.close sock with _ -> ());
raise (Eval_error ("socket-connect: " ^ Unix.error_message e)));
let name = alloc_chan_name () in
Hashtbl.replace channel_table name (sock, "rw", ref false, ref true);
String name
| _ -> raise (Eval_error "socket-connect: (host port)"));
register "socket-server" (fun args ->
let (host, port) = match args with
| [port_v] -> ("", port_of port_v)
| [String h; port_v] -> (h, port_of port_v)
| _ -> raise (Eval_error "socket-server: (port) or (host port)")
in
let addr = Unix.ADDR_INET (resolve_inet_addr host, port) in
let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
Unix.setsockopt sock Unix.SO_REUSEADDR true;
(try Unix.bind sock addr
with Unix.Unix_error (e, _, _) ->
(try Unix.close sock with _ -> ());
raise (Eval_error ("socket-server: bind: " ^ Unix.error_message e)));
Unix.listen sock 8;
let name = alloc_chan_name () in
Hashtbl.replace channel_table name (sock, "server", ref false, ref true);
String name);
register "socket-accept" (fun args ->
match args with
| [String name] ->
let (sock, _, _, _) = chan_get name in
let (client_sock, client_addr) =
try Unix.accept sock
with Unix.Unix_error (e, _, _) ->
raise (Eval_error ("socket-accept: " ^ Unix.error_message e))
in
let (host_str, port) = match client_addr with
| Unix.ADDR_INET (addr, p) -> (Unix.string_of_inet_addr addr, p)
| Unix.ADDR_UNIX path -> (path, 0)
in
let client_name = alloc_chan_name () in
Hashtbl.replace channel_table client_name (client_sock, "rw", ref false, ref true);
let d = Hashtbl.create 3 in
Hashtbl.replace d "channel" (String client_name);
Hashtbl.replace d "host" (String host_str);
Hashtbl.replace d "port" (Integer port);
Dict d
| _ -> raise (Eval_error "socket-accept: (server-channel)"));
(* io-select-channels: (read-list write-list timeout-ms) → {:readable [...] :writable [...]}
timeout-ms < 0 → block indefinitely; 0 → poll. Returns ready channel names. *)
register "io-select-channels" (fun args ->