Extract net allowlist decisions
ober
661098713267a9eab448c8eb47f863f5f1d82b99
--- a/docs/limits-followup.md +++ b/docs/limits-followup.md @@ -42,6 +42,7 @@ New Jerboa modules exist for the main proposed primitives: - `(std os supervise)` - `(std os exec-id)` - `(std os tracefs)` +- `(std net allowlist)` - `(std net allow-proxy)` - `(std security env)` - `(std os temp-home)` @@ -293,25 +294,26 @@ File: `lib/std/net/allow-proxy.ss` Implemented: +- Reusable decision-only allowlist checks live in `(std net allowlist)` so + callers can preflight host policy without importing the proxy/TCP stack. - A local CONNECT proxy skeleton. - 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. Critical missing security requirements: -- No denial of IP literals. -- No denial of loopback, link-local, private, or local network ranges. - 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. -Observed behavior: +Observed behavior after the decision-layer hardening: -- With an allowlist of `*:443`, both `127.0.0.1:443` and `10.0.0.1:443` were - accepted by `allow-proxy-host-allowed?`. That violates the localnet and - IP-literal denial requirements. +- 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. Required next work: --- a/lib/std/net/allow-proxy.ss +++ b/lib/std/net/allow-proxy.ss @@ -61,6 +61,13 @@ (import (chezscheme) (only (jerboa core) def defstruct try catch finally) + (only (std net allowlist) + host-is-ipv4-literal? + host-is-ipv6-literal? + host-is-localnet? + net-allowlist-split-host-port + net-allowlist-host-allowed? + net-allowlist-host-denial-reason) (only (std net tcp) tcp-listen tcp-accept tcp-close tcp-connect tcp-server-port)) @@ -132,112 +139,6 @@ 'allow: patterns opts)) - ;; ---------- IP-literal and localnet detection ---------- - - (def (host-is-ipv4-literal? host) - ;; True iff HOST is a valid IPv4 dotted-quad literal. Does not - ;; resolve DNS; matches the textual form only. - (and (string? host) - (parse-ipv4 host) - #t)) - - (def (parse-ipv4 host) - ;; Returns a 4-list of octets or #f. No leading zeros normalisation; - ;; "01.02.03.04" is accepted for safety (octal-looking forms still - ;; resolve to the same address class via inet_aton, so we should - ;; deny them too). - (let* ([n (string-length host)]) - (let lp ([i 0] [oct '()] [acc -1]) - (cond - [(>= i n) - (and (>= acc 0) (<= acc 255) - (let ([all (reverse (cons acc oct))]) - (and (= 4 (length all)) - all)))] - [(char=? (string-ref host i) #\.) - (and (>= acc 0) (<= acc 255) - (lp (+ i 1) (cons acc oct) -1))] - [else - (let ([c (string-ref host i)]) - (and (char<=? #\0 c #\9) - (let ([d (- (char->integer c) (char->integer #\0))]) - (lp (+ i 1) oct - (if (< acc 0) d (+ (* acc 10) d))))))])))) - - (def (host-is-ipv6-literal? host) - ;; Conservative match: contains a colon and either starts with '[' - ;; (bracketed form) or contains at least one ':' segment plus only - ;; hex/colon/dot characters. This rejects "example.com" cleanly and - ;; accepts "::1", "fe80::1", "2001:db8::1", "[::1]". - (and (string? host) - (> (string-length host) 1) - (let* ([s (if (and (char=? (string-ref host 0) #\[) - (let ([n (string-length host)]) - (char=? (string-ref host (- n 1)) #\]))) - (substring host 1 (- (string-length host) 1)) - host)]) - (and (let lp ([i 0] [colon? #f] [non-hex? #f]) - (cond - [(>= i (string-length s)) (and colon? (not non-hex?))] - [else - (let ([c (string-ref s i)]) - (cond - [(char=? c #\:) (lp (+ i 1) #t non-hex?)] - [(or (char<=? #\0 c #\9) - (char<=? #\a c #\f) - (char<=? #\A c #\F) - (char=? c #\.)) ;; IPv4-mapped tail - (lp (+ i 1) colon? non-hex?)] - [else (lp (+ i 1) colon? #t)]))])))))) - - (def (host-is-localnet? host) - ;; Returns a symbol describing the localnet category, or #f. - ;; Categories: 'loopback4 'loopback6 'link-local4 'link-local6 - ;; 'rfc1918-10 'rfc1918-172 'rfc1918-192 'cgnat 'multicast4 'multicast6 - ;; 'unspecified - (cond - [(host-is-ipv4-literal? host) - (let* ([oct (parse-ipv4 host)] - [a (car oct)] [b (cadr oct)]) - (cond - [(= a 127) 'loopback4] - [(= a 10) 'rfc1918-10] - [(and (= a 172) (>= b 16) (<= b 31)) 'rfc1918-172] - [(and (= a 192) (= b 168)) 'rfc1918-192] - [(and (= a 169) (= b 254)) 'link-local4] - [(and (= a 100) (>= b 64) (<= b 127)) 'cgnat] - [(and (>= a 224) (<= a 239)) 'multicast4] - [(= a 0) 'unspecified] - [else #f]))] - [(host-is-ipv6-literal? host) - (let* ([s host] - [s (if (and (> (string-length s) 1) - (char=? (string-ref s 0) #\[)) - (substring s 1 (- (string-length s) 1)) - s)] - [lower (string-downcase s)]) - (cond - [(or (string=? lower "::1") (string=? lower "0:0:0:0:0:0:0:1")) - 'loopback6] - [(or (string=? lower "::") (string=? lower "0:0:0:0:0:0:0:0")) - 'unspecified] - [(or (and (>= (string-length lower) 4) - (string=? (substring lower 0 4) "fe80")) ; link-local - (and (>= (string-length lower) 3) - (string=? (substring lower 0 3) "ff0"))) ; multicast - (cond - [(and (>= (string-length lower) 4) - (string=? (substring lower 0 4) "fe80")) 'link-local6] - [else 'multicast6])] - [(or (and (>= (string-length lower) 2) - (string=? (substring lower 0 2) "fc")) - (and (>= (string-length lower) 2) - (string=? (substring lower 0 2) "fd"))) - 'rfc1918-6] ;; fc00::/7 unique-local - [else #f]))] - [(string=? host "localhost") 'loopback4] - [else #f])) - ;; ---------- Allowlist matching ---------- (def (allow-proxy-host-allowed? p host port) @@ -247,29 +148,20 @@ ;; wildcard ("*:443") in the allowlist. ;; 2. Match against the host:port glob allowlist. ;; Returns the matching pattern string on allow, #f on deny. - (cond - [(allow-proxy-host-denial-reason p host port) #f] - [else - (let ([target (string-append host ":" (number->string port))]) - (let lp ([xs (allow-proxy-rec-allowlist p)]) - (cond - [(null? xs) #f] - [(target-matches? target (car xs)) (car xs)] - [else (lp (cdr xs))])))])) + (net-allowlist-host-allowed? + (allow-proxy-rec-allowlist p) + host port + (allow-proxy-rec-allow-ip-literals? p) + (allow-proxy-rec-allow-localnet? p))) (def (allow-proxy-host-denial-reason p host port) ;; Returns a symbol describing why HOST is unconditionally denied, or ;; #f if it passes the gate. Callers (proxy and audit log) use this ;; to emit a structured deny reason instead of a generic "no match". - (let ([ipl? (or (host-is-ipv4-literal? host) - (host-is-ipv6-literal? host))] - [ln (host-is-localnet? host)]) - (cond - [(and ipl? (not (allow-proxy-rec-allow-ip-literals? p))) - 'ip-literal] - [(and ln (not (allow-proxy-rec-allow-localnet? p))) - (or ln 'localnet)] - [else #f]))) + (net-allowlist-host-denial-reason + host + (allow-proxy-rec-allow-ip-literals? p) + (allow-proxy-rec-allow-localnet? p))) ;; ---------- Structured event constructor ---------- @@ -296,71 +188,6 @@ [else #f])) (lp (cddr xs))])))) - (def (target-matches? target pat) - ;; Split TARGET and PAT on ':' and match host part and port part - ;; independently. Host part supports '*' (one label) and '**' (any). - (let-values ([(thost tport) (split-host-port target)] - [(phost pport) (split-host-port pat)]) - (and (port-matches? tport pport) - (host-matches? thost phost)))) - - (def (split-host-port s) - (let lp ([i (- (string-length s) 1)]) - (cond - [(< i 0) (values s "")] - [(char=? (string-ref s i) #\:) - (values (substring s 0 i) - (substring s (+ i 1) (string-length s)))] - [else (lp (- i 1))]))) - - (def (port-matches? tp pp) - (cond - [(string=? pp "*") #t] - [(string=? pp "") #t] - [else (string=? tp pp)])) - - (def (host-matches? host pat) - (cond - [(string=? pat "*") #t] - [(string=? pat host) #t] - [(prefix? "**." pat) - ;; **.example.com matches any-suffix - (let ([suffix (substring pat 3 (string-length pat))]) - (or (string=? host suffix) - (and (> (string-length host) (+ 1 (string-length suffix))) - (string=? (substring host - (- (string-length host) - (+ 1 (string-length suffix))) - (string-length host)) - (string-append "." suffix)))))] - [(prefix? "*." pat) - ;; *.example.com matches exactly one extra label - (let ([suffix (substring pat 2 (string-length pat))]) - (and (> (string-length host) (+ 1 (string-length suffix))) - (string=? (substring host - (- (string-length host) - (+ 1 (string-length suffix))) - (string-length host)) - (string-append "." suffix)) - ;; ensure exactly one label before the suffix - (not (label-contains-dot? host suffix))))] - [else #f])) - - (def (label-contains-dot? host suffix) - ;; HOST is "a.b.c", SUFFIX is "c" → label is "a.b" → contains dot. - ;; Returns #t when the prefix label before SUFFIX contains a dot, - ;; which means *.suffix would NOT match. - (let ([pre-len (- (string-length host) (+ 1 (string-length suffix)))]) - (let lp ([i 0]) - (cond - [(>= i pre-len) #f] - [(char=? (string-ref host i) #\.) #t] - [else (lp (+ i 1))])))) - - (def (prefix? p s) - (and (>= (string-length s) (string-length p)) - (string=? (substring s 0 (string-length p)) p))) - ;; ---------- Logging / stats ---------- (def (bump! p key) @@ -484,7 +311,7 @@ ;; "CONNECT host:port HTTP/1.1" (let-values ([(method rest) (split-on-space line)]) (let-values ([(target _ver) (split-on-space rest)]) - (let-values ([(host port-str) (split-host-port target)]) + (let-values ([(host port-str) (net-allowlist-split-host-port target)]) (values method host (or (string->number port-str) 0)))))) new file mode 100644 --- /dev/null +++ b/lib/std/net/allowlist.ss @@ -0,0 +1,205 @@ +#!chezscheme +;;; (std net allowlist) - Decision-only host:port allowlist helpers +;;; +;;; This module contains the reusable security decision layer used by +;;; (std net allow-proxy) and shells/launchers that need to preflight a network +;;; policy without pulling in the proxy server or TCP stack. + +(library (std net allowlist) + (export + host-is-ipv4-literal? + host-is-ipv6-literal? + host-is-localnet? + net-allowlist-split-host-port + net-allowlist-target-matches? + net-allowlist-host-denial-reason + net-allowlist-host-allowed?) + + (import (chezscheme) + (only (jerboa core) def)) + + (def (host-is-ipv4-literal? host) + ;; True iff HOST is a valid IPv4 dotted-quad literal. Does not resolve DNS; + ;; matches the textual form only. + (and (string? host) + (parse-ipv4 host) + #t)) + + (def (parse-ipv4 host) + ;; Returns a 4-list of octets or #f. Leading zero forms are accepted so + ;; octal-looking IP literals are still treated as IP literals and denied by + ;; default. + (let* ([n (string-length host)]) + (let lp ([i 0] [oct '()] [acc -1]) + (cond + [(>= i n) + (and (>= acc 0) (<= acc 255) + (let ([all (reverse (cons acc oct))]) + (and (= 4 (length all)) + all)))] + [(char=? (string-ref host i) #\.) + (and (>= acc 0) (<= acc 255) + (lp (+ i 1) (cons acc oct) -1))] + [else + (let ([c (string-ref host i)]) + (and (char<=? #\0 c #\9) + (let ([d (- (char->integer c) (char->integer #\0))]) + (lp (+ i 1) oct + (if (< acc 0) d (+ (* acc 10) d))))))])))) + + (def (host-is-ipv6-literal? host) + ;; Conservative match: contains a colon and otherwise contains only + ;; hex/colon/dot characters, with optional brackets. + (and (string? host) + (> (string-length host) 1) + (let* ([s (if (and (char=? (string-ref host 0) #\[) + (let ([n (string-length host)]) + (char=? (string-ref host (- n 1)) #\]))) + (substring host 1 (- (string-length host) 1)) + host)]) + (and (let lp ([i 0] [colon? #f] [non-hex? #f]) + (cond + [(>= i (string-length s)) (and colon? (not non-hex?))] + [else + (let ([c (string-ref s i)]) + (cond + [(char=? c #\:) (lp (+ i 1) #t non-hex?)] + [(or (char<=? #\0 c #\9) + (char<=? #\a c #\f) + (char<=? #\A c #\F) + (char=? c #\.)) + (lp (+ i 1) colon? non-hex?)] + [else (lp (+ i 1) colon? #t)]))])))))) + + (def (host-is-localnet? host) + ;; Returns a symbol describing the localnet category, or #f. + (cond + [(host-is-ipv4-literal? host) + (let* ([oct (parse-ipv4 host)] + [a (car oct)] [b (cadr oct)]) + (cond + [(= a 127) 'loopback4] + [(= a 10) 'rfc1918-10] + [(and (= a 172) (>= b 16) (<= b 31)) 'rfc1918-172] + [(and (= a 192) (= b 168)) 'rfc1918-192] + [(and (= a 169) (= b 254)) 'link-local4] + [(and (= a 100) (>= b 64) (<= b 127)) 'cgnat] + [(and (>= a 224) (<= a 239)) 'multicast4] + [(= a 0) 'unspecified] + [else #f]))] + [(host-is-ipv6-literal? host) + (let* ([s host] + [s (if (and (> (string-length s) 1) + (char=? (string-ref s 0) #\[)) + (substring s 1 (- (string-length s) 1)) + s)] + [lower (string-downcase s)] + [lp-len (string-length lower)]) + (cond + [(or (string=? lower "::1") (string=? lower "0:0:0:0:0:0:0:1")) + 'loopback6] + [(or (string=? lower "::") (string=? lower "0:0:0:0:0:0:0:0")) + 'unspecified] + [(and (>= lp-len 4) (string=? (substring lower 0 4) "fe80")) + 'link-local6] + [(and (>= lp-len 3) (string=? (substring lower 0 3) "ff0")) + 'multicast6] + [(and (>= lp-len 2) + (or (string=? (substring lower 0 2) "fc") + (string=? (substring lower 0 2) "fd"))) + 'rfc1918-6] + [else #f]))] + [(string=? host "localhost") 'loopback4] + [else #f])) + + (def (net-allowlist-host-denial-reason host allow-ip-literals? + allow-localnet?) + ;; Returns a symbol naming why HOST is unconditionally denied, or #f if it + ;; passes the hard gate. + (let ([ipl? (or (host-is-ipv4-literal? host) + (host-is-ipv6-literal? host))] + [ln (host-is-localnet? host)]) + (cond + [(and ipl? (not allow-ip-literals?)) 'ip-literal] + [(and ln (not allow-localnet?)) (or ln 'localnet)] + [else #f]))) + + (def (net-allowlist-host-allowed? patterns host port allow-ip-literals? + allow-localnet?) + ;; Returns the matched pattern on allow, or #f on deny. + (cond + [(net-allowlist-host-denial-reason host allow-ip-literals? + allow-localnet?) + #f] + [else + (let* ([port-str (cond + [(string? port) port] + [(integer? port) (number->string port)] + [else ""])] + [target (string-append host ":" port-str)]) + (let lp ([xs patterns]) + (cond + [(null? xs) #f] + [(net-allowlist-target-matches? target (car xs)) (car xs)] + [else (lp (cdr xs))])))])) + + (def (net-allowlist-target-matches? target pat) + ;; Split TARGET and PAT on ':' and match host part and port part + ;; independently. Host part supports '*' (one label) and '**' (any). + (let-values ([(thost tport) (net-allowlist-split-host-port target)] + [(phost pport) (net-allowlist-split-host-port pat)]) + (and (port-matches? tport pport) + (host-matches? thost phost)))) + + (def (net-allowlist-split-host-port s) + (let lp ([i (- (string-length s) 1)]) + (cond + [(< i 0) (values s "")] + [(char=? (string-ref s i) #\:) + (values (substring s 0 i) + (substring s (+ i 1) (string-length s)))] + [else (lp (- i 1))]))) + + (def (port-matches? tp pp) + (cond + [(string=? pp "*") #t] + [(string=? pp "") #t] + [else (string=? tp pp)])) + + (def (host-matches? host pat) + (cond + [(string=? pat "*") #t] + [(string=? pat host) #t] + [(prefix? "**." pat) + (let ([suffix (substring pat 3 (string-length pat))]) + (or (string=? host suffix) + (and (> (string-length host) (+ 1 (string-length suffix))) + (string=? (substring host + (- (string-length host) + (+ 1 (string-length suffix))) + (string-length host)) + (string-append "." suffix)))))] + [(prefix? "*." pat) + (let ([suffix (substring pat 2 (string-length pat))]) + (and (> (string-length host) (+ 1 (string-length suffix))) + (string=? (substring host + (- (string-length host) + (+ 1 (string-length suffix))) + (string-length host)) + (string-append "." suffix)) + (not (label-contains-dot? host suffix))))] + [else #f])) + + (def (label-contains-dot? host suffix) + (let ([pre-len (- (string-length host) (+ 1 (string-length suffix)))]) + (let lp ([i 0]) + (cond + [(>= i pre-len) #f] + [(char=? (string-ref host i) #\.) #t] + [else (lp (+ i 1))])))) + + (def (prefix? p s) + (and (>= (string-length s) (string-length p)) + (string=? (substring s 0 (string-length p)) p))) + + ) ;; end library --- a/tests/test-limits-primitives.ss +++ b/tests/test-limits-primitives.ss @@ -6,6 +6,7 @@ ;;; (std os limits) — per-launch install report shape ;;; (std os limits sandbox) — fail-closed gating, dynamic report ;;; (std os exec-id) — resolution, comparison helpers +;;; (std net allowlist) — decision-only host allowlist checks ;;; (std net allow-proxy) — IP/localnet denial, structured events ;;; (std security env) — default deny patterns, validate-command ;;; (std security audit-log)— structured constructors, redaction @@ -20,6 +21,7 @@ (std os exec-id) (std os tracefs) (std os temp-home) + (std net allowlist) (std net allow-proxy) (std security env) (std security audit-log) @@ -222,6 +224,17 @@ (allow-proxy-host-allowed? p "example.com" 443) (lambda (x) x))) +(test-pred "net-allowlist decision layer matches wildcard host" + (net-allowlist-host-allowed? '("*.example.com:443") + "api.example.com" 443 #f #f) + (lambda (x) x)) +(test "net-allowlist decision layer denies localnet wildcard" + (net-allowlist-host-allowed? '("*:443") "127.0.0.1" 443 #f #f) + #f) +(test "net-allowlist denial reason reports ip literal" + (net-allowlist-host-denial-reason "169.254.169.254" #f #f) + 'ip-literal) + ;; ===== env policy: default deny patterns ===== (printf "[env policy]~%")