Resolve allow-proxy targets safely
ober
046cfb8055c2dc1266e942f74d55331a5e62c0e0
--- a/docs/limits-followup.md +++ b/docs/limits-followup.md @@ -1,7 +1,7 @@ # Limits Follow-Up: Missing Enforcement and Test Work Reviewed: 2026-05-21 -Status updated: 2026-05-22 (tracefs fd/cwd state phase) +Status updated: 2026-05-22 (allow-proxy DNS/recheck phase) This document is a follow-up to `docs/limits.md` after reviewing the new limits/sandbox/audit module set added around commit `97eea41`. @@ -22,7 +22,7 @@ backend-specific filesystem and network denial tests are still needed. | 3 | Resource limits | SAFE PARTIAL — requested-limit plans and child install reports are per-kind; `require: '(limits)` fails closed before exec; parent-side time/output markers exist; **GAP**: cgroup v2 | | 4 | Executable identity | DONE — path search, realpath/stat identity, comparison helper, and TOCTOU caveat are present | | 5 | Filesystem tracing | SAFE PARTIAL — `tracefs-capabilities`, fail-closed wrapper, normalized `fs-event` output, best-effort fd/cwd tracking, and generic read/write/exec suggestions exist; **GAP**: native backends and deeper Linux traced-run tests | -| 6 | Network allowlist | DONE for decision layer — IP literals and localnet ranges are denied before wildcard matching; **GAP**: DNS recheck + child network sandbox/proxy handoff | +| 6 | Network allowlist | SAFE PARTIAL — reusable decision layer, parent-side DNS resolution, resolved-address localnet recheck, structured proxy events, and binary CONNECT tunneling exist; **GAP**: child network sandbox/proxy handoff and direct-network denial tests | | 7 | Environment/secrets | DONE — default deny policy, argv validation, env construction, and redaction helpers exist | | 8 | Temp HOME/cache | DONE for helper layer — fake HOME, scratch/cache grants, env overrides, cleanup, and sandbox grant helper exist | | 9 | Structured audit model | PARTIAL — event constructors and redaction exist; **GAP**: full integration from all primitives | @@ -61,7 +61,7 @@ make test # includes tests/test-limits-primitives.ss /Users/user/mine/jerboa/.chez/bin/scheme --libdirs lib --script tests/test-limits-primitives.ss -# 58 passed, 0 failed, 0 skipped +# 88 passed, 0 failed, 0 skipped ``` ## Required Standard Before Calling This Done @@ -308,12 +308,18 @@ Implemented: - host:port pattern matching with exact, `*`, and `**` host wildcards. - allow/deny counters and logger callback. - Hard denial of IP literals and localnet ranges before wildcard matching. +- Trusted-parent DNS resolution via `(std net address)`. +- Resolved-address recheck for loopback, link-local, private, multicast, and + other local ranges before connecting. +- `allow-proxy-connect-decision`, which returns a reusable alist with + `allowed`, `host`, `port`, `pattern`, `resolved-host`, `connect-host`, and + `reason` fields for shell/app integration. +- Binary CONNECT handling with structured allow, deny, DNS/connect-failure, + and malformed-request events. Critical missing security requirements: -- No DNS resolution in the trusted parent followed by deny-range rechecking. - No optional SOCKS5 proxy. -- No structured network audit event type. - No integration with a child sandbox that denies all outbound network except the local proxy endpoint. @@ -322,19 +328,18 @@ Observed behavior after the decision-layer hardening: - With an allowlist of `*:443`, normal hosts such as `example.com:443` are accepted, while `127.0.0.1:443`, `10.0.0.1:443`, and cloud-metadata style link-local addresses are denied before wildcard matching. +- With an allowlist of `localhost:443`, the proxy decision resolves + `localhost` to `127.0.0.1` and denies it unless `allow-localnet?: #t` is + explicitly set. Required next work: -1. Add proxy policy fields: - - `deny-ip-literals?` - - `deny-localnet?` - - `allow-localhost-proxy-only?` -2. Parse host literals, bracketed IPv6 literals, and plain IPv4 literals. -3. Resolve DNS in the proxy before connecting. -4. Reject resolved addresses in loopback, link-local, private, multicast, and - other local ranges unless explicitly allowed. -5. Emit structured events for allowed, denied, DNS failure, and connect failure. -6. Add tests for: +1. Wire callers such as `jsh` to launch children with direct outbound network + denied and only the local proxy endpoint permitted. +2. Add backend-specific network denial tests that prove raw child connects fail + while allowed proxy CONNECT targets succeed. +3. Add optional SOCKS5 proxy support if non-HTTP tools need first-class support. +4. Add deeper proxy tests for: - exact allow - wildcard allow - denied host @@ -456,6 +461,7 @@ Current coverage: - `exec-id-resolve` path, symlink, missing, hash. - `tracefs-parse-strace` for basic syscalls. - `allow-proxy-host-allowed?` exact, wildcard, localnet denial. +- `allow-proxy-connect-decision` DNS resolution and resolved-localnet denial. - `env-policy-build` strips denied vars and injects explicit secrets. - `temp-home` cleanup and env overrides. - `audit-log` redaction and JSONL validity. @@ -465,7 +471,7 @@ Current coverage: 1. Add backend-specific filesystem and network denial tests for `(std os limits sandbox)`. 2. Add cgroup v2 support where a delegated controller is available. -3. Fix allow-proxy DNS recheck and proxy handoff. +3. Wire child network sandbox/proxy handoff in callers. 4. Wire audit-log into the primitives. 5. Expand tracefs from a parser prototype into a real traced-run API. --- a/lib/std/net/address.ss +++ b/lib/std/net/address.ss @@ -79,12 +79,91 @@ (not (ipv4? str)) (not (ipv6? str)))) + (def (string-contains? s sub) + (let ([sl (string-length s)] [bl (string-length sub)]) + (and (>= sl bl) + (let lp ([i 0]) + (cond + [(> (+ i bl) sl) #f] + [(string=? sub (substring s i (+ i bl))) #t] + [else (lp (+ i 1))]))))) + ;; ========== Resolution ========== + (def _libc-loaded + (let ((v (getenv "JERBOA_STATIC"))) + (if (and v (not (string=? v "")) (not (string=? v "0"))) + #f + (load-shared-object #f)))) + + (def c-getaddrinfo + (foreign-procedure "getaddrinfo" (string string void* void*) int)) + (def c-freeaddrinfo + (foreign-procedure "freeaddrinfo" (void*) void)) + (def c-inet-ntop + (foreign-procedure "inet_ntop" (int void* u8* int) void*)) + + (def AF_INET 2) + (def SOCK_STREAM 1) + (def INET_ADDRSTRLEN 16) + + ;; struct addrinfo layout differs by OS: + ;; macOS / BSD: 32 (ai_canonname before ai_addr) + ;; Linux glibc: 24 (ai_addr before ai_canonname) + (def ai-addr-offset + (let ([mt (symbol->string (machine-type))]) + (cond + [(or (string-contains? mt "osx") + (string-contains? mt "darwin") + (string-contains? mt "fb") + (string-contains? mt "ob") + (string-contains? mt "nb")) + 32] + [else 24]))) + (def (resolve-hostname host) - ;; Placeholder: returns host as-is. - ;; Full implementation would use getaddrinfo FFI. - host) + ;; Resolve HOST to an IPv4 address string. Literal IPv4 addresses are + ;; returned as-is; localhost maps to loopback without invoking DNS. + (cond + [(or (string=? host "localhost") (string=? host "")) "127.0.0.1"] + [(ipv4? host) host] + [(ipv6? host) host] + [else (resolve-hostname/blocking host)])) + + (def (resolve-hostname/blocking host) + (let ([hints (foreign-alloc 48)]) + (do ([i 0 (+ i 1)]) ((= i 48)) + (foreign-set! 'unsigned-8 hints i 0)) + (foreign-set! 'int hints 4 AF_INET) + (foreign-set! 'int hints 8 SOCK_STREAM) + (let ([result-ptr (foreign-alloc 8)]) + (foreign-set! 'void* result-ptr 0 0) + (let ([rc (c-getaddrinfo host #f hints result-ptr)]) + (foreign-free hints) + (cond + [(not (= rc 0)) + (foreign-free result-ptr) + (error 'resolve-hostname "DNS resolution failed" host rc)] + [else + (let ([result (foreign-ref 'void* result-ptr 0)]) + (foreign-free result-ptr) + (if (= result 0) + (error 'resolve-hostname "no IPv4 address found" host) + (let ([addr-ptr (foreign-ref 'void* result ai-addr-offset)]) + (let ([in-addr-ptr (+ addr-ptr 4)] + [buf (make-bytevector INET_ADDRSTRLEN)]) + (let ([p (c-inet-ntop AF_INET in-addr-ptr buf + INET_ADDRSTRLEN)]) + (c-freeaddrinfo result) + (if (= p 0) + (error 'resolve-hostname "inet_ntop failed" host) + (let lp ([i 0]) + (if (= (bytevector-u8-ref buf i) 0) + (utf8->string + (let ([b (make-bytevector i)]) + (bytevector-copy! buf 0 b 0 i) + b)) + (lp (+ i 1))))))))))]))))) ;; ========== Helpers ========== --- a/lib/std/net/allow-proxy.ss +++ b/lib/std/net/allow-proxy.ss @@ -52,6 +52,7 @@ allow-proxy-host-allowed? allow-proxy-host-denial-reason + allow-proxy-connect-decision make-allow-proxy-policy allow-proxy-event @@ -68,8 +69,10 @@ net-allowlist-split-host-port net-allowlist-host-allowed? net-allowlist-host-denial-reason) + (only (std net address) + resolve-hostname) (only (std net tcp) - tcp-listen tcp-accept tcp-close tcp-connect + tcp-listen tcp-accept-binary tcp-close tcp-connect-binary tcp-server-port)) ;; ---------- Record ---------- @@ -163,13 +166,76 @@ (allow-proxy-rec-allow-ip-literals? p) (allow-proxy-rec-allow-localnet? p))) + (def (alist-get key xs fallback) + (let ([cell (assq key xs)]) + (if cell (cdr cell) fallback))) + + (def (allow-proxy-connect-decision p host port) + ;; Full proxy decision for a requested CONNECT target. This extends the + ;; decision-only allowlist check with trusted-parent DNS resolution and a + ;; post-resolution localnet deny check. Returns an alist: + ;; ((allowed . #t) ... (connect-host . "93.184.216.34")) + ;; or + ;; ((allowed . #f) ... (reason . localnet-symbol)) + (let ([pattern (allow-proxy-host-allowed? p host port)]) + (cond + [(not pattern) + (let ([reason (or (allow-proxy-host-denial-reason p host port) + 'not-in-allowlist)]) + (let ([resolved + (and (not (host-is-ipv4-literal? host)) + (not (host-is-ipv6-literal? host)) + (try (resolve-hostname host) + (catch (e) #f)))]) + (let ([base (list (cons 'allowed #f) + (cons 'host host) + (cons 'port port) + (cons 'reason reason))]) + (if resolved + (cons (cons 'resolved-host resolved) base) + base))))] + [else + (let ([resolved + (try (resolve-hostname host) + (catch (e) #f))]) + (cond + [(not resolved) + (list (cons 'allowed #f) + (cons 'host host) + (cons 'port port) + (cons 'pattern pattern) + (cons 'reason 'dns-failed))] + [(and (host-is-localnet? resolved) + (not (allow-proxy-rec-allow-localnet? p))) + (list (cons 'allowed #f) + (cons 'host host) + (cons 'port port) + (cons 'pattern pattern) + (cons 'resolved-host resolved) + (cons 'reason (host-is-localnet? resolved)))] + [(and (host-is-ipv6-literal? resolved) + (not (host-is-ipv4-literal? resolved))) + (list (cons 'allowed #f) + (cons 'host host) + (cons 'port port) + (cons 'pattern pattern) + (cons 'resolved-host resolved) + (cons 'reason 'ipv6-unsupported))] + [else + (list (cons 'allowed #t) + (cons 'host host) + (cons 'port port) + (cons 'pattern pattern) + (cons 'resolved-host resolved) + (cons 'connect-host resolved))]))]))) + ;; ---------- Structured event constructor ---------- (def (allow-proxy-event kind . opts) ;; Returns an alist suitable for the logger callback and audit ;; integration. Kinds: 'allow 'deny 'connect-failed 'dns-failed ;; 'malformed. Recognised options: host: port: reason: pattern: - ;; bytes-in: bytes-out: error:. + ;; resolved-host: connect-host: bytes-in: bytes-out: error:. (let ([acc (list (cons 'kind kind))]) (let lp ([xs opts]) (cond @@ -182,6 +248,8 @@ [(port:) (set! acc (cons (cons 'port v) acc))] [(reason:) (set! acc (cons (cons 'reason v) acc))] [(pattern:) (set! acc (cons (cons 'pattern v) acc))] + [(resolved-host:)(set! acc (cons (cons 'resolved-host v) acc))] + [(connect-host:) (set! acc (cons (cons 'connect-host v) acc))] [(bytes-in:) (set! acc (cons (cons 'bytes-in v) acc))] [(bytes-out:) (set! acc (cons (cons 'bytes-out v) acc))] [(error:) (set! acc (cons (cons 'error v) acc))] @@ -228,7 +296,7 @@ (when (allow-proxy-rec-running? p) (let ([accepted (try - (let-values ([(in out) (tcp-accept srv)]) + (let-values ([(in out) (tcp-accept-binary srv)]) (cons in out)) (catch (e) #f))]) (cond @@ -265,16 +333,21 @@ (log! p `(deny (reason . not-connect) (line . ,line))) (bump! p 'denied) (close-pair in out)] - [(not (allow-proxy-host-allowed? p host port)) - (let ([reason (or (allow-proxy-host-denial-reason p host port) - 'not-in-allowlist)]) - (write-status out 403 "host not in allowlist") - (log! p (allow-proxy-event 'deny - 'host: host 'port: port 'reason: reason))) - (bump! p 'denied) - (close-pair in out)] [else - (tunnel p in out host port)]))]))) + (let ([decision (allow-proxy-connect-decision p host port)]) + (cond + [(not (alist-get 'allowed decision #f)) + (let ([reason (alist-get 'reason decision 'not-in-allowlist)]) + (write-status out 403 "host not in allowlist") + (log! p (allow-proxy-event 'deny + 'host: host 'port: port 'reason: reason + 'pattern: (alist-get 'pattern decision #f) + 'resolved-host: + (alist-get 'resolved-host decision #f)))) + (bump! p 'denied) + (close-pair in out)] + [else + (tunnel p in out host port decision)]))]))]))) (def (close-pair in out) (try (close-port in) (catch (e) #f)) @@ -282,21 +355,21 @@ (def (read-line-textual port) ;; Read until CRLF or LF. Returns string without terminator. - (let ([acc (open-output-string)]) + (let-values ([(acc extract) (open-bytevector-output-port)]) (let lp () - (let ([c (get-char port)]) + (let ([b (get-u8 port)]) (cond - [(eof-object? c) - (let ([s (get-output-string acc)]) + [(eof-object? b) + (let ([s (utf8->string (extract))]) (if (= 0 (string-length s)) #f s))] - [(char=? c #\newline) (get-output-string acc)] - [(char=? c #\return) - (let ([n (get-char port)]) - (unless (or (eof-object? n) (char=? n #\newline)) - (write-char n acc)) - (get-output-string acc))] + [(= b 10) (utf8->string (extract))] + [(= b 13) + (let ([n (get-u8 port)]) + (unless (or (eof-object? n) (= n 10)) + (put-u8 acc n)) + (utf8->string (extract)))] [else - (write-char c acc) + (put-u8 acc b) (lp)]))))) (def (drain-headers in) @@ -326,47 +399,63 @@ [else (lp (+ i 1))])))) (def (write-status out code msg) - (display "HTTP/1.1 " out) - (display code out) - (display " " out) - (display msg out) - (display "\r\n\r\n" out) + (put-bytevector + out + (string->utf8 + (string-append "HTTP/1.1 " + (number->string code) + " " + msg + "\r\n\r\n"))) (flush-output-port out)) ;; ---------- Tunnel ---------- - (def (tunnel p client-in client-out host port) - (log! p `(connect (host . ,host) (port . ,port))) - (bump! p 'allowed) - (let ([conn (try (call-with-values - (lambda () (tcp-connect host port)) - cons) - (catch (e) #f))]) - (cond - [(not conn) - (write-status client-out 502 "upstream connect failed") - (close-pair client-in client-out)] - [else - (let ([origin-in (car conn)] [origin-out (cdr conn)]) - (write-status client-out 200 "Connection established") - ;; Two shuttle threads, each copies one direction. - (let ([t1 (fork-thread - (lambda () (copy-loop client-in origin-out)))] - [t2 (fork-thread - (lambda () (copy-loop origin-in client-out)))]) - ;; Wait for either direction to close (no thread-join in - ;; Chez; poll with a brief sleep). Once one side closes, - ;; we tear down both. - (let wait () - (cond - [(or (and (proxy-port-eof? client-in) - (proxy-port-eof? origin-in))) - #f] - [else - (sleep (make-time 'time-duration 50000000 0)) - (wait)])) - (close-pair client-in client-out) - (close-pair origin-in origin-out)))]))) + (def (tunnel p client-in client-out host port decision) + (let ([connect-host (alist-get 'connect-host decision host)] + [resolved-host (alist-get 'resolved-host decision host)] + [pattern (alist-get 'pattern decision #f)]) + (log! p (allow-proxy-event 'allow + 'host: host + 'port: port + 'pattern: pattern + 'resolved-host: resolved-host + 'connect-host: connect-host)) + (bump! p 'allowed) + (let ([conn (try (call-with-values + (lambda () (tcp-connect-binary connect-host port)) + cons) + (catch (e) #f))]) + (cond + [(not conn) + (write-status client-out 502 "upstream connect failed") + (log! p (allow-proxy-event 'connect-failed + 'host: host + 'port: port + 'resolved-host: resolved-host + 'connect-host: connect-host)) + (close-pair client-in client-out)] + [else + (let ([origin-in (car conn)] [origin-out (cdr conn)]) + (write-status client-out 200 "Connection established") + ;; Two shuttle threads, each copies one direction. + (let ([t1 (fork-thread + (lambda () (copy-loop client-in origin-out)))] + [t2 (fork-thread + (lambda () (copy-loop origin-in client-out)))]) + ;; Wait for either direction to close (no thread-join in + ;; Chez; poll with a brief sleep). Once one side closes, + ;; we tear down both. + (let wait () + (cond + [(or (and (proxy-port-eof? client-in) + (proxy-port-eof? origin-in))) + #f] + [else + (sleep (make-time 'time-duration 50000000 0)) + (wait)])) + (close-pair client-in client-out) + (close-pair origin-in origin-out)))])))) (def (proxy-port-eof? p) (try (port-eof? p) (catch (e) #t))) --- a/tests/test-limits-primitives.ss +++ b/tests/test-limits-primitives.ss @@ -255,6 +255,28 @@ (allow-proxy-host-allowed? p "example.com" 443) (lambda (x) x))) +(let* ([p (make-allow-proxy-policy '("localhost:443"))] + [d (allow-proxy-connect-decision p "localhost" 443)]) + (test "allow-proxy connect decision rechecks resolved localnet" + (alist-ref/default d 'allowed #t) + #f) + (test "allow-proxy connect decision reports resolved localnet reason" + (alist-ref/default d 'reason #f) + 'loopback4) + (test "allow-proxy connect decision records resolved host" + (alist-ref/default d 'resolved-host #f) + "127.0.0.1")) + +(let* ([p (make-allow-proxy-policy '("localhost:443") + 'allow-localnet?: #t)] + [d (allow-proxy-connect-decision p "localhost" 443)]) + (test "allow-proxy connect decision allows opted-in localnet" + (alist-ref/default d 'allowed #f) + #t) + (test "allow-proxy connect decision returns connect host" + (alist-ref/default d 'connect-host #f) + "127.0.0.1")) + (test-pred "net-allowlist decision layer matches wildcard host" (net-allowlist-host-allowed? '("*.example.com:443") "api.example.com" 443 #f #f)