serve: add reverse-tunnel mode (relay + connect + serve --connect)
ober
983bb4b527f101b426a1c605997f9cf2505c3db6
--- a/build-binary.ss +++ b/build-binary.ss @@ -135,6 +135,8 @@ "lib/jcode/ui/tui-toast" "lib/jcode/ui/tui-syntax" "lib/jcode/ui/tui" + "lib/jcode/ui/relay" + "lib/jcode/ui/connect" "lib/jcode/ui/cli")) ;; --- Step 0: Clean stale .so files so WPO can recompile everything --- --- a/src/jcode/ui/cli.ss +++ b/src/jcode/ui/cli.ss @@ -24,6 +24,8 @@ :jcode/core/plugin :jcode/ui/tui :jcode/ui/serve + :jcode/ui/relay + :jcode/ui/connect :jerboa/core :jerboa/runtime ;; Use Chez's raw mutex (with-mutex requires it). The prelude's @@ -84,6 +86,8 @@ ((equal? (car rest) "session") (session-command (cdr rest))) ((equal? (car rest) "config") (config-command (cdr rest))) ((equal? (car rest) "serve") (serve-main (cdr rest))) + ((equal? (car rest) "relay") (relay-main (cdr rest))) + ((equal? (car rest) "connect") (connect-main (cdr rest))) (else (one-shot-mode (string-join rest " ") opts))) (close-trace-log!)))) @@ -172,6 +176,15 @@ COMMANDS: VPS / remote control). Token still required. serve --rotate-token Generate new auth token and exit serve --show-token Display current auth token and exit + serve --connect HOST:PORT --register NAME + Reverse-tunnel mode: dial relay on HOST:PORT, + register as NAME, accept controller pairings. + relay --port N Run rendezvous relay (pairs hosts with controllers). + relay --port N --bind ADDR Bind relay to specific address. + relay --rotate-token / --show-token Manage relay token. + connect HOST:PORT --host NAME + Controller mode: dial relay, attach to host NAME, + proxy stdin/stdout (speaks the serve protocol). EXAMPLES: jcode Start interactive session @@ -179,6 +192,9 @@ EXAMPLES: jcode session list List sessions jcode serve --port 8321 Start TCP server for Android app jcode serve --port 8321 --bind 0.0.0.0 Expose on VPS (front with TLS) + jcode relay --port 9001 Run relay on VPS + jcode serve --connect vps:9001 --register laptop Mac dials in + jcode connect vps:9001 --host laptop Phone/CLI talks to laptop ")) (def (interactive-mode opts) new file mode 100644 --- /dev/null +++ b/src/jcode/ui/connect.ss @@ -0,0 +1,156 @@ +;;; jcode connect — controller side of reverse tunnel +;;; +;;; Dials a relay, identifies as controller for HOST, then becomes a +;;; transparent stdin/stdout proxy to the remote `jcode serve` running +;;; on that host. From the controller's perspective the wire after +;;; handshake is identical to a direct TCP `jcode serve --port` session. +;;; +;;; Usage: +;;; jcode connect HOST:PORT --host NAME [--token T] +;;; +;;; If --token is omitted, reads ~/.jcode/relay-token (matches the relay). + +(export connect-main) + +(import :std/text/json + :std/net/tcp + :std/misc/thread + :std/misc/string + :jcode/core/log) + +(def logger (make-logger "connect")) + +;; ── token management (shares relay-token file with relay/host) ──────── + +(def (token-path) + (path-join (or (getenv "HOME") ".") ".jcode" "relay-token")) + +(def (load-token) + (let ((p (token-path))) + (and (file-exists? p) + (call-with-input-file p + (lambda (port) + (let ((s (get-string-all port))) + (and (string? s) (> (string-length s) 0) + (let loop ((i (- (string-length s) 1))) + (cond + ((< i 0) "") + ((char-whitespace? (string-ref s i)) (loop (- i 1))) + (#t (substring s 0 (+ i 1)))))))))))) + +;; ── helpers ─────────────────────────────────────────────────────────── + +(def (split-host:port s) + (let ((i (let loop ((k (- (string-length s) 1))) + (cond + ((< k 0) #f) + ((char=? (string-ref s k) #\:) k) + (#t (loop (- k 1))))))) + (cond + ((not i) + (error 'connect (format "expected HOST:PORT, got ~a" s))) + (#t + (let ((h (substring s 0 i)) + (p (string->number (substring s (+ i 1) (string-length s))))) + (unless (and p (> p 0) (< p 65536)) + (error 'connect (format "invalid port in ~a" s))) + (values h p)))))) + +(def (write-json-line out obj) + (let ((ht (make-hash-table))) + (for-each (lambda (p) (hash-put! ht (car p) (cdr p))) obj) + (display (json-object->string ht) out) + (newline out) + (flush-output-port out))) + +;; ── byte pumps ──────────────────────────────────────────────────────── + +(def (pump-string src-in dst-out) + (let ((buf (make-string 4096))) + (let loop () + (let ((n (get-string-some! src-in buf 0 (string-length buf)))) + (cond + ((eof-object? n) (void)) + ((zero? n) (void)) + (#t + (put-string dst-out buf 0 n) + (flush-output-port dst-out) + (loop))))))) + +;; ── arg parsing ─────────────────────────────────────────────────────── + +(def (parse-connect-args args) + (let loop ((args args) (opts '()) (positional '())) + (cond + ((null? args) (cons (reverse positional) (reverse opts))) + ((and (equal? (car args) "--host") (pair? (cdr args))) + (loop (cddr args) (cons (cons 'host (cadr args)) opts) positional)) + ((and (equal? (car args) "--token") (pair? (cdr args))) + (loop (cddr args) (cons (cons 'token (cadr args)) opts) positional)) + ((string-prefix? "--" (car args)) + (fprintf (current-error-port) + "[ERROR] unknown connect option: ~a~n" (car args)) + (exit 1)) + (#t + (loop (cdr args) opts (cons (car args) positional)))))) + +;; ── main ────────────────────────────────────────────────────────────── + +(def (connect-main args) + (let* ((parsed (parse-connect-args args)) + (positional (car parsed)) + (opts (cdr parsed))) + (when (null? positional) + (fprintf (current-error-port) + "[ERROR] connect requires HOST:PORT (e.g. vps.example.com:9001)~n") + (exit 1)) + (let* ((endpoint (car positional)) + (host-opt (assoc 'host opts)) + (tok-opt (assoc 'token opts)) + (host (and host-opt (cdr host-opt))) + (token (or (and tok-opt (cdr tok-opt)) + (load-token)))) + (unless host + (fprintf (current-error-port) + "[ERROR] --host NAME required (which registered serve to talk to)~n") + (exit 1)) + (unless token + (fprintf (current-error-port) + "[ERROR] no token (pass --token or write ~~/.jcode/relay-token)~n") + (exit 1)) + (let-values (((addr port) (split-host:port endpoint))) + (log-info logger "dial" `((relay . ,endpoint) (host . ,host))) + (let-values (((sin sout) (tcp-connect addr port))) + (try + (write-json-line sout + `(("role" . "controller") ("host" . ,host) ("token" . ,token))) + (let* ((line (get-line sin)) + (obj (and (string? line) (string->json-object line)))) + (cond + ((not obj) + (fprintf (current-error-port) + "[ERROR] relay closed before reply~n") + (exit 2)) + ((not (eq? (hash-ref obj "ok" #f) #t)) + (fprintf (current-error-port) + "[ERROR] relay rejected: ~a~n" + (or (hash-ref obj "error" #f) "unknown")) + (exit 2)) + (#t + (log-info logger "paired" `((host . ,host))) + ;; Pump stdin → socket in a thread, socket → stdout in main. + (let ((t (spawn + (lambda () + (try + (pump-string (current-input-port) sout) + (catch (_) (void))))))) + (try + (pump-string sin (current-output-port)) + (catch (_) (void))) + (try (thread-join! t) (catch (_) (void))))))) + (catch (e) + (fprintf (current-error-port) "[ERROR] connect: ~a~n" (err->string e)) + (exit 2)) + (finally + (try (close-port sin) (catch (_) (void))) + (try (close-port sout) (catch (_) (void)))))))))) new file mode 100644 --- /dev/null +++ b/src/jcode/ui/relay.ss @@ -0,0 +1,319 @@ +;;; jcode relay — VPS-side reverse-tunnel rendezvous +;;; +;;; Pairs an outbound `jcode serve --connect` (host) with an inbound +;;; `jcode connect` (controller) and pumps bytes both directions until +;;; either side closes. +;;; +;;; Wire handshake (one JSON line, terminated by newline, then raw bytes): +;;; +;;; host → relay : {"role":"host","name":"NAME","token":"T"} +;;; relay → host : {"ok":true} ; registered +;;; relay → host : {"controller_connected":true} ; pair started +;;; +;;; controller → relay : {"role":"controller","host":"NAME","token":"T"} +;;; relay → ctrl : {"ok":true} ; raw bytes follow +;;; +;;; After {"ok":true}, the relay is a transparent byte pump. The host then +;;; speaks the existing serve protocol (auth_ok / ready / token / ...); +;;; the controller speaks the existing client protocol (auth / user / ping). +;;; +;;; Single host per NAME, single controller per host (v1). Reject extras. + +(export relay-main) + +(import :std/text/json + :std/net/tcp + :std/misc/thread + :jcode/core/log + (rename (only (chezscheme) make-mutex) + (make-mutex chez-make-mutex))) + +(def logger (make-logger "relay")) + +;; Registry of waiting hosts: name -> (vector in out token). +;; A host sits here after registering, until a controller arrives or it disconnects. +(def *hosts* (make-hash-table)) +(def *hosts-mutex* (chez-make-mutex)) + +;; Set of active pair names so we reject a 2nd controller for the same host. +(def *active-pairs* (make-hash-table)) +(def *pairs-mutex* (chez-make-mutex)) + +(def (host-claim! name in out token) + (with-mutex *hosts-mutex* + (cond + ((hash-ref *hosts* name #f) + #f) ; already registered + (#t + (hash-put! *hosts* name (vector in out token)) + #t)))) + +(def (host-take! name) + (with-mutex *hosts-mutex* + (let ((v (hash-ref *hosts* name #f))) + (when v (hash-remove! *hosts* name)) + v))) + +(def (host-drop! name) + (with-mutex *hosts-mutex* + (hash-remove! *hosts* name))) + +(def (pair-claim! name) + (with-mutex *pairs-mutex* + (cond + ((hash-ref *active-pairs* name #f) #f) + (#t (hash-put! *active-pairs* name #t) #t)))) + +(def (pair-release! name) + (with-mutex *pairs-mutex* + (hash-remove! *active-pairs* name))) + +;; ── token management (mirrors serve.ss) ─────────────────────────────── + +(def (token-path) + (path-join (or (getenv "HOME") ".") ".jcode" "relay-token")) + +(def (load-token) + (let ((p (token-path))) + (and (file-exists? p) + (call-with-input-file p + (lambda (port) + (let ((s (get-string-all port))) + (and (string? s) (> (string-length s) 0) + (let loop ((i (- (string-length s) 1))) + (cond + ((< i 0) "") + ((char-whitespace? (string-ref s i)) (loop (- i 1))) + (#t (substring s 0 (+ i 1)))))))))))) + +(def (random-hex-32) + (let* ((bv (make-bytevector 32 0))) + (call-with-input-file "/dev/urandom" + (lambda (port) + (let loop ((i 0)) + (when (< i 32) + (bytevector-u8-set! bv i (get-u8 port)) + (loop (+ i 1)))))) + (let loop ((i 0) (out '())) + (cond + ((>= i 32) (apply string-append (reverse out))) + (#t + (let ((b (bytevector-u8-ref bv i))) + (loop (+ i 1) + (cons (format "~2,'0X" b) out)))))))) + +(def (ensure-token!) + (or (load-token) + (let ((dir (path-join (or (getenv "HOME") ".") ".jcode"))) + (unless (file-exists? dir) + (mkdir dir)) + (let* ((tok (random-hex-32)) + (path (token-path))) + (call-with-output-file path + (lambda (out) (display tok out))) + (fprintf (current-error-port) + "[INFO] generated new relay token~n") + (fprintf (current-error-port) + "[INFO] token: ~a~n" tok) + (fprintf (current-error-port) + "[INFO] use this on hosts (jcode serve --connect ... --token ...)~n") + (fprintf (current-error-port) + " and controllers (jcode connect ... --token ...).~n") + (flush-output-port (current-error-port)) + tok)))) + +;; ── handshake helpers ───────────────────────────────────────────────── + +(def (read-line-or-error in label) + (let ((line (get-line in))) + (when (eof-object? line) + (error 'relay (format "~a: peer closed before handshake" label))) + line)) + +(def (write-json-line out obj) + (let ((ht (make-hash-table))) + (for-each (lambda (p) (hash-put! ht (car p) (cdr p))) obj) + (display (json-object->string ht) out) + (newline out) + (flush-output-port out))) + +(def (write-ok out) (write-json-line out '(("ok" . #t)))) +(def (write-fail out msg) + (write-json-line out `(("ok" . #f) ("error" . ,msg)))) + +;; ── byte pump ───────────────────────────────────────────────────────── +;; Copies bytes from src-in to dst-out until EOF or error. The pump uses +;; a fixed-size buffer, but binary ports are wrapped in transcoded ports +;; in jerboa's tcp-connect/tcp-accept; we read characters and write them +;; through. Line-buffering on the existing serve protocol is preserved +;; because the underlying TCP doesn't add framing. + +(def (pump src-in dst-out label) + (let ((buf (make-string 4096))) + (let loop () + (let ((n (get-string-some! src-in buf 0 (string-length buf)))) + (cond + ((eof-object? n) (void)) + ((zero? n) (void)) + (#t + (put-string dst-out buf 0 n) + (flush-output-port dst-out) + (loop))))))) + +;; ── connection handlers ─────────────────────────────────────────────── + +(def (handle-host name token-claimed expected-token in out) + (cond + ((not (equal? token-claimed expected-token)) + (write-fail out "bad token") + (log-warn logger "host" `((name . ,name) (msg . "bad token"))) + (try (close-port in) (catch (_) (void))) + (try (close-port out) (catch (_) (void)))) + ((not (host-claim! name in out token-claimed)) + (write-fail out "host name already registered") + (log-warn logger "host" `((name . ,name) (msg . "duplicate registration"))) + (try (close-port in) (catch (_) (void))) + (try (close-port out) (catch (_) (void)))) + (#t + (write-ok out) + (log-info logger "host" `((name . ,name) (msg . "registered, awaiting controller")))))) + +(def (handle-controller name token-claimed expected-token cin cout) + (cond + ((not (equal? token-claimed expected-token)) + (write-fail cout "bad token") + (log-warn logger "ctrl" `((host . ,name) (msg . "bad token"))) + (try (close-port cin) (catch (_) (void))) + (try (close-port cout) (catch (_) (void)))) + ((not (pair-claim! name)) + (write-fail cout "host already paired with another controller") + (log-warn logger "ctrl" `((host . ,name) (msg . "already paired"))) + (try (close-port cin) (catch (_) (void))) + (try (close-port cout) (catch (_) (void)))) + (#t + (let ((hv (host-take! name))) + (cond + ((not hv) + (write-fail cout "no such host registered") + (pair-release! name) + (log-warn logger "ctrl" `((host . ,name) (msg . "no host"))) + (try (close-port cin) (catch (_) (void))) + (try (close-port cout) (catch (_) (void)))) + (#t + (let ((hin (vector-ref hv 0)) + (hout (vector-ref hv 1))) + (write-ok cout) + (write-json-line hout '(("controller_connected" . #t))) + (log-info logger "pair" `((host . ,name) (msg . "paired, pumping"))) + ;; When either pump returns, close the OPPOSITE direction's ports + ;; so the other pump unblocks (read EOFs or write fails). + (let ((t1 (spawn (lambda () + (try (pump cin hout "ctrl->host") (catch (_) (void))) + (try (close-port hin) (catch (_) (void))) + (try (close-port cout) (catch (_) (void)))))) + (t2 (spawn (lambda () + (try (pump hin cout "host->ctrl") (catch (_) (void))) + (try (close-port cin) (catch (_) (void))) + (try (close-port hout) (catch (_) (void))))))) + (try (thread-join! t1) (catch (_) (void))) + (try (thread-join! t2) (catch (_) (void)))) + (pair-release! name) + (log-info logger "pair" `((host . ,name) (msg . "session ended"))) + (try (close-port cin) (catch (_) (void))) + (try (close-port cout) (catch (_) (void))) + (try (close-port hin) (catch (_) (void))) + (try (close-port hout) (catch (_) (void)))))))))) + +(def (handle-connection in out expected-token) + (try + (let* ((line (read-line-or-error in "handshake")) + (obj (string->json-object line)) + (role (hash-ref obj "role" #f)) + (tok (hash-ref obj "token" #f))) + (cond + ((equal? role "host") + (let ((name (hash-ref obj "name" #f))) + (cond + ((or (not (string? name)) (zero? (string-length name))) + (write-fail out "missing name") + (try (close-port in) (catch (_) (void))) + (try (close-port out) (catch (_) (void)))) + (#t (handle-host name tok expected-token in out))))) + ((equal? role "controller") + (let ((name (hash-ref obj "host" #f))) + (cond + ((or (not (string? name)) (zero? (string-length name))) + (write-fail out "missing host") + (try (close-port in) (catch (_) (void))) + (try (close-port out) (catch (_) (void)))) + (#t (handle-controller name tok expected-token in out))))) + (#t + (write-fail out "unknown role") + (try (close-port in) (catch (_) (void))) + (try (close-port out) (catch (_) (void)))))) + (catch (e) + (log-error logger "conn" `((msg . ,(err->string e)))) + (try (close-port in) (catch (_) (void))) + (try (close-port out) (catch (_) (void)))))) + +;; ── arg parsing + main ──────────────────────────────────────────────── + +(def (parse-relay-args args) + (let loop ((args args) (opts '())) + (cond + ((null? args) (reverse opts)) + ((and (equal? (car args) "--port") (pair? (cdr args))) + (let ((p (string->number (cadr args)))) + (if (and p (> p 0) (< p 65536)) + (loop (cddr args) (cons (cons 'port p) opts)) + (begin + (fprintf (current-error-port) "[ERROR] invalid port: ~a~n" (cadr args)) + (exit 1))))) + ((and (equal? (car args) "--bind") (pair? (cdr args))) + (loop (cddr args) (cons (cons 'bind (cadr args)) opts))) + ((equal? (car args) "--rotate-token") + (loop (cdr args) (cons '(rotate-token . #t) opts))) + ((equal? (car args) "--show-token") + (loop (cdr args) (cons '(show-token . #t) opts))) + (#t + (fprintf (current-error-port) "[ERROR] unknown relay option: ~a~n" (car args)) + (exit 1))))) + +(def (relay-main args) + (let ((opts (parse-relay-args args))) + (when (assoc 'rotate-token opts) + (let ((path (token-path))) + (when (file-exists? path) (delete-file path)) + (let ((tok (ensure-token!))) + (fprintf (current-error-port) "[INFO] new relay token: ~a~n" tok) + (flush-output-port (current-error-port)) + (exit 0)))) + (when (assoc 'show-token opts) + (let ((tok (load-token))) + (if tok + (fprintf (current-error-port) "[INFO] relay token: ~a~n" tok) + (fprintf (current-error-port) "[INFO] no relay token (run with --port to generate)~n")) + (flush-output-port (current-error-port)) + (exit 0))) + (let* ((port-opt (or (assoc 'port opts) + (begin + (fprintf (current-error-port) + "[ERROR] relay requires --port N~n") + (exit 1)))) + (bind-opt (assoc 'bind opts)) + (bind-addr (if bind-opt (cdr bind-opt) "0.0.0.0")) + (port-num (cdr port-opt)) + (token (ensure-token!)) + (srv (tcp-listen bind-addr port-num))) + (fprintf (current-error-port) "[INFO] relay listening on ~a:~a~n" + bind-addr (tcp-server-port srv)) + (unless (or (equal? bind-addr "127.0.0.1") (equal? bind-addr "::1")) + (fprintf (current-error-port) + "[WARN] non-loopback bind: handshake & relayed bytes are cleartext.~n") + (fprintf (current-error-port) + " Run behind TLS terminator (caddy/stunnel) or on a private VPN.~n")) + (flush-output-port (current-error-port)) + (let accept-loop () + (let-values (((in out) (tcp-accept srv))) + (spawn (lambda () (handle-connection in out token))) + (accept-loop)))))) --- a/src/jcode/ui/serve.ss +++ b/src/jcode/ui/serve.ss @@ -367,6 +367,98 @@ (emit-error (format "auth error: ~a" (err->string e))) #f)))))) +;; ── reverse-tunnel client (host side) ──────────────────────────────── +;; +;; Dial a relay, register as a host under NAME, wait for a controller to be +;; paired, then run the existing serve-loop on the relay socket. Reconnects +;; with simple backoff if the relay/controller drops. + +(def (relay-token-path) + (path-join (or (getenv "HOME") ".") ".jcode" "relay-token")) + +(def (load-relay-token) + (let ((p (relay-token-path))) + (if (file-exists? p) + (string-trim (read-file-string p)) + #f))) + +(def (split-host:port s) + (let ((i (let loop ((k (- (string-length s) 1))) + (cond + ((< k 0) #f) + ((char=? (string-ref s k) #\:) k) + (#t (loop (- k 1))))))) + (cond + ((not i) + (error 'serve (format "--connect expects HOST:PORT, got ~a" s))) + (#t + (let ((h (substring s 0 i)) + (p (string->number (substring s (+ i 1) (string-length s))))) + (unless (and p (> p 0) (< p 65536)) + (error 'serve (format "invalid port in ~a" s))) + (values h p)))))) + +(def (write-json-line out obj) + (let ((ht (make-hash-table))) + (for-each (lambda (p) (hash-put! ht (car p) (cdr p))) obj) + (display (json-object->string ht) out) + (newline out) + (flush-output-port out))) + +(def (relay-register! sin sout name token) + (write-json-line sout + `(("role" . "host") ("name" . ,name) ("token" . ,token))) + (let* ((line (get-line sin)) + (obj (and (string? line) (string->json-object line)))) + (cond + ((not obj) (error 'serve "relay closed before reply")) + ((not (eq? (hash-ref obj "ok" #f) #t)) + (error 'serve + (format "relay rejected registration: ~a" + (or (hash-ref obj "error" #f) "unknown")))) + (#t (void))))) + +(def (relay-await-controller! sin) + (let* ((line (get-line sin)) + (obj (and (string? line) (string->json-object line)))) + (cond + ((not obj) #f) + ((eq? (hash-ref obj "controller_connected" #f) #t) #t) + (#t #f)))) + +(def (relay-host-loop relay-addr relay-port name relay-token server-token) + (let restart () + (try + (let-values (((sin sout) (tcp-connect relay-addr relay-port))) + (try + (relay-register! sin sout name relay-token) + (fprintf (current-error-port) + "[INFO] registered with relay ~a:~a as ~s, waiting for controller~n" + relay-addr relay-port name) + (flush-output-port (current-error-port)) + (cond + ((not (relay-await-controller! sin)) + (log-warn logger "relay" '((msg . "relay closed before controller"))) + (void)) + (#t + (log-info logger "relay" '((msg . "controller paired, starting serve"))) + (parameterize ((*serve-in* sin) + (*serve-out* sout)) + (set! *current-session* #f) + (set! *session-tokens-in* 0) + (set! *session-tokens-out* 0) + (set! *session-cost* 0.0) + (when (validate-auth! server-token) + (serve-loop))))) + (finally + (try (close-port sin) (catch (_) (void))) + (try (close-port sout) (catch (_) (void)))))) + (catch (e) + (log-warn logger "relay" + `((msg . ,(format "reconnecting in 5s: ~a" (err->string e))))))) + (thread-sleep! 5) + (restart))) + ;; ── TCP server loop ─────────────────────────────────────────────────── (def (tcp-serve-loop bind-addr port-num) @@ -422,6 +514,12 @@ (exit 1))))) ((and (equal? (car args) "--bind") (pair? (cdr args))) (loop (cddr args) (cons (cons 'bind (cadr args)) opts))) + ((and (equal? (car args) "--connect") (pair? (cdr args))) + (loop (cddr args) (cons (cons 'connect (cadr args)) opts))) + ((and (equal? (car args) "--register") (pair? (cdr args))) + (loop (cddr args) (cons (cons 'register (cadr args)) opts))) + ((and (equal? (car args) "--token") (pair? (cdr args))) + (loop (cddr args) (cons (cons 'relay-token (cadr args)) opts))) ((equal? (car args) "--rotate-token") (loop (cdr args) (cons '(rotate-token . #t) opts))) ((equal? (car args) "--show-token") @@ -455,16 +553,38 @@ (t-lsp (spawn init-lsp-tools))) (thread-join! t-mcp) (thread-join! t-lsp)) - ;; Dispatch to TCP or stdio mode - (let ((port-opt (assoc 'port opts)) - (bind-opt (assoc 'bind opts))) - (if port-opt - ;; TCP mode - (let ((bind-addr (if bind-opt (cdr bind-opt) "127.0.0.1"))) - (log-info logger "serve-start" - `((mode . "tcp") (bind . ,bind-addr) (port . ,(cdr port-opt)))) - (tcp-serve-loop bind-addr (cdr port-opt))) - ;; stdio mode (backward compat) - (begin - (log-info logger "serve-start" '((mode . "stdio"))) - (serve-loop)))))) + ;; Dispatch to reverse-tunnel, TCP, or stdio mode + (let ((port-opt (assoc 'port opts)) + (bind-opt (assoc 'bind opts)) + (connect-opt (assoc 'connect opts)) + (reg-opt (assoc 'register opts)) + (rt-opt (assoc 'relay-token opts))) + (cond + (connect-opt + (unless reg-opt + (fprintf (current-error-port) + "[ERROR] --connect requires --register NAME~n") + (exit 1)) + (let-values (((relay-addr relay-port) + (split-host:port (cdr connect-opt)))) + (let ((relay-token (or (and rt-opt (cdr rt-opt)) + (load-relay-token))) + (server-token (ensure-token!)) + (name (cdr reg-opt))) + (unless relay-token + (fprintf (current-error-port) + "[ERROR] no relay token (pass --token or write ~~/.jcode/relay-token)~n") + (exit 1)) + (log-info logger "serve-start" + `((mode . "reverse-tunnel") + (relay . ,(cdr connect-opt)) + (name . ,name))) + (relay-host-loop relay-addr relay-port name relay-token server-token)))) + (port-opt + (let ((bind-addr (if bind-opt (cdr bind-opt) "127.0.0.1"))) + (log-info logger "serve-start" + `((mode . "tcp") (bind . ,bind-addr) (port . ,(cdr port-opt)))) + (tcp-serve-loop bind-addr (cdr port-opt)))) + (#t + (log-info logger "serve-start" '((mode . "stdio"))) + (serve-loop))))))