provider+debug-repl: __collect_safe on remaining blocking FFI
ober
9afeb20b1e376f88de927807c68d6d07e81d0f6a
--- a/src/jcode/core/debug-repl.ss +++ b/src/jcode/core/debug-repl.ss @@ -35,7 +35,15 @@ (def c-socket (foreign-procedure "socket" (int int int) int)) (def c-bind (foreign-procedure "bind" (int void* int) int)) (def c-listen (foreign-procedure "listen" (int int) int)) -(def c-accept (foreign-procedure "accept" (int void* void*) int)) +;; accept(2) is __collect_safe so it does not pin Chez's TC mutex while +;; parked in the kernel. Without that, a debug-repl accept thread sleeping +;; in accept() blocks every other green thread (watchdogs, the streaming +;; main loop, etc.), wedging the whole process. The non-blocking flag set +;; by set-nonblocking! masks this most of the time, but if for any reason +;; the syscall does block (e.g. fcntl was rejected silently, or a brief +;; in-kernel wait), the scheduler must keep running. Same pattern as +;; jerboa_tls_read in provider.ss. +(def c-accept (foreign-procedure __collect_safe "accept" (int void* void*) int)) (def c-close (foreign-procedure "close" (int) int)) (def c-setsockopt (foreign-procedure "setsockopt" (int int int void* int) int)) (def c-htons (foreign-procedure "htons" (unsigned-short) unsigned-short)) --- a/src/jcode/provider/provider.ss +++ b/src/jcode/provider/provider.ss @@ -143,19 +143,30 @@ (when body-str (put-string out body-str)) (get-output-string out))) -;; TC-safe rustls read. +;; TC-safe rustls bindings. ;; -;; The std lib's rustls-read uses a plain foreign-procedure that holds the -;; Chez TC mutex during the call. When the read blocks waiting for bytes, -;; no other Scheme thread can run -- so the streaming watchdog in this -;; module never fires and a silent server hangs jcode forever. +;; The std lib's rustls-{read,write,flush,close} are plain foreign-procedure +;; declarations that hold the Chez TC mutex during the call. When any of +;; them block waiting on the kernel (a slow read, a full TCP send buffer, +;; a socket shutdown that races a peer close) no other Scheme thread can +;; run -- so the streaming watchdog in this module never fires and a +;; silent server hangs jcode forever. ;; -;; This binding declares __collect_safe so the scheduler can switch threads -;; while the C side is parked in recv(). Same pattern as the termbox poll -;; binding in src/jcode/ui/tui-ffi.ss. +;; These bindings declare __collect_safe so the scheduler can switch +;; threads while the C side is parked in a syscall. Same pattern as the +;; termbox poll binding in src/jcode/ui/tui-ffi.ss. (def jcode-tls-read (foreign-procedure __collect_safe "jerboa_tls_read" (unsigned-64 u8* unsigned-64) int)) +(def jcode-tls-write + (foreign-procedure __collect_safe "jerboa_tls_write" + (unsigned-64 u8* unsigned-64) int)) +(def jcode-tls-flush + (foreign-procedure __collect_safe "jerboa_tls_flush" + (unsigned-64) int)) +(def jcode-tls-close + (foreign-procedure __collect_safe "jerboa_tls_close" + (unsigned-64) void)) ;; TLS I/O: write full string via rustls (def (tls-write-string conn s) @@ -168,10 +179,10 @@ (bytevector-copy! bv offset c 0 4096) c) (let ((c (make-bytevector remaining))) (bytevector-copy! bv offset c 0 remaining) c))) - (n (rustls-write conn chunk (bytevector-length chunk)))) + (n (jcode-tls-write conn chunk (bytevector-length chunk)))) (when (< n 0) (error 'tls-write-string "TLS write failed")) (loop (+ offset n))))) - (rustls-flush conn))) + (jcode-tls-flush conn))) ;; TLS I/O: read one line (up to \n). Returns string or #f on EOF. (def (tls-read-line conn) @@ -298,7 +309,7 @@ (tls-read-n conn (string->number (cdr cl))) (tls-read-all conn)))) (values status body))) - (lambda () (rustls-close conn)))) + (lambda () (jcode-tls-close conn)))) ;; Plain HTTP via tcp (let-values (((in out) (tcp-connect host port))) (dynamic-wind @@ -339,7 +350,7 @@ (def (close-once!) (unless (vector-ref closed? 0) (vector-set! closed? 0 #t) - (rustls-close conn))) + (jcode-tls-close conn))) ;; Watchdog: closes the connection if no bytes arrive for ;; timeout-secs seconds. Two correctness traps to remember here: ;; @@ -1119,7 +1130,7 @@ (else (tls-read-all-bytes conn)))) (body (utf8->string body-bv))) (values status body))) - (lambda () (rustls-close conn)))) + (lambda () (jcode-tls-close conn)))) (let-values (((in out) (tcp-connect host port))) (dynamic-wind (lambda () (void))