Fix non-streaming HTTP hang on keep-alive; --repl-port bind IP
ober
3e168556e5cfd1f7f37c40e52594aad422950a17
--- a/src/jcode/core/debug-repl.ss +++ b/src/jcode/core/debug-repl.ss @@ -98,9 +98,32 @@ (let ((flags (c-fcntl fd F_GETFL 0))) (c-fcntl fd F_SETFL (bitwise-ior flags O_NONBLOCK)))) -(def (make-sockaddr-in port) - ;; Bind to 127.0.0.1 only (not 0.0.0.0) - (let ((buf (foreign-alloc SOCKADDR_IN_SIZE))) +(def (parse-ipv4 s) + ;; "10.0.0.4" → (10 0 0 4), or #f when malformed. Hand-rolled so this + ;; module keeps zero string-lib dependencies. + (let ((len (string-length s))) + (let loop ((i 0) (cur 0) (digits 0) (octets '())) + (cond + ((= i len) + (and (> digits 0) (<= cur 255) + (let ((all (reverse (cons cur octets)))) + (and (= (length all) 4) all)))) + ((char=? (string-ref s i) #\.) + (and (> digits 0) (<= cur 255) + (loop (+ i 1) 0 0 (cons cur octets)))) + ((and (char>=? (string-ref s i) #\0) + (char<=? (string-ref s i) #\9)) + (and (< digits 3) + (loop (+ i 1) + (+ (* cur 10) (- (char->integer (string-ref s i)) 48)) + (+ digits 1) + octets))) + (else #f))))) + +(def (make-sockaddr-in port . maybe-ip) + ;; Bind address as a 4-octet list; defaults to loopback (not 0.0.0.0) + (let ((ip (if (pair? maybe-ip) (car maybe-ip) '(127 0 0 1))) + (buf (foreign-alloc SOCKADDR_IN_SIZE))) (let lp ((i 0)) (when (< i SOCKADDR_IN_SIZE) (foreign-set! 'unsigned-8 buf i 0) @@ -114,11 +137,11 @@ (#t (foreign-set! 'unsigned-short buf 0 AF_INET))) ;; sin_family (16-bit) (foreign-set! 'unsigned-short buf 2 (c-htons port)) - ;; 127.0.0.1 = bytes 127, 0, 0, 1 at offset 4 - (foreign-set! 'unsigned-8 buf 4 127) - (foreign-set! 'unsigned-8 buf 5 0) - (foreign-set! 'unsigned-8 buf 6 0) - (foreign-set! 'unsigned-8 buf 7 1) + ;; sin_addr octets at offset 4 + (foreign-set! 'unsigned-8 buf 4 (car ip)) + (foreign-set! 'unsigned-8 buf 5 (cadr ip)) + (foreign-set! 'unsigned-8 buf 6 (caddr ip)) + (foreign-set! 'unsigned-8 buf 7 (cadddr ip)) buf)) (def (sockaddr-in-port buf) @@ -227,9 +250,15 @@ ;; ---- Public API ---- (def (start-jcode-repl! . args) - "Start the debug REPL. Pass a port number or 0 for auto-assign." + "Start the debug REPL. (start-jcode-repl! [port [host]]) — port 0 for +auto-assign; host an IPv4 dotted quad to bind, default 127.0.0.1." (stop-jcode-repl!) - (let ((port (if (pair? args) (car args) 0))) + (let* ((port (if (pair? args) (car args) 0)) + (host (and (pair? args) (pair? (cdr args)) (cadr args))) + (ip (if host + (or (parse-ipv4 host) + (error 'start-jcode-repl! "invalid bind IP" host)) + '(127 0 0 1)))) (let ((fd (c-socket AF_INET SOCK_STREAM 0))) (when (< fd 0) (error 'start-jcode-repl! "socket() failed")) @@ -238,8 +267,8 @@ (foreign-set! 'int one 0 1) (c-setsockopt fd SOL_SOCKET SO_REUSEADDR one 4) (foreign-free one)) - ;; Bind to 127.0.0.1 - (let ((addr (make-sockaddr-in port))) + ;; Bind to the requested address (loopback unless told otherwise) + (let ((addr (make-sockaddr-in port ip))) (let ((rc (c-bind fd addr SOCKADDR_IN_SIZE))) (foreign-free addr) (when (< rc 0) @@ -265,7 +294,8 @@ (write-port-file! actual-port) (fork-thread (lambda () (accept-loop fd))) (log-info logger "started" - `((port . ,actual-port))) + `((port . ,actual-port) + (host . ,(or host "127.0.0.1")))) actual-port))))) (def (stop-jcode-repl!) --- a/src/jcode/provider/provider.ss +++ b/src/jcode/provider/provider.ss @@ -207,6 +207,10 @@ (let ((out (open-output-string))) (put-string out (string-append method " " path " HTTP/1.1\r\n")) (put-string out (string-append "Host: " host "\r\n")) + ;; We never reuse connections (fresh tcp-connect per request), so tell + ;; the server to close when done — readers that fall back to read-all + ;; then terminate on EOF instead of hanging on a keep-alive socket. + (put-string out "Connection: close\r\n") (for-each (lambda (h) (put-string out (string-append (car h) ": " (cdr h) "\r\n"))) headers) @@ -421,6 +425,49 @@ (if (eof-object? c) (get-output-string out) (begin (write-char c out) (loop))))))) +;; Read exactly n BYTES from a utf-8 transcoded port. Content-Length is +;; in bytes, not chars, so count each char's encoded length (eol-style is +;; none — see port-read-line's manual \r handling — so no translation +;; distorts the count). +(def (char-utf8-length c) + (let ((cp (char->integer c))) + (cond ((< cp #x80) 1) + ((< cp #x800) 2) + ((< cp #x10000) 3) + (else 4)))) + +(def (port-read-n in n) + (let ((out (open-output-string))) + (let loop ((remaining n)) + (if (<= remaining 0) + (get-output-string out) + (let ((c (read-char in))) + (if (eof-object? c) + (get-output-string out) + (begin + (write-char c out) + (loop (- remaining (char-utf8-length c)))))))))) + +;; Chunked transfer decoding over a textual port (mirrors tls-read-chunked). +(def (port-read-chunked in) + (let ((out (open-output-string))) + (let loop () + (let* ((size-line (or (port-read-line in) "")) + (semi (string-index size-line #\;)) + (hex (if semi (substring size-line 0 semi) size-line)) + (size (string->number (string-trim hex) 16))) + (cond + ((or (not size) (zero? size)) + ;; Drain trailers + final CRLF + (let trailer () + (let ((l (port-read-line in))) + (when (and l (> (string-length l) 0)) (trailer)))) + (get-output-string out)) + (else + (put-string out (port-read-n in size)) + (port-read-line in) ;; trailing CRLF after chunk + (loop))))))) + ;; Generic HTTP POST with JSON body, returns (values status body-string) (def (http-post-json url headers body-json) (let-values (((scheme host port path) (parse-url-parts url))) @@ -452,10 +499,21 @@ (lambda () (void)) (lambda () (port-write-string out req) + ;; Honor Content-Length / chunked like the TLS branch above. + ;; A bare read-all hangs forever on keep-alive servers (e.g. + ;; ollama answers and holds the socket open — no EOF arrives). (let* ((status-line (port-read-line in)) (status (parse-http-status status-line)) (resp-headers (port-read-headers in)) - (body (port-read-all in))) + (cl (assoc "content-length" resp-headers)) + (te (assoc "transfer-encoding" resp-headers)) + (chunked? (and te (string-contains + (string-downcase (cdr te)) + "chunked"))) + (body (cond + (cl (port-read-n in (string->number (cdr cl)))) + (chunked? (port-read-chunked in)) + (else (port-read-all in))))) (values status body))) (lambda () (close-port in) --- a/src/jcode/ui/cli.ss +++ b/src/jcode/ui/cli.ss @@ -16,6 +16,7 @@ :jcode/core/debug-repl :jcode/core/skill :jcode/core/builtin-skills + :jcode/core/agent-defs :jcode/core/checkpoints :jcode/tool/registry :jcode/tool/file @@ -95,10 +96,19 @@ (session-init-db) (init-tools) ;; Start debug REPL only when an explicit port is requested. - (let ((repl-opt (assoc '--repl-port opts))) + (let ((repl-opt (assoc '--repl-port opts)) + (host-opt (assoc '--repl-host opts))) (when repl-opt - (let ((port (start-jcode-repl! (cdr repl-opt)))) - (printf "Debug REPL on port ~a (nc 127.0.0.1 ~a)~n" port port)))) + (let* ((host (and host-opt (cdr host-opt))) + (port (if host + (start-jcode-repl! (cdr repl-opt) host) + (start-jcode-repl! (cdr repl-opt))))) + (printf "Debug REPL on port ~a (nc ~a ~a)~n" + port (or host "127.0.0.1") port) + (when (and host (not (equal? host "127.0.0.1"))) + (fprintf (current-error-port) + "[WARN] debug REPL is an unauthenticated eval socket — binding ~a exposes it beyond loopback~n" + host))))) ;; Apply CLI overrides to agent parameters (let ((p-opt (assoc '--provider opts)) (m-opt (assoc '--model opts))) @@ -137,9 +147,19 @@ ((equal? (car args) "--no-mcp") (loop (cdr args) (cons '(--no-mcp . #t) opts))) ((equal? (car args) "--verbose") (loop (cdr args) (cons '(--verbose . #t) opts))) ((and (equal? (car args) "--repl-port") (pair? (cdr args))) - (let ((p (string->number (cadr args)))) + ;; Accept "PORT" (bind 127.0.0.1, as before) or "IP:PORT" to bind a + ;; specific address, e.g. --repl-port 10.0.0.4:5555 + (let* ((spec (cadr args)) + (colon (string-contains spec ":")) + (host (and colon (substring spec 0 colon))) + (port-str (if colon + (substring spec (+ colon 1) (string-length spec)) + spec)) + (p (string->number port-str))) (if (and p (> p 0) (< p 65536)) - (loop (cddr args) (cons (cons '--repl-port p) opts)) + (loop (cddr args) + (let ((opts (cons (cons '--repl-port p) opts))) + (if host (cons (cons '--repl-host host) opts) opts))) (begin (fprintf (current-error-port) "[ERROR] invalid --repl-port: ~a~n" (cadr args)) (exit 1))))) @@ -201,7 +221,7 @@ OPTIONS: --tui Launch terminal UI mode --no-tui Force line-mode REPL (default) --no-mcp Skip MCP server initialization - --repl-port N Start debug REPL on specific localhost port + --repl-port [IP:]N Start debug REPL (binds 127.0.0.1 unless IP given) --verbose Log TUI events to ~/jcode.log --trace FILE Trace EVERYTHING to FILE: full HTTP requests/responses (API keys redacted), full tool args/results, all log @@ -732,7 +752,7 @@ EXAMPLES: (let ((cmd (string-trim (substring input 1 (string-length input))))) (cond ((equal? cmd "help") - (display "\nCommands:\n /help Show this help\n /model [name] Show or set model\n /provider [name] Show or set provider\n /expert <prompt> Route one prompt to the configured expert model\n /plan Switch to PLAN mode (read-only)\n /build Switch to BUILD mode (read+write)\n /mode Show current mode\n /mcp Toggle MCP tools on/off\n /tools List available tools\n /themes List available TUI themes\n /theme [name] Cycle or switch TUI theme\n /clear Start a new session\n /sessions List saved sessions\n /compact Show message count\n /undo [N] Revert last N checkpoint(s) (default 1)\n /checkpoints List recent shadow-git checkpoints\n /forge [on|off] Show or toggle forge guardrails\n /forge sampling <off|on|strict> Per-model sampling policy\n /forge workflow Describe + self-test the workflow engine\n /forge proxy Describe + self-test the OpenAI-compatible proxy\n /forge ablation Describe + self-test the eval/ablation harness\n /forge verify Describe + self-test the verify-gate (ATLAS verify+repair)\n /forge bestofk Describe + self-test best-of-k diverse-gen (ATLAS Phase-1)\n /forge breaker Describe + self-test the no-progress loop breaker\n /forge run <task> Verify-gated coding on your live model (edit→verify→done)\n /quit Exit\n\nMulti-line: end a line with \\ to continue on the next line.\n\n")) + (display "\nCommands:\n /help Show this help\n /model [name] Show or set model\n /provider [name] Show or set provider\n /expert <prompt> Route one prompt to the configured expert model\n /plan Switch to PLAN mode (read-only)\n /build Switch to BUILD mode (read+write)\n /mode Show current mode\n /mcp Toggle MCP tools on/off\n /tools List available tools\n /agents List named sub-agent roles (task tool)\n /themes List available TUI themes\n /theme [name] Cycle or switch TUI theme\n /clear Start a new session\n /sessions List saved sessions\n /compact Show message count\n /undo [N] Revert last N checkpoint(s) (default 1)\n /checkpoints List recent shadow-git checkpoints\n /forge [on|off] Show or toggle forge guardrails\n /forge sampling <off|on|strict> Per-model sampling policy\n /forge workflow Describe + self-test the workflow engine\n /forge proxy Describe + self-test the OpenAI-compatible proxy\n /forge ablation Describe + self-test the eval/ablation harness\n /forge verify Describe + self-test the verify-gate (ATLAS verify+repair)\n /forge bestofk Describe + self-test best-of-k diverse-gen (ATLAS Phase-1)\n /forge breaker Describe + self-test the no-progress loop breaker\n /forge run <task> Verify-gated coding on your live model (edit→verify→done)\n /quit Exit\n\nMulti-line: end a line with \\ to continue on the next line.\n\n")) ((equal? cmd "model") (printf "Provider: ~a~n" (or (current-provider-override) (config-provider))) (printf "Model: ~a~n" (or (current-model-override) (config-model))) @@ -848,6 +868,22 @@ EXAMPLES: (if (null? file-skills) (printf " (none)~n") (for-each (lambda (n) (printf " ~a~n" n)) file-skills)))) + ((equal? cmd "agents") + (printf "Named agents (task tool `agent` parameter; variants via jcode.json \"agents\"):~n") + (for-each + (lambda (name) + (let ((d (agent-def-lookup name))) + (printf " ~a~n ~a~n model: ~a write scope: ~a~n" + name + (agent-def-description d) + (if (agent-def-model d) + (format "~a~a" + (if (agent-def-provider d) + (string-append (agent-def-provider d) "/") "") + (agent-def-model d)) + "(session default)") + (write-scope-label (agent-def-write-scope d))))) + (agent-def-names))) ((or (equal? cmd "forge") (equal? cmd "forge status")) (forge-print-status)) ((equal? cmd "forge workflow")