security: proxy loopback-only bind + token auth + request caps (P0)

ober

6ed7a3cc9aded8db543b90207de9bb0bf0f69e34

diff --git a/src/jcode/proxy/server.ss b/src/jcode/proxy/server.ss
index 1995116..f4f7fc5 100644
--- a/src/jcode/proxy/server.ss
+++ b/src/jcode/proxy/server.ss
@@ -18,13 +18,17 @@
 
 (export proxy-dispatch
         make-presp presp? presp-status presp-content-type presp-body
-        sse-body proxy-serve make-provider-backend)
+        sse-body proxy-serve make-provider-backend
+        proxy-authorized? proxy-handle-request proxy-content-length-ok?
+        *proxy-max-body-bytes* *proxy-max-header-count*)
 
 (import :std/text/json
         :std/net/tcp
         :std/misc/string
+        (only (std crypto random) random-token)
         :jcode/core/message
         :jcode/core/workflow
+        :jcode/core/remote-auth
         :jcode/provider/provider
         :jcode/proxy/handler)
 
@@ -34,7 +38,7 @@
 ;; ── response builders ────────────────────────────────────────────────
 
 (def *reason-phrases*
-  '((200 . "OK") (400 . "Bad Request") (404 . "Not Found")
+  '((200 . "OK") (400 . "Bad Request") (401 . "Unauthorized") (404 . "Not Found")
     (405 . "Method Not Allowed") (500 . "Internal Server Error")))
 
 (def (reason-phrase code)
@@ -81,6 +85,32 @@
       ((and (condition? e) (message-condition? e)) (condition-message e))
       (else (call-with-string-output-port (lambda (p) (display-condition e p)))))))
 
+;; ── request limits + auth ─────────────────────────────────────────────
+;; A client-declared Content-Length used to allocate that many characters
+;; up front (OOM); bound it and the header count instead.
+
+(def *proxy-max-body-bytes*   (* 32 1024 1024))
+(def *proxy-max-header-count* 100)
+
+(def (proxy-content-length-ok? n)
+  (and (number? n) (exact? n) (<= 0 n *proxy-max-body-bytes*)))
+
+(def (proxy-authorized? auth-header token)
+  "Constant-time check of an `Authorization: Bearer <token>` header against
+   the expected TOKEN. #f token means auth is required but unset → reject."
+  (and (string? token) (string? auth-header)
+       (string-prefix? "Bearer " auth-header)
+       (remote-auth-proof=?
+         (substring auth-header 7 (string-length auth-header))
+         token)))
+
+(def (proxy-handle-request method path body auth-header token backend)
+  "Auth-gate then route. Pure (no socket I/O) so the auth boundary is
+   unit-testable: an unauthenticated request yields a 401, never the router."
+  (if (proxy-authorized? auth-header token)
+    (proxy-dispatch method path body backend)
+    (error-resp 401 "unauthorized")))
+
 ;; ── routing core (pure: no socket I/O — unit-testable) ────────────────
 
 (def (proxy-dispatch method path body backend)
@@ -136,6 +166,13 @@
                                 (string-length line))))
       #f)))
 
+(def (parse-authorization line)
+  (let ((low (string-downcase line)))
+    (if (string-prefix? "authorization:" low)
+      (string-trim (substring line (string-length "authorization:")
+                              (string-length line)))
+      #f)))
+
 (def (read-n-chars in n)
   (let loop ((acc '()) (remaining n))
     (if (<= remaining 0)
@@ -146,21 +183,31 @@
           (loop (cons chunk acc) (- remaining (string-length chunk))))))))
 
 (def (read-http-request in)
-  "Read one HTTP request from IN. Returns (method path body) or #f on EOF."
+  "Read one HTTP request from IN. Returns (method path body auth-header), or
+   #f on EOF or when the header count / declared body size exceed the caps
+   (checked BEFORE allocating the body, so a hostile Content-Length cannot
+   force an unbounded allocation)."
   (let ((reqline (get-line in)))
     (if (eof-object? reqline)
       #f
       (let* ((parts  (split-spaces (strip-cr reqline)))
              (method (if (pair? parts) (car parts) ""))
              (path   (if (and (pair? parts) (pair? (cdr parts))) (cadr parts) "")))
-        (let hloop ((clen 0))
-          (let ((line (get-line in)))
-            (cond
-              ((eof-object? line) (list method path ""))
-              ((string=? (strip-cr line) "")
-               (list method path (if (> clen 0) (read-n-chars in clen) "")))
-              (else
-               (hloop (or (parse-content-length (strip-cr line)) clen))))))))))
+        (let hloop ((clen 0) (auth #f) (hcount 0))
+          (cond
+            ((> hcount *proxy-max-header-count*) #f)
+            ((not (proxy-content-length-ok? clen)) #f)
+            (else
+             (let ((line (get-line in)))
+               (cond
+                 ((eof-object? line) (list method path "" auth))
+                 ((string=? (strip-cr line) "")
+                  (list method path (if (> clen 0) (read-n-chars in clen) "") auth))
+                 (else
+                  (let ((sl (strip-cr line)))
+                    (hloop (or (parse-content-length sl) clen)
+                           (or auth (parse-authorization sl))
+                           (+ hcount 1)))))))))))))
 
 (def (write-http-response out resp)
   (let* ((status (presp-status resp))
@@ -179,26 +226,47 @@
   (guard (e [else (void)])
     (close-port port)))
 
-(def (proxy-serve bind-addr port backend)
+(def proxy-serve
+  (case-lambda
+    ((bind-addr port backend)
+     (proxy-serve/bind bind-addr port backend #f #f))
+    ((bind-addr port backend insecure?)
+     (proxy-serve/bind bind-addr port backend #f insecure?))
+    ((bind-addr port backend token insecure?)
+     (proxy-serve/bind bind-addr port backend token insecure?))))
+
+(def (proxy-serve/bind bind-addr port backend token insecure?)
   "Listen on BIND-ADDR:PORT and serve OpenAI chat-completions through BACKEND.
-   Sequential accept loop — one request at a time (single-slot serialization)."
-  (let ((srv (tcp-listen bind-addr port)))
-    (fprintf (current-error-port) "[INFO] proxy listening on ~a:~a~n"
-             bind-addr (tcp-server-port srv))
-    (flush-output-port (current-error-port))
-    (let accept-loop ()
-      (let-values (((in out) (tcp-accept srv)))
-        (guard (e [else
-                    (fprintf (current-error-port) "[WARN] proxy request failed: ~a~n"
-                             (condition->msg e))])
-          (let ((req (read-http-request in)))
-            (write-http-response out
-              (if req
-                (proxy-dispatch (car req) (cadr req) (caddr req) backend)
-                (error-resp 400 "bad request")))))
-        (best-effort-close-port! in)
-        (best-effort-close-port! out)
-        (accept-loop)))))
+   Sequential accept loop — one request at a time (single-slot serialization).
+
+   Security: binds loopback only unless INSECURE? is true (a 0.0.0.0 bind
+   exposes agent/tool execution to the network), and every request must carry
+   a matching `Authorization: Bearer <token>` header. A token is generated and
+   printed when none is supplied, so the proxy is never unauthenticated."
+  (unless (or insecure? (remote-loopback-endpoint? bind-addr))
+    (error 'proxy-serve
+      "refusing non-loopback bind ~a: the proxy authenticates with a local token only; pass insecure? to override"
+      bind-addr))
+  (let ((token (or token (random-token 32))))
+    (fprintf (current-error-port) "[INFO] proxy auth token: ~a~n" token)
+    (let ((srv (tcp-listen bind-addr port)))
+      (fprintf (current-error-port) "[INFO] proxy listening on ~a:~a (token auth required)~n"
+               bind-addr (tcp-server-port srv))
+      (flush-output-port (current-error-port))
+      (let accept-loop ()
+        (let-values (((in out) (tcp-accept srv)))
+          (guard (e [else
+                      (fprintf (current-error-port) "[WARN] proxy request failed: ~a~n"
+                               (condition->msg e))])
+            (let ((req (read-http-request in)))
+              (write-http-response out
+                (if req
+                  (proxy-handle-request (car req) (cadr req) (caddr req)
+                                        (cadddr req) token backend)
+                  (error-resp 400 "bad request")))))
+          (best-effort-close-port! in)
+          (best-effort-close-port! out)
+          (accept-loop))))))
 
 ;; ── provider-backed BACKEND adapter ───────────────────────────────────
 ;; Wraps a jcode provider as the (messages tool-specs sampling) -> response
diff --git a/src/jcode/ui/cli.ss b/src/jcode/ui/cli.ss
index b9080fd..7bb0eda 100644
--- a/src/jcode/ui/cli.ss
+++ b/src/jcode/ui/cli.ss
@@ -747,7 +747,7 @@ EXAMPLES:
 
 ;; `jcode proxy` — serve the configured provider behind the guardrail proxy.
 (def (proxy-main args)
-  (let loop ((args args) (port 8080) (bind "127.0.0.1"))
+  (let loop ((args args) (port 8080) (bind "127.0.0.1") (insecure? #f))
     (cond
       ((null? args)
        (let ((backend (make-provider-backend (get-current-provider))))
@@ -755,16 +755,18 @@ EXAMPLES:
            "[INFO] guardrail proxy for provider ~a~n"
            (or (current-provider-override) (config-provider)))
          (flush-output-port (current-error-port))
-         (proxy-serve bind port backend)))
+         (proxy-serve bind port backend insecure?)))
       ((and (equal? (car args) "--port") (pair? (cdr args)))
        (let ((p (string->number (cadr args))))
          (if (and p (> p 0) (< p 65536))
-           (loop (cddr args) p bind)
+           (loop (cddr args) p bind insecure?)
            (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) port (cadr args)))
+       (loop (cddr args) port (cadr args) insecure?))
+      ((equal? (car args) "--insecure")
+       (loop (cdr args) port bind #t))
       (else
        (fprintf (current-error-port) "[ERROR] unknown proxy option: ~a~n" (car args))
        (exit 1)))))
diff --git a/test/security-regression.ss b/test/security-regression.ss
index df78fe1..7abae68 100644
--- a/test/security-regression.ss
+++ b/test/security-regression.ss
@@ -7,6 +7,7 @@
         (jcode core remote-auth)
         (jcode core plugin)
         (jcode core mentions)
+        (jcode proxy server)
         (std misc ports)
         (std misc string)
         (std net tcp))
@@ -205,6 +206,30 @@
          "credential-sentinel")))
 (putenv "HOME" mention-saved-home)
 
+;; ── (c) proxy unauthenticated bind ────────────────────────────────────
+(define proxy-backend (lambda args #f))
+(check "proxy refuses non-loopback bind (0.0.0.0) by default"
+  (refused? (lambda () (proxy-serve "0.0.0.0" 0 proxy-backend))))
+(check "proxy refuses non-loopback bind (public ip) by default"
+  (refused? (lambda () (proxy-serve "192.168.1.50" 0 proxy-backend))))
+(check "proxy rejects missing Authorization"
+  (not (proxy-authorized? #f "secret-token")))
+(check "proxy rejects wrong bearer token"
+  (not (proxy-authorized? "Bearer wrong-token" "secret-token")))
+(check "proxy accepts valid bearer token"
+  (proxy-authorized? "Bearer secret-token" "secret-token"))
+(check "unauthenticated proxy request yields 401"
+  (= 401 (presp-status
+           (proxy-handle-request "GET" "/health" "" #f "secret-token" proxy-backend))))
+(check "authenticated proxy request routes to 200"
+  (= 200 (presp-status
+           (proxy-handle-request "GET" "/health" "" "Bearer secret-token"
+                                 "secret-token" proxy-backend))))
+(check "proxy rejects oversized Content-Length"
+  (not (proxy-content-length-ok? 999999999999)))
+(check "proxy accepts bounded Content-Length"
+  (proxy-content-length-ok? 1024))
+
 (when (> failures 0)
   (error 'security-regression (format "~a security regression test(s) failed" failures)))
 (printf "Security regressions passed~n")