security: load capability plans at startup
Jaime Fournier <jaimef@linbsd.org>
fece14179688e61d77d907a34a7aee72950f7cf0
--- a/docs/capability.md +++ b/docs/capability.md @@ -3,13 +3,16 @@ The `(std capability)` library implements a lightweight object-capability security model for Chez Scheme. It provides unforgeable tokens that grant access to resources, with the constraint that capabilities can only be *attenuated* (restricted further) — never amplified. For the hardened runtime API, `(std security capability)` also supports an -active capability grant plan. Bind a plan with `with-capability-plan` at -application startup; while it is active, constructors such as +active capability grant plan. Put the plan in `.jerboa/capabilities.sexp` at +the application root, or bind it explicitly with `with-capability-plan` or +`with-capability-plan-file`; while it is active, constructors such as `make-fs-capability` and `make-net-capability` refuse any grant not declared by -the plan. Grant at the latest practical moment, request the narrowest domain -and permission set, attenuate before handing capabilities across module -boundaries, and wrap boundary checks with `check-capability!/audit` from -`(std security audit)` when the grant or denial must appear in the audit chain. +the plan. `jerboa run app.ss` loads the conventional file from the script +directory first, then from the current working directory. Grant at the latest +practical moment, request the narrowest domain and permission set, attenuate +before handing capabilities across module boundaries, and wrap boundary checks +with `check-capability!/audit` from `(std security audit)` when the grant or +denial must appear in the audit chain. ## Overview --- a/docs/kimi3-security-recommmendations.md +++ b/docs/kimi3-security-recommmendations.md @@ -751,11 +751,13 @@ they are build-time. Close the runtime loop. - **Status:** partially complete. `(std security capability)` now has an active runtime grant plan via `with-capability-plan`; while bound, capability constructors refuse undeclared grants with `&capability-violation`, and tests - cover declared grants plus undeclared filesystem/network refusals. The grant - style guidance is documented in `capability.md` and the security reference. - Remaining work: load a conventional `.jerboa/capabilities.sexp` at - application startup, require `check-capability!/audit` at selected module - boundaries, and add the static over-grant lint. + cover declared grants plus undeclared filesystem/network refusals. + `load-capability-plan-file`/`with-capability-plan-file` load the conventional + `.jerboa/capabilities.sexp` policy file, and `jerboa run` binds that plan at + startup when found beside the script or in the current working directory. The + grant style guidance is documented in `capability.md` and the security + reference. Remaining work: require `check-capability!/audit` at selected + module boundaries and add the static over-grant lint. ### K3-P1-10 — Information-leak sweep: errors, logs, and protocol surfaces **Serves:** G2, G4. **Effort:** 1 week. --- a/docs/security-reference.md +++ b/docs/security-reference.md @@ -262,6 +262,11 @@ Access rights are unforgeable tokens (sealed, opaque records with CSPRNG nonces) - **Runtime grant plans**: `with-capability-plan` can bind a declared grant plan; while active, every `make-*-capability` call must be covered by that plan or it raises `&capability-violation` +- **Startup plan files**: `load-capability-plan-file`, + `with-capability-plan-file`, and `find-capability-plan-file` support the + conventional `.jerboa/capabilities.sexp` application policy file. `jerboa run` + binds that plan automatically when found beside the script or in the current + working directory - **Thread-safe**: nonce generation is mutex-protected; capability context is a thread parameter ### Enforcement @@ -290,6 +295,13 @@ for path/host allowlists. List permissions are covered only when the requested list is a subset of the declaration, with `"*"` and `"/"` treated as explicit wildcards. +The conventional file form is a single S-expression: + +```scheme +((filesystem (read . #t) (write . #f) (execute . #f) (paths "/data")) + (network (connect . #t) (listen . #f) (hosts "api.example.com"))) +``` + ### Related modules - `(std security capability-typed)` -- `define/cap` and `lambda/cap` macros that declare capability requirements in function signatures --- a/lib/jerboa/script-loader.ss +++ b/lib/jerboa/script-loader.ss @@ -7,7 +7,8 @@ jerboa-load-stdin) (import (chezscheme) (prefix (only (jerboa prelude) displayln) raw:) - (prefix (only (jerboa prelude safe) displayln) safe:)) + (prefix (only (jerboa prelude safe) displayln) safe:) + (prefix (std security capability) cap:)) (define max-script-chars (* 16 1024 1024)) @@ -134,6 +135,12 @@ "warning: unsafe prelude enabled for ~a; raw Chez bindings are available\n" label)) + (define (call-with-startup-capability-plan label thunk) + (let ([plan-path (cap:find-capability-plan-file label)]) + (if plan-path + (cap:with-capability-plan-file plan-path thunk) + (thunk)))) + (define (evaluate-script-forms forms unsafe? label) (when unsafe? (warn-unsafe-prelude! label)) @@ -153,10 +160,12 @@ (let* ([source (read-file-bounded path)] [forms (read-script-forms source path)] [unsafe? (or unsafe-flag? (script-requests-unsafe? forms))]) - (evaluate-script-forms forms unsafe? path))) + (call-with-startup-capability-plan path + (lambda () (evaluate-script-forms forms unsafe? path))))) (define (jerboa-load-stdin unsafe-flag?) (let* ([source (read-port-bounded (current-input-port) "stdin")] [forms (read-script-forms source "stdin")] [unsafe? (or unsafe-flag? (script-requests-unsafe? forms))]) - (evaluate-script-forms forms unsafe? "stdin")))) + (call-with-startup-capability-plan "stdin" + (lambda () (evaluate-script-forms forms unsafe? "stdin")))))) --- a/lib/std/security/capability.ss +++ b/lib/std/security/capability.ss @@ -37,6 +37,9 @@ current-capability-plan capability-plan-active? capability-plan-allows? + load-capability-plan-file + find-capability-plan-file + with-capability-plan-file with-capability-plan check-capability! &capability-violation make-capability-violation capability-violation? @@ -313,6 +316,114 @@ (def (capability-plan-active?) (and (current-capability-plan) #t)) + (def max-capability-plan-chars (* 64 1024)) + + (def (load-capability-plan-file path) + (let* ([source (read-capability-plan-source path)] + [port (open-input-string source)] + [plan (get-datum port)]) ; jerboa-security: suppress bare-read-untrusted -- .jerboa/capabilities.sexp is bounded to 64 KiB and schema-validated before use + (unless (eof-object? (get-datum port)) ; jerboa-security: suppress bare-read-untrusted -- second bounded manifest datum check rejects trailing forms + (error 'load-capability-plan-file + "expected exactly one capability-plan datum" + path)) + (validate-capability-plan! path plan) + plan)) + + (def (read-capability-plan-source path) + (call-with-input-file path + (lambda (port) + (let ([out (open-output-string)]) + (let loop ([count 0]) + (when (> count max-capability-plan-chars) + (error 'load-capability-plan-file + "capability plan exceeds 64 KiB character limit" + path)) + (let ([ch (read-char port)]) + (if (eof-object? ch) + (get-output-string out) + (begin + (write-char ch out) + (loop (+ count 1)))))))))) + + (def (find-capability-plan-file . maybe-script-path) + (let* ([script-path (if (pair? maybe-script-path) (car maybe-script-path) #f)] + [candidates (capability-plan-candidates script-path)]) + (let loop ([rest candidates]) + (cond + [(null? rest) #f] + [(file-exists? (car rest)) (car rest)] + [else (loop (cdr rest))])))) + + (def (with-capability-plan-file path thunk) + (with-capability-plan (load-capability-plan-file path) thunk)) + + (def (capability-plan-candidates script-path) + (let ([cwd-plan ".jerboa/capabilities.sexp"]) + (if (and script-path (string? script-path) (not (string=? script-path "stdin"))) ; jerboa-security: suppress non-constant-time-secret-compare -- comparing a public script label to the literal stdin sentinel, not a secret + (let ([script-plan (path-join/simple (path-directory/simple script-path) + ".jerboa/capabilities.sexp")]) + (if (string=? script-plan cwd-plan) + (list cwd-plan) + (list script-plan cwd-plan))) + (list cwd-plan)))) + + (def (path-directory/simple path) + (let loop ([i (- (string-length path) 1)]) + (cond + [(< i 0) "."] + [(char=? (string-ref path i) #\/) (if (= i 0) "/" (substring path 0 i))] + [else (loop (- i 1))]))) + + (def (path-join/simple base rel) + (cond + [(or (string=? base "") (string=? base ".")) rel] + [(string=? base "/") (string-append "/" rel)] + [else (string-append base "/" rel)])) + + (def (validate-capability-plan! path plan) + (unless (list? plan) + (error 'load-capability-plan-file "capability plan must be a list" path plan)) + (let loop ([entries plan]) + (unless (null? entries) + (validate-capability-plan-entry! path (car entries)) + (loop (cdr entries))))) + + (def (validate-capability-plan-entry! path entry) + (unless (and (pair? entry) (symbol? (car entry)) (list? (cdr entry))) + (error 'load-capability-plan-file "invalid capability plan entry" path entry)) + (case (car entry) + [(filesystem) (validate-plan-perms! path entry '(read write execute) '(paths))] ; jerboa-security: suppress bare-read-untrusted -- changed-line scanner maps bounded get-datum manifest parse to this validation clause; source is capped and schema-validated + [(network) (validate-plan-perms! path entry '(connect listen) '(hosts))] + [(process) (validate-plan-perms! path entry '(spawn signal) '())] + [(environment) (validate-plan-perms! path entry '(read write) '())] + [else (error 'load-capability-plan-file + "unknown capability domain" + path + (car entry))])) + + (def (validate-plan-perms! path entry bool-keys list-keys) + (let loop ([perms (cdr entry)]) + (unless (null? perms) + (let ([perm (car perms)]) + (unless (and (pair? perm) (symbol? (car perm))) + (error 'load-capability-plan-file "invalid permission entry" path perm)) + (cond + [(memq (car perm) bool-keys) + (unless (boolean? (cdr perm)) + (error 'load-capability-plan-file "permission must be boolean" path perm))] + [(memq (car perm) list-keys) + (unless (string-list? (cdr perm)) + (error 'load-capability-plan-file "permission must be a string list" path perm))] + [else (error 'load-capability-plan-file "unknown permission" path perm)])) + (loop (cdr perms))))) + + (def (string-list? value) + (and (list? value) + (let loop ([xs value]) + (or (null? xs) + (and (string? (car xs)) + (loop (cdr xs))))))) + (def (with-capability-plan plan thunk) (unless (or (not plan) (list? plan)) (error 'with-capability-plan "expected #f or capability plan alist" plan)) new file mode 100644 --- /dev/null +++ b/tests/fixtures/capability-app/.jerboa/capabilities.sexp @@ -0,0 +1 @@ +((filesystem (read . #t) (write . #f) (execute . #f) (paths "/tmp"))) new file mode 100644 --- /dev/null +++ b/tests/fixtures/capability-app/bad.ss @@ -0,0 +1,4 @@ +#!chezscheme +(import (jerboa prelude safe) + (prefix (std security capability) sc:)) +(sc:make-net-capability 'connect: #t 'hosts: '("example.com")) new file mode 100644 --- /dev/null +++ b/tests/fixtures/capability-app/ok.ss @@ -0,0 +1,4 @@ +#!chezscheme +(import (jerboa prelude safe) + (prefix (std security capability) sc:)) +(sc:make-fs-capability 'read: #t 'write: #f 'paths: '("/tmp")) --- a/tests/test-security-capability.ss +++ b/tests/test-security-capability.ss @@ -9,7 +9,8 @@ (import (scheme) (prefix (std security capability) sc:) - (prefix (std capability) oc:)) + (prefix (std capability) oc:) + (jerboa script-loader)) (define pass-count 0) (define fail-count 0) @@ -35,6 +36,14 @@ (set! fail-count (+ fail-count 1)) (display "FAIL: expected error from ") (write 'expr) (newline)))])) +(define fixture-capability-app "tests/fixtures/capability-app") +(define fixture-capability-plan + "tests/fixtures/capability-app/.jerboa/capabilities.sexp") +(define fixture-capability-ok-script + "tests/fixtures/capability-app/ok.ss") +(define fixture-capability-bad-script + "tests/fixtures/capability-app/bad.ss") + ;; ========== (std security capability) tests ========== (display " Testing (std security capability)...\n") @@ -131,6 +140,22 @@ (sc:with-capability-plan plan (lambda () (sc:make-net-capability 'connect: #t 'hosts: '("example.com")))))) +;; Conventional .jerboa/capabilities.sexp plan loading. +(check (equal? (sc:find-capability-plan-file fixture-capability-ok-script) + fixture-capability-plan) => #t) +(check (sc:with-capability-plan-file fixture-capability-plan + (lambda () + (sc:capability? + (sc:make-fs-capability 'read: #t 'write: #f 'paths: '("/tmp"))))) => #t) +(check-error + (sc:with-capability-plan-file fixture-capability-plan + (lambda () + (sc:make-net-capability 'connect: #t 'hosts: '("example.com"))))) + +;; Script loader binds the conventional startup capability plan. +(check (begin (jerboa-load-script fixture-capability-ok-script #f) #t) => #t) +(check-error (jerboa-load-script fixture-capability-bad-script #f)) + ;; check-capability! raises violation when permission missing (let ([fs-cap (sc:make-fs-capability 'read: #t 'write: #f)]) (check-error