coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
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:
giles
2026-05-07 16:50:06 +00:00
parent 64d36fa66e
commit c8b232d40e
3 changed files with 176 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

70
lib/tcl/runtime.sx
View File

@@ -362,8 +362,13 @@
(is-chan
(and
(not (nil? maybe-chan))
(>= (len maybe-chan) 4)
(equal? (slice maybe-chan 0 4) "file"))))
(or
(and
(>= (len maybe-chan) 4)
(equal? (slice maybe-chan 0 4) "file"))
(and
(>= (len maybe-chan) 4)
(equal? (slice maybe-chan 0 4) "sock"))))))
(if
is-chan
(let
@@ -3199,6 +3204,61 @@
(interp args)
(assoc (tcl-event-step interp 0) :result "")))
; ============================================================
; Socket: TCP client and server (Phase 5c)
; ============================================================
; Internal command invoked by the auto-registered fileevent on a server
; channel. Args: (server-chan callback-word ...). Accepts one client and
; calls the user callback with (client-chan peer-host peer-port).
(define
tcl-cmd-_sock-do-accept
(fn
(interp args)
(let
((server-chan (first args)) (cb-parts (rest args)))
(let
((info (socket-accept server-chan)))
(let
((client-chan (get info :channel))
(peer-host (get info :host))
(peer-port (str (get info :port))))
(let
((cmd
(join
" "
(append
cb-parts
(list client-chan peer-host peer-port)))))
(assoc (tcl-eval-string interp cmd) :result "")))))))
; socket host port — TCP client; returns "sockN"
; socket -server cb port — TCP server; auto-fires cb on each accept
(define
tcl-cmd-socket
(fn
(interp args)
(cond
((= 0 (len args)) (error "socket: wrong # args"))
((equal? (first args) "-server")
(if
(< (len args) 3)
(error "socket: usage: socket -server cb port")
(let
((cb (nth args 1)) (port (parse-int (nth args 2))))
(let
((server-chan (socket-server port)))
(let
((handler (str "_sock-do-accept " server-chan " " cb)))
(assoc
(tcl-fileevent-set interp server-chan "readable" handler)
:result server-chan))))))
((= 2 (len args))
(let
((host (first args)) (port (parse-int (nth args 1))))
(assoc interp :result (socket-connect host port))))
(else (error "socket: wrong # args")))))
(define
tcl-cmd-array
@@ -3689,6 +3749,10 @@
((i (tcl-register i "vwait" tcl-cmd-vwait)))
(let
((i (tcl-register i "update" tcl-cmd-update)))
(let
((i (tcl-register i "socket" tcl-cmd-socket)))
(let
((i (tcl-register i "_sock-do-accept" tcl-cmd-_sock-do-accept)))
(let
((i (tcl-register i "file" tcl-cmd-file)))
(let
@@ -3700,4 +3764,4 @@
(tcl-register
i
"array"
tcl-cmd-array)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
tcl-cmd-array)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))