updates
ober
d132088d869546399d6a39a966b09403f4bc81b0
--- a/data/features.sexp +++ b/data/features.sexp @@ -1176,4 +1176,24 @@ ("use_case" . "Use when validating changed Jerboa source files before build, especially larger modules such as src/jcode/core/agent.ss or src/jcode/ui/serve.ss.") + ("votes" . 0)) + (("description" + . + "jerboa_verify on a repo source file such as src/jcode/ui/tui-sidebar.ss reports \"export form outside of a module or library\" even though make build transpiles and compiles the file successfully. The verifier should load/transpile .ss source files with the same module context/libdirs used by jerbuild so local modules with top-level export forms can be checked directly.") ("estimated_token_reduction" . "") + ("example_scenario" + . + "Run jerboa_verify with file_path=/Users/user/mine/jerboa-code/src/jcode/ui/tui-sidebar.ss and project_path=/Users/user/mine/jerboa-code. Expected: verify the module. Actual: export form outside of a module or library.") + ("id" . "verify-ss-export-module-context") + ("impact" + . + "Reduces false verification failures and avoids fallback build-only checks for ordinary Jerboa project source files.") + ("status" . "open") + ("tags" "verify" "export" "source-file" "project-context" + "jerbuild") + ("title" + . + "Verify .ss source files with top-level export forms in project module context") + ("use_case" + . + "After editing a Jerboa project source file, agents need a direct verifier result before building. If verify rejects top-level export forms, agents fall back to make build and lose the faster, more focused syntax/expand feedback.") ("votes" . 0))) --- a/docs/security-reference.md +++ b/docs/security-reference.md @@ -192,6 +192,44 @@ Fork-based privilege separation. Supervisor holds elevated privileges; workers a --- +### Sandbox Launch Policies and Egress Reports -- `(std os limits sandbox)` + +The launch-policy sandbox layer provides a passive policy object plus per-axis +reports for command launchers. It is the preferred interface when callers need to +know whether filesystem, network, syscall, or limit enforcement was installed, +degraded, unavailable, or refused. + +Network egress can be declared as an ordered policy: + +```scheme +(import (std os limits sandbox)) + +(define ep + (make-egress-policy + 'deny + (list (make-egress-rule 'allow "*.example.com:443")) + #t)) ; require full isolation + +(define pol + (sandbox-policy 'egress-policy: ep + 'net-connect-ports: '(43125))) + +(sandbox-policy-diagnostics pol) +``` + +`make-egress-policy` supports `allow` and `deny` rules. Default-deny policies +with only allow rules can be converted to a local proxy allowlist via +`egress-policy-proxy-allowlist`. Policies with ordered deny rules or +default-allow semantics are deliberately not converted, because a simple proxy +allowlist cannot safely express "allow everything except X". + +When `require-full-isolation?` is true, `sandbox-launch` implicitly requires the +`net` axis and fails closed if the backend cannot install full network +confinement. Use `sandbox-result-diagnostics` to inspect launch status, refused +axes, backend reports, and process status. + +--- + ## 6. Sandbox Entry Point **Module**: `(std security sandbox)` --- a/lib/std/os/limits/sandbox.ss +++ b/lib/std/os/limits/sandbox.ss @@ -59,9 +59,23 @@ sandbox-policy-get sandbox-policy-pairs + make-egress-rule + egress-rule? + egress-rule-action + egress-rule-target + make-egress-policy + egress-policy? + egress-policy-default-action + egress-policy-rules + egress-policy-require-full-isolation? + egress-policy-proxy-allowlist + egress-policy-host-decision + egress-policy-host-allowed? + sandbox-capabilities sandbox-backend sandbox-policy-explain + sandbox-policy-diagnostics sandbox-launch sandbox-prepare-child! @@ -81,7 +95,8 @@ sandbox-result-launched? sandbox-result-status sandbox-result-signal - sandbox-result-refused-axes) + sandbox-result-refused-axes + sandbox-result-diagnostics) (import (chezscheme) (only (jerboa core) def defstruct try catch finally) @@ -114,7 +129,136 @@ process-result-signal process-result-pid process-result-killed-reason - process-result-child-status)) + process-result-child-status) + (only (std net allowlist) + net-allowlist-target-matches? + net-allowlist-host-denial-reason)) + + ;; ---------- Egress policy ---------- + + (defstruct %egress-rule (action target)) + (def %make-egress-rule make-%egress-rule) + (def egress-rule? %egress-rule?) + (def egress-rule-action %egress-rule-action) + (def egress-rule-target %egress-rule-target) + + (defstruct %egress-policy (default-action rules require-full-isolation?)) + (def %make-egress-policy make-%egress-policy) + (def egress-policy? %egress-policy?) + (def egress-policy-default-action %egress-policy-default-action) + (def egress-policy-rules %egress-policy-rules) + (def egress-policy-require-full-isolation? %egress-policy-require-full-isolation?) + + (def (normalize-egress-action action who) + (let ([a (cond + [(symbol? action) action] + [(string? action) + (string->symbol (string-downcase action))] + [else action])]) + (cond + [(memq a '(allow deny)) a] + [else + (error who "expected egress action 'allow or 'deny" action)]))) + + (def (make-egress-rule action target) + (unless (and (string? target) (> (string-length target) 0)) + (error 'make-egress-rule "expected non-empty target string" target)) + (%make-egress-rule + (normalize-egress-action action 'make-egress-rule) + target)) + + (def (normalize-egress-rule rule) + (cond + [(egress-rule? rule) rule] + [(and (pair? rule) (pair? (cdr rule))) + (make-egress-rule (car rule) (cadr rule))] + [(and (pair? rule) (symbol? (car rule)) (string? (cdr rule))) + (make-egress-rule (car rule) (cdr rule))] + [else + (error 'make-egress-policy + "expected egress-rule or (action target) pair" + rule)])) + + (def (make-egress-policy default-action rules . maybe-require-full-isolation?) + (unless (list? rules) + (error 'make-egress-policy "expected list of egress rules" rules)) + (%make-egress-policy + (normalize-egress-action default-action 'make-egress-policy) + (map normalize-egress-rule rules) + (and (pair? maybe-require-full-isolation?) + (car maybe-require-full-isolation?) + #t))) + + (def (egress-policy-has-deny-rules? pol) + (let lp ([xs (egress-policy-rules pol)]) + (cond + [(null? xs) #f] + [(eq? (egress-rule-action (car xs)) 'deny) #t] + [else (lp (cdr xs))]))) + + (def (egress-policy-effective-net pol) + ;; Host/FQDN policies need a local proxy plus direct-network restriction + ;; unless the policy is a pure allow-all. + (cond + [(not pol) #f] + [(and (eq? (egress-policy-default-action pol) 'allow) + (not (egress-policy-has-deny-rules? pol))) + 'allow] + [else 'allowlist])) + + (def (egress-policy-proxy-allowlist pol) + ;; Returns the allowlist patterns that can be enforced by (std net + ;; allow-proxy), or #f when the policy is default-allow with deny rules. + ;; A proxy allowlist cannot express "allow everything except X" or ordered + ;; deny-over-allow rules safely. + (cond + [(not (egress-policy? pol)) + (error 'egress-policy-proxy-allowlist "expected egress-policy" pol)] + [(or (eq? (egress-policy-default-action pol) 'allow) + (egress-policy-has-deny-rules? pol)) + #f] + [else + (let lp ([xs (egress-policy-rules pol)] [out '()]) + (cond + [(null? xs) (reverse out)] + [(eq? (egress-rule-action (car xs)) 'allow) + (lp (cdr xs) (cons (egress-rule-target (car xs)) out))] + [else (lp (cdr xs) out)]))])) + + (def (port->string port) + (cond + [(integer? port) (number->string port)] + [(string? port) port] + [else ""])) + + (def (egress-rule-matches-host? rule host port) + (net-allowlist-target-matches? + (string-append host ":" (port->string port)) + (egress-rule-target rule))) + + (def (egress-policy-host-decision pol host port . opts) + ;; Decision-only helper for diagnostics, tests, and launchers. It does + ;; not resolve DNS and intentionally treats IP literals/localnet targets + ;; as denied unless explicitly opted in. + (unless (egress-policy? pol) + (error 'egress-policy-host-decision "expected egress-policy" pol)) + (let ([allow-ip-literals? (and (pair? opts) (car opts))] + [allow-localnet? (and (pair? opts) (pair? (cdr opts)) + (cadr opts))]) + (cond + [(net-allowlist-host-denial-reason host allow-ip-literals? + allow-localnet?) + 'deny] + [else + (let lp ([xs (egress-policy-rules pol)]) + (cond + [(null? xs) (egress-policy-default-action pol)] + [(egress-rule-matches-host? (car xs) host port) + (egress-rule-action (car xs))] + [else (lp (cdr xs))]))]))) + + (def (egress-policy-host-allowed? pol host port . opts) + (eq? (apply egress-policy-host-decision pol host port opts) 'allow)) ;; ---------- Policy record ---------- @@ -131,6 +275,7 @@ (net . deny) (net-allow . ()) (net-connect-ports . ()) + (egress-policy . #f) (syscalls . safe) (ptrace? . #f) (no-new-privs? . #t))) @@ -139,6 +284,7 @@ '(read-paths: write-paths: exec-paths: deny-read-paths: deny-write-paths: deny-exec-paths: net: net-allow: net-connect-ports: + egress-policy: syscalls: ptrace?: no-new-privs?:)) (def (sandbox-policy . args) @@ -194,6 +340,31 @@ (def (sandbox-policy-pairs pol) (sandbox-policy-rec-entries pol)) + (def (sandbox-policy-egress-policy pol) + (let ([ep (sandbox-policy-get pol 'egress-policy)]) + (cond + [(not ep) #f] + [(egress-policy? ep) ep] + [else + (error 'sandbox-policy "egress-policy must be an egress-policy" ep)]))) + + (def (sandbox-policy-effective-net pol) + (let ([ep (sandbox-policy-egress-policy pol)]) + (or (and ep (egress-policy-effective-net ep)) + (sandbox-policy-get pol 'net)))) + + (def (sandbox-policy-egress-requires-net? pol) + (let ([ep (sandbox-policy-egress-policy pol)]) + (and ep (egress-policy-require-full-isolation? ep)))) + + (def (add-axis-once axes axis) + (if (memq axis axes) axes (cons axis axes))) + + (def (sandbox-policy-required-axes pol axes) + (if (sandbox-policy-egress-requires-net? pol) + (add-axis-once axes 'net) + axes)) + ;; ---------- Backend detection ---------- (def (sandbox-backend) @@ -285,7 +456,7 @@ [else (loop (cdr xs))]))) (def (linux-net-mode pol) - (case (sandbox-policy-get pol 'net) + (case (sandbox-policy-effective-net pol) [(allow) 0] [(deny no-internet) 1] [(local-only allowlist) @@ -293,7 +464,7 @@ [else 1])) (def (linux-net-status-for pol net-install? fs-status) - (let ([net (sandbox-policy-get pol 'net)] + (let ([net (sandbox-policy-effective-net pol)] [port (linux-net-port pol)]) (cond [(eq? net 'allow) 'installed] @@ -375,7 +546,7 @@ (let* ([read (sandbox-policy-get pol 'read-paths)] [write (sandbox-policy-get pol 'write-paths)] [exec (sandbox-policy-get pol 'exec-paths)] - [net (sandbox-policy-get pol 'net)] + [net (sandbox-policy-effective-net pol)] [needs-wrap? (sandbox-policy-has-paths? pol)] [fs-status (cond @@ -413,7 +584,7 @@ ;; `deny` is the neutral default today, so do not force every default ;; policy through sandbox-exec. Callers that need direct-network denial ;; for proxy handoff should request local-only or allowlist explicitly. - (case (sandbox-policy-get pol 'net) + (case (sandbox-policy-effective-net pol) [(local-only allowlist) #t] [else #f])) @@ -431,7 +602,7 @@ (sandbox-policy-get pol 'deny-read-paths) (sandbox-policy-get pol 'deny-write-paths) (sandbox-policy-get pol 'deny-exec-paths) - (sandbox-policy-get pol 'net))]) + (sandbox-policy-effective-net pol))]) (cons "/usr/bin/sandbox-exec" (cons "-p" (cons sbpl cmd))))] [else cmd]))) @@ -454,13 +625,13 @@ (and (platform-linux?) (or (sandbox-policy-has-paths? pol) (sandbox-policy-net-wrapper-needed? pol) - (memq (sandbox-policy-get pol 'net) '(deny no-internet))))) + (memq (sandbox-policy-effective-net pol) '(deny no-internet))))) (def (sandbox-child-preexec-available? pol) (or (not (sandbox-child-preexec-needed? pol)) (and (platform-linux?) (>= (linux-landlock-abi-version) 1) - (or (not (memq (sandbox-policy-get pol 'net) + (or (not (memq (sandbox-policy-effective-net pol) '(deny no-internet local-only allowlist))) (linux-landlock-net-available?))))) @@ -510,7 +681,7 @@ (syscalls . degraded))) (def (net-status-for pol) - (case (sandbox-policy-get pol 'net) + (case (sandbox-policy-effective-net pol) [(deny) 'installed] [(allow) 'installed] [(local-only) 'degraded] @@ -627,7 +798,7 @@ (sandbox-policy-get pol 'deny-read-paths) (sandbox-policy-get pol 'deny-write-paths) (sandbox-policy-get pol 'deny-exec-paths) - (sandbox-policy-get pol 'net))) + (sandbox-policy-effective-net pol))) (def (sbpl-string s) ;; SBPL strings: quote and backslash-escape. @@ -681,6 +852,38 @@ (let ([p (sandbox-result-process r)]) (and p (process-result-signal p)))) + (def (egress-policy-rule-count ep) + (if ep (length (egress-policy-rules ep)) 0)) + + (def (egress-policy-diagnostics ep) + (and ep + `((default-action . ,(egress-policy-default-action ep)) + (rules . ,(egress-policy-rule-count ep)) + (proxy-allowlist . ,(or (egress-policy-proxy-allowlist ep) '())) + (require-full-isolation? . ,(egress-policy-require-full-isolation? ep)) + (direct-network . ,(egress-policy-effective-net ep))))) + + (def (sandbox-policy-diagnostics pol) + (let ([ep (sandbox-policy-egress-policy pol)]) + `((backend . ,(sandbox-backend)) + (effective-net . ,(sandbox-policy-effective-net pol)) + (policy . ,(sandbox-policy-pairs pol)) + (egress . ,(egress-policy-diagnostics ep)) + (capabilities . ,(sandbox-capabilities))))) + + (def (sandbox-result-diagnostics r) + (let ([p (sandbox-result-process r)]) + `((backend . ,(sandbox-result-backend r)) + (launched? . ,(sandbox-result-launched? r)) + (refused-axes . ,(sandbox-result-refused-axes r)) + (report . ,(sandbox-result-report r)) + (limits . ,(sandbox-result-limit-report r)) + (process . ,(and p + `((pid . ,(process-result-pid p)) + (status . ,(process-result-status p)) + (signal . ,(process-result-signal p)) + (killed-reason . ,(process-result-killed-reason p)))))))) + ;; ---------- Launch ---------- (def *sandbox-launch-keys* @@ -813,8 +1016,11 @@ (def (sandbox-launch-kw pol args) (let* ([command (launch-arg args 'command: #f)] - [require-axes (launch-arg args 'require: '())] - [fail-closed? (launch-arg args 'fail-closed?: #t)] + [require-axes (sandbox-policy-required-axes + pol + (launch-arg args 'require: '()))] + [fail-closed? (or (sandbox-policy-egress-requires-net? pol) + (launch-arg args 'fail-closed?: #t))] [limit-pol (launch-arg args 'limit-policy: #f)] [limit-plan (and limit-pol (limit-policy-plan limit-pol))] [capabilities (sandbox-capabilities)] @@ -844,7 +1050,10 @@ spec pol limit-pol require-axes fail-closed?))]))) (def (sandbox-launch-spec spec pol limit-pol require-axes fail-closed?) - (let* ([user-pre (launch-spec-child-pre-exec spec)] + (let* ([require-axes (sandbox-policy-required-axes pol require-axes)] + [fail-closed? (or fail-closed? + (sandbox-policy-egress-requires-net? pol))] + [user-pre (launch-spec-child-pre-exec spec)] [status-proc (lambda () `((sandbox . ,(sandbox-prepare-child! pol)) @@ -925,6 +1134,24 @@ (write (cdr kv) port) (newline port)) (sandbox-policy-rec-entries pol)) + (display "effective-net = " port) + (write (sandbox-policy-effective-net pol) port) + (newline port) + (let ([ep (sandbox-policy-egress-policy pol)]) + (when ep + (display "egress:" port) (newline port) + (display " default-action : " port) + (write (egress-policy-default-action ep) port) + (newline port) + (display " rules : " port) + (write (egress-policy-rule-count ep) port) + (newline port) + (display " proxy-allowlist : " port) + (write (or (egress-policy-proxy-allowlist ep) 'unsupported) port) + (newline port) + (display " require-full-isolation? : " port) + (write (egress-policy-require-full-isolation? ep) port) + (newline port))) (display "capabilities:" port) (newline port) (for-each (lambda (kv) --- a/tests/test-limits-primitives.ss +++ b/tests/test-limits-primitives.ss @@ -392,6 +392,69 @@ (net-allowlist-host-denial-reason "169.254.169.254" #f #f) 'ip-literal) +;; ===== sandbox egress policy: declarative network shape ===== +(printf "[sandbox egress policy]~%") + +(let* ([ep (make-egress-policy + 'deny + (list (make-egress-rule 'allow "*.example.com:443")) + #t)] + [pol (sandbox-policy 'egress-policy: ep)] + [diag (sandbox-policy-diagnostics pol)]) + (test "egress policy default action" + (egress-policy-default-action ep) + 'deny) + (test "egress proxy allowlist from default-deny allows" + (egress-policy-proxy-allowlist ep) + '("*.example.com:443")) + (test "egress policy allows matching host" + (egress-policy-host-allowed? ep "api.example.com" 443) + #t) + (test "egress policy denies non-matching host" + (egress-policy-host-allowed? ep "api.invalid" 443) + #f) + (test "egress policy drives effective net mode" + (alist-ref/default diag 'effective-net #f) + 'allowlist) + (test-pred "egress diagnostics include policy report" + (alist-ref/default diag 'egress #f) + (lambda (x) (and (pair? x) (assq 'proxy-allowlist x)))) + (test-pred "sandbox policy explain includes egress section" + (sandbox-policy-explain pol) + (lambda (s) (string-contains? s "egress:")))) + +(let ([ep (make-egress-policy + 'deny + (list (make-egress-rule 'deny "bad.example.com:443") + (make-egress-rule 'allow "*.example.com:443")))]) + (test "egress decision honors first matching deny" + (egress-policy-host-decision ep "bad.example.com" 443) + 'deny) + (test "egress policy with deny rules is not proxy-allowlist convertible" + (egress-policy-proxy-allowlist ep) + #f)) + +(let ([r (sandbox-launch + (sandbox-policy + 'egress-policy: + (make-egress-policy + 'deny + (list (make-egress-rule 'allow "api.example.com:443")) + #t)) + 'command: '("/bin/echo" "should-not-run") + 'fail-closed?: #f)]) + (test "strict egress policy fail-closes without full net isolation" + (sandbox-result-launched? r) + #f) + (test "strict egress policy reports net refusal" + (sandbox-result-refused-axes r) + '(net)) + (test-pred "sandbox result diagnostics report launch refusal" + (sandbox-result-diagnostics r) + (lambda (x) + (and (eq? (alist-ref/default x 'launched? #t) #f) + (equal? (alist-ref/default x 'refused-axes '()) '(net)))))) + ;; ===== env policy: default deny patterns ===== (printf "[env policy]~%")