Debug REPL: TLS + token auth for non-loopback binds
ober
10db634b95b5de8a6bb8983451e74fbd3b6356c7
--- a/.gitignore +++ b/.gitignore @@ -39,3 +39,4 @@ jcode.json /jcode-linux-amd64-main.c /jcode-linux-arm64 /jcode-linux-arm64-main.c +.repl-token --- a/Makefile +++ b/Makefile @@ -207,8 +207,17 @@ $(NATIVE_DIR): vendor-clean: rm -rf vendor -gen: vendor-deps purge-stale sqlite-shim sqlite-lib - $(JERBUILD) transpile src lib +# ── Debug-REPL auth token ──────────────────────────────────────────────────── +# Baked into the binary at compile time (compile-time getenv in debug-repl.ss); +# required to connect when --repl-port binds a non-loopback IP. Generated once +# per checkout; delete .repl-token (+ make clean) to rotate. +REPL_TOKEN_FILE ?= .repl-token +$(REPL_TOKEN_FILE): + @head -c 16 /dev/urandom | od -An -tx1 | tr -d ' \n' > $@ + @echo "Generated debug-REPL auth token in $(REPL_TOKEN_FILE)" + +gen: vendor-deps purge-stale sqlite-shim sqlite-lib $(REPL_TOKEN_FILE) + JCODE_REPL_TOKEN=$$(cat $(REPL_TOKEN_FILE)) $(JERBUILD) transpile src lib build: gen native-rs DYLD_LIBRARY_PATH=$(LDPATH) LD_LIBRARY_PATH=$(LDPATH) \ @@ -252,6 +261,7 @@ test-providers: build # .a, and links it all. Per-OS link flags come from --os-libs. binary: gen native-rs DYLD_LIBRARY_PATH=$(LDPATH) LD_LIBRARY_PATH=$(LDPATH) \ + JCODE_REPL_TOKEN=$$(cat $(REPL_TOKEN_FILE)) \ $(JERBUILD) build --config .jerbuild --os-libs "$(JCODE_OS_LIBS)" cp vendor/termbox2/jcode_tui_shim.dylib ./jcode_tui_shim.dylib 2>/dev/null || true cp vendor/termbox2/jcode_tui_shim.so ./jcode_tui_shim.so 2>/dev/null || true @@ -305,7 +315,7 @@ linux-amd64: gen @command -v cargo >/dev/null 2>&1 || { \ echo "ERROR: cargo not found on PATH. Install rustup from rustup.rs"; \ exit 1; } - JERBOA_HOME=$(JERBOA_HOME) TARGET_ARCH=amd64 $(SCHEME) -q --libdirs "$(XC_LIBDIRS)" --script build-jcode-cross.ss + JERBOA_HOME=$(JERBOA_HOME) TARGET_ARCH=amd64 JCODE_REPL_TOKEN=$$(cat $(REPL_TOKEN_FILE)) $(SCHEME) -q --libdirs "$(XC_LIBDIRS)" --script build-jcode-cross.ss @ls -lh jcode-linux-amd64 @file jcode-linux-amd64 @@ -321,7 +331,7 @@ linux-arm64: gen @command -v cargo >/dev/null 2>&1 || { \ echo "ERROR: cargo not found on PATH. Install rustup from rustup.rs"; \ exit 1; } - JERBOA_HOME=$(JERBOA_HOME) TARGET_ARCH=arm64 $(SCHEME) -q --libdirs "$(XC_LIBDIRS)" --script build-jcode-cross.ss + JERBOA_HOME=$(JERBOA_HOME) TARGET_ARCH=arm64 JCODE_REPL_TOKEN=$$(cat $(REPL_TOKEN_FILE)) $(SCHEME) -q --libdirs "$(XC_LIBDIRS)" --script build-jcode-cross.ss @ls -lh jcode-linux-arm64 @file jcode-linux-arm64 --- a/src/jcode/core/debug-repl.ss +++ b/src/jcode/core/debug-repl.ss @@ -98,6 +98,14 @@ (let ((flags (c-fcntl fd F_GETFL 0))) (c-fcntl fd F_SETFL (bitwise-ior flags O_NONBLOCK)))) +(def (set-blocking! fd) + ;; BSD/macOS accepted sockets INHERIT O_NONBLOCK from the listener (Linux + ;; does not). The rust TLS layer maps WouldBlock to 0 — indistinguishable + ;; from EOF — so the TLS path needs a genuinely blocking fd (safe: all its + ;; FFI IO is __collect_safe). + (let ((flags (c-fcntl fd F_GETFL 0))) + (c-fcntl fd F_SETFL (bitwise-and flags (bitwise-not O_NONBLOCK))))) + (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. @@ -149,11 +157,109 @@ (lo (foreign-ref 'unsigned-8 buf 3))) (+ (* hi 256) lo))) +;; ---- Auth token ---- +;; Non-loopback binds require a token. It is baked in at COMPILE time from +;; JCODE_REPL_TOKEN (make sets it from .repl-token), so the deployed binary +;; carries the token with no sidecar file. The expander runs during the +;; build — getenv here reads the BUILD machine's environment. +(define-syntax compile-time-token + (lambda (x) + (syntax-case x () + ((k) + (let ((t (getenv "JCODE_REPL_TOKEN"))) + (if (and t (> (string-length t) 0)) + (datum->syntax #'k t) + #'#f)))))) + +(def *repl-build-token* (compile-time-token)) + +(def (repl-auth-token) + ;; Runtime env override wins (secures a stock binary ad-hoc); falls back + ;; to the build-time token. + (let ((env (getenv "JCODE_REPL_TOKEN"))) + (if (and env (> (string-length env) 0)) env *repl-build-token*))) + +(def (loopback-ip? ip) (= (car ip) 127)) + +(def (token=? a b) + ;; Constant-time-ish compare: XOR-accumulate over the shorter string so + ;; content mismatches don't return early (length still leaks — fine). + (and (string? a) (string? b) + (let ((la (string-length a)) (lb (string-length b))) + (let loop ((i 0) (diff (if (= la lb) 0 1))) + (if (or (= i la) (= i lb)) + (zero? diff) + (loop (+ i 1) + (bitwise-ior diff + (bitwise-xor (char->integer (string-ref a i)) + (char->integer (string-ref b i)))))))))) + +;; ---- TLS (non-loopback transport) ---- +;; Non-loopback binds serve TLS with a self-signed cert generated in-memory +;; at startup (rcgen via jerboa-native). Blocking IO calls declare +;; __collect_safe — same pattern as provider.ss — so a parked read doesn't +;; pin the TC mutex and freeze every other green thread. + +(def c-tls-server-new-pem + (foreign-procedure "jerboa_tls_server_new_pem" + (u8* unsigned-64 u8* unsigned-64) unsigned-64)) +(def c-tls-server-free + (foreign-procedure "jerboa_tls_server_free" (unsigned-64) void)) +(def c-tls-accept + (foreign-procedure __collect_safe "jerboa_tls_accept" + (unsigned-64 int) unsigned-64)) +(def c-tls-read + (foreign-procedure __collect_safe "jerboa_tls_read" + (unsigned-64 u8* unsigned-64) int)) +(def c-tls-write + (foreign-procedure __collect_safe "jerboa_tls_write" + (unsigned-64 u8* unsigned-64) int)) +(def c-tls-close + (foreign-procedure __collect_safe "jerboa_tls_close" + (unsigned-64) void)) +(def c-x509-gen + (foreign-procedure "jerboa_x509_generate_self_signed_mem" + (u8* unsigned-64 int u8* unsigned-64 void* u8* unsigned-64 void*) int)) + +(def (generate-self-signed-pem sans-csv) + ;; → (values cert-pem-bv key-pem-bv); SANs from a comma-separated list + ;; of IPs/hostnames. 825-day validity. + (let ((csv (string->utf8 sans-csv)) + (cert (make-bytevector 8192)) + (key (make-bytevector 8192)) + (cert-len (foreign-alloc 8)) + (key-len (foreign-alloc 8))) + (let ((rc (c-x509-gen csv (bytevector-length csv) 825 + cert (bytevector-length cert) cert-len + key (bytevector-length key) key-len))) + (let ((cl (foreign-ref 'unsigned-64 cert-len 0)) + (kl (foreign-ref 'unsigned-64 key-len 0))) + (foreign-free cert-len) + (foreign-free key-len) + (when (< rc 0) + (error 'start-jcode-repl! "self-signed cert generation failed")) + (let ((c (make-bytevector cl)) (k (make-bytevector kl))) + (bytevector-copy! cert 0 c 0 cl) + (bytevector-copy! key 0 k 0 kl) + (values c k)))))) + +(def (make-repl-tls-ctx host) + ;; Fresh self-signed cert per process start; clients connect with + ;; e.g. `openssl s_client -quiet -connect host:port` (no CA to verify + ;; against — the token gate is the auth; TLS provides wire privacy). + (let-values (((cert key) (generate-self-signed-pem host))) + (let ((ctx (c-tls-server-new-pem cert (bytevector-length cert) + key (bytevector-length key)))) + (when (zero? ctx) + (error 'start-jcode-repl! "TLS server context creation failed")) + ctx))) + ;; ---- State ---- (def *server-fd* #f) (def *server-port* #f) (def *server-running* #f) +(def *server-tls-ctx* #f) (def *repl-port-file* (string-append (or (getenv "HOME") ".") "/.jcode-repl-port")) @@ -175,7 +281,37 @@ ;; ---- Client REPL ---- -(def (client-repl fd) +(def (read-auth-line ip) + ;; Raw line read — tokens are bare strings, not sexps, so jerboa-read + ;; is the wrong tool here. + (let loop ((acc '())) + (let ((c (read-char ip))) + (cond + ((eof-object? c) (and (pair? acc) (list->string (reverse acc)))) + ((char=? c #\newline) (list->string (reverse acc))) + ((char=? c #\return) (loop acc)) + (else (loop (cons c acc))))))) + +(def (auth-ok? ip op token) + ;; First line from the client must be the token. Guard everything: an + ;; I/O error or mismatch = quietly reject (never raise out of the + ;; client thread — an unhandled exception there takes down the process). + (guard (e [#t #f]) + (display "token? " op) + (flush-output-port op) + (let ((line (read-auth-line ip))) + (if (and line (token=? line token)) + #t + (begin + (display "unauthorized\n" op) + (flush-output-port op) + #f))))) + +;; ---- Client transports ---- +;; Both produce (values textual-in textual-out close!) so client-repl is +;; transport-agnostic (plain fd for loopback, TLS for non-loopback). + +(def (fd->repl-ports fd) ;; dup the fd so input and output ports each own a separate descriptor (let* ((write-fd (c-dup fd)) (ip (open-fd-input-port fd (buffer-mode block) @@ -184,9 +320,62 @@ (op (open-fd-output-port write-fd (buffer-mode line) (make-transcoder (utf-8-codec) (eol-style lf) (error-handling-mode replace))))) - (dynamic-wind - void + (values ip op (lambda () + (guard (e [#t (void)]) (close-port ip)) + (guard (e [#t (void)]) (close-port op)))))) + +(def (tls-conn->repl-ports conn) + ;; Wrap a rustls conn handle as transcoded textual ports. The conn owns + ;; the accepted fd (rust TcpStream from_raw_fd) — closing the conn closes + ;; the socket; the closed? flag makes that idempotent across both ports. + (let* ((closed? #f) + (close-conn! + (lambda () + (unless closed? + (set! closed? #t) + (guard (e [#t (void)]) (c-tls-close conn))))) + (bin-in + (make-custom-binary-input-port "tls-repl-in" + (lambda (bv start count) + (if closed? 0 + (let* ((tmp (make-bytevector count)) + (n (c-tls-read conn tmp count))) + (if (<= n 0) 0 ;; EOF or TLS error — either way, stop + (begin (bytevector-copy! tmp 0 bv start n) n))))) + #f #f close-conn!)) + (bin-out + (make-custom-binary-output-port "tls-repl-out" + (lambda (bv start count) + (if closed? count + (let ((tmp (make-bytevector count))) + (bytevector-copy! bv start tmp 0 count) + (let loop ((off 0)) + (if (>= off count) count + (let* ((rem (- count off)) + (chunk (make-bytevector rem))) + (bytevector-copy! tmp off chunk 0 rem) + (let ((n (c-tls-write conn chunk rem))) + (if (< n 0) count ;; conn dead — swallow, reader sees EOF + (loop (+ off n)))))))))) + #f #f close-conn!)) + (ip (transcoded-port bin-in + (make-transcoder (utf-8-codec) (eol-style none) + (error-handling-mode replace)))) + (op (transcoded-port bin-out + (make-transcoder (utf-8-codec) (eol-style lf) + (error-handling-mode replace))))) + (values ip op + (lambda () + (guard (e [#t (void)]) (close-port ip)) + (guard (e [#t (void)]) (close-port op)) + (close-conn!))))) + +(def (client-repl ip op close! token) + (dynamic-wind + void + (lambda () + (when (or (not token) (auth-ok? ip op token)) (let loop () (guard (e [#t (void)]) ;; I/O error — stop (display "jcode> " op) @@ -224,20 +413,34 @@ (newline op))) results) (flush-output-port op))))) - (loop))))))) - (lambda () - (guard (e [#t (void)]) (close-port ip)) - (guard (e [#t (void)]) (close-port op)))))) + (loop)))))))) + (lambda () (close! )))) ;; ---- Accept loop ---- -(def (accept-loop server-fd) +(def (serve-client fd tls-ctx token) + ;; Runs in its own thread. TLS handshake happens lazily inside the rust + ;; conn on first read/write; a plain-TCP client against a TLS listener + ;; just gets a handshake failure → read returns <=0 → thread exits. + (guard (e [#t (log-warn logger "client-error" '())]) + (if tls-ctx + (let ((conn (begin (set-blocking! fd) (c-tls-accept tls-ctx fd)))) + (if (zero? conn) + (begin + (c-close fd) + (log-warn logger "tls-accept-failed" '())) + (let-values (((ip op close!) (tls-conn->repl-ports conn))) + (client-repl ip op close! token)))) + (let-values (((ip op close!) (fd->repl-ports fd))) + (client-repl ip op close! token))))) + +(def (accept-loop server-fd tls-ctx token) (let loop () (when *server-running* (let ((client-fd (c-accept server-fd 0 0))) (cond ((>= client-fd 0) - (fork-thread (lambda () (client-repl client-fd))) + (fork-thread (lambda () (serve-client client-fd tls-ctx token))) (loop)) ((let ((e (get-errno))) (or (= e EINTR) (= e EAGAIN))) (thread-sleep! *retry-delay-secs*) @@ -251,14 +454,23 @@ (def (start-jcode-repl! . args) "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." +auto-assign; host an IPv4 dotted quad to bind, default 127.0.0.1. +Non-loopback binds serve TLS and require the auth token (baked at build +from .repl-token, or JCODE_REPL_TOKEN at runtime)." (stop-jcode-repl!) (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)))) + '(127 0 0 1))) + (remote? (not (loopback-ip? ip))) + (token (and remote? + (or (repl-auth-token) + (error 'start-jcode-repl! + "non-loopback bind requires an auth token: rebuild (make bakes .repl-token) or set JCODE_REPL_TOKEN" + host)))) + (tls-ctx (and remote? (make-repl-tls-ctx host)))) (let ((fd (c-socket AF_INET SOCK_STREAM 0))) (when (< fd 0) (error 'start-jcode-repl! "socket() failed")) @@ -290,12 +502,14 @@ auto-assign; host an IPv4 dotted quad to bind, default 127.0.0.1." (foreign-free len) (set! *server-fd* fd) (set! *server-port* actual-port) + (set! *server-tls-ctx* tls-ctx) (set! *server-running* #t) (write-port-file! actual-port) - (fork-thread (lambda () (accept-loop fd))) + (fork-thread (lambda () (accept-loop fd tls-ctx token))) (log-info logger "started" `((port . ,actual-port) - (host . ,(or host "127.0.0.1")))) + (host . ,(or host "127.0.0.1")) + (tls . ,(if tls-ctx "on" "off")))) actual-port))))) (def (stop-jcode-repl!) @@ -307,6 +521,10 @@ auto-assign; host an IPv4 dotted quad to bind, default 127.0.0.1." (c-close *server-fd*)) (set! *server-fd* #f) (set! *server-port* #f)) + (when *server-tls-ctx* + (guard (e [#t (void)]) + (c-tls-server-free *server-tls-ctx*)) + (set! *server-tls-ctx* #f)) (delete-port-file!))) (def (jcode-repl-port) --- a/src/jcode/ui/cli.ss +++ b/src/jcode/ui/cli.ss @@ -100,15 +100,18 @@ (host-opt (assoc '--repl-host opts))) (when repl-opt (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))))) + (remote? (and host (not (string-prefix? "127." host)))) + (port (guard (e (#t (fprintf (current-error-port) "[ERROR] ") + (display-condition e (current-error-port)) + (fprintf (current-error-port) "~n") + (exit 1))) + (if host + (start-jcode-repl! (cdr repl-opt) host) + (start-jcode-repl! (cdr repl-opt)))))) + (if remote? + (printf "Debug REPL on ~a:~a — TLS + token auth: openssl s_client -quiet -connect ~a:~a (first line = token)~n" + host port host port) + (printf "Debug REPL on port ~a (nc 127.0.0.1 ~a)~n" port port))))) ;; Apply CLI overrides to agent parameters (let ((p-opt (assoc '--provider opts)) (m-opt (assoc '--model opts))) @@ -221,7 +224,7 @@ OPTIONS: --tui Launch terminal UI mode --no-tui Force line-mode REPL (default) --no-mcp Skip MCP server initialization - --repl-port [IP:]N Start debug REPL (binds 127.0.0.1 unless IP given) + --repl-port [IP:]N Debug REPL; non-loopback IP = TLS + token auth (.repl-token) --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 --- a/support/ffi-symbols.list +++ b/support/ffi-symbols.list @@ -64,8 +64,10 @@ jcode_tb_event_y # ── jerboa-native (TLS / rustls) ───────────────────────────────── jerboa_tls_server_new +jerboa_tls_server_new_pem jerboa_tls_server_new_mtls jerboa_tls_server_free +jerboa_x509_generate_self_signed_mem jerboa_tls_accept jerboa_tls_connect jerboa_tls_connect_pinned