security: enforce runtime capability plans
Jaime Fournier <jaimef@linbsd.org>
9196fb1275ac3e6677a6d77ffaf131a75c55cf9c
diff --git a/docs/capability.md b/docs/capability.md
index 947cdd5..d4082f0 100644
--- a/docs/capability.md
+++ b/docs/capability.md
@@ -2,6 +2,15 @@
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
+`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.
+
## Overview
In the object-capability model:
diff --git a/docs/kimi3-security-recommmendations.md b/docs/kimi3-security-recommmendations.md
index 4df83ec..2d32502 100644
--- a/docs/kimi3-security-recommmendations.md
+++ b/docs/kimi3-security-recommmendations.md
@@ -748,6 +748,14 @@ they are build-time. Close the runtime loop.
grant).
- **Accept:** undeclared-grant refusal test; audit-chain verification
test; lint rule fires on a synthetic over-grant.
+- **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.
### K3-P1-10 — Information-leak sweep: errors, logs, and protocol surfaces
**Serves:** G2, G4. **Effort:** 1 week.
diff --git a/docs/security-reference.md b/docs/security-reference.md
index 2b838cf..91a85fb 100644
--- a/docs/security-reference.md
+++ b/docs/security-reference.md
@@ -251,6 +251,9 @@ Access rights are unforgeable tokens (sealed, opaque records with CSPRNG nonces)
lexical checks only for missing create-target leaves
- **Default deny for hosts**: empty host list means no hosts allowed (not all allowed)
- **Intersection**: `with-capabilities` intersects child capabilities against parent per-permission (ANDs booleans, set-intersects lists)
+- **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`
- **Thread-safe**: nonce generation is mutex-protected; capability context is a thread parameter
### Enforcement
@@ -258,13 +261,27 @@ Access rights are unforgeable tokens (sealed, opaque records with CSPRNG nonces)
```scheme
(import (std security capability))
-(let ([cap (make-fs-capability read: #t write: #f paths: '("/data"))])
- (with-capabilities (list cap)
- (check-capability! 'filesystem 'read "/data/config.scm") ;; ok
- (check-capability! 'filesystem 'write "/data/config.scm") ;; raises &capability-violation
- ))
+(define plan
+ '((filesystem (read . #t) (write . #f) (execute . #f) (paths "/data"))))
+
+(with-capability-plan plan
+ (lambda ()
+ (let ([cap (make-fs-capability read: #t write: #f paths: '("/data"))])
+ (with-capabilities (list cap)
+ (check-capability! 'filesystem 'read "/data/config.scm")))))
+
+(with-capability-plan plan
+ (lambda ()
+ (make-fs-capability read: #t write: #t paths: '("/data"))))
+;; raises &capability-violation: undeclared grant
```
+Grant plans are alists keyed by capability domain. Permission values use the
+same shape as `capability-permissions`: booleans for scalar rights and lists
+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.
+
### Related modules
- `(std security capability-typed)` -- `define/cap` and `lambda/cap` macros that declare capability requirements in function signatures
diff --git a/lib/std/security/capability.ss b/lib/std/security/capability.ss
index 7858fc1..9b42f13 100644
--- a/lib/std/security/capability.ss
+++ b/lib/std/security/capability.ss
@@ -34,6 +34,10 @@
;; Capability context
with-capabilities
current-capabilities
+ current-capability-plan
+ capability-plan-active?
+ capability-plan-allows?
+ with-capability-plan
check-capability!
&capability-violation make-capability-violation capability-violation?
capability-violation-type capability-violation-detail
@@ -59,6 +63,11 @@
(def capability-permissions %capability-permissions)
(def (make-cap type perms)
+ (unless (capability-plan-allows? type perms)
+ (raise (condition
+ (make-capability-violation type 'undeclared-grant)
+ (make-message-condition
+ (format "capability grant not declared: ~a" type)))))
(%make-capability (random-bytes 16) type perms))
;; ========== Capability Violation Condition ==========
@@ -298,6 +307,56 @@
(def current-capabilities
(make-thread-parameter '()))
+ (def current-capability-plan
+ (make-thread-parameter #f))
+
+ (def (capability-plan-active?)
+ (and (current-capability-plan) #t))
+
+ (def (with-capability-plan plan thunk)
+ (unless (or (not plan) (list? plan))
+ (error 'with-capability-plan "expected #f or capability plan alist" plan))
+ (parameterize ([current-capability-plan plan])
+ (thunk)))
+
+ (def (capability-plan-allows? type perms)
+ (let ([plan (current-capability-plan)])
+ (if (not plan)
+ #t
+ (exists (lambda (entry)
+ (and (pair? entry)
+ (eq? (car entry) type)
+ (permissions-covered? perms (cdr entry))))
+ plan))))
+
+ (def (permissions-covered? requested declared)
+ (let lp ([xs requested])
+ (cond
+ [(null? xs) #t]
+ [else
+ (let* ([req (car xs)]
+ [decl (and (pair? req) (assq (car req) declared))])
+ (and (pair? req)
+ (permission-covered? (cdr req) (if decl (cdr decl) #f))
+ (lp (cdr xs))))])))
+
+ (def (permission-covered? requested declared)
+ (cond
+ [(boolean? requested) (or (not requested) (eq? declared #t))]
+ [(list? requested)
+ (and (list? declared)
+ (or (member "*" declared)
+ (member "/" declared)
+ (list-subset? requested declared)))]
+ [else (equal? requested declared)]))
+
+ (def (list-subset? xs allowed)
+ (let lp ([rest xs])
+ (cond
+ [(null? rest) #t]
+ [(member (car rest) allowed) (lp (cdr rest))]
+ [else #f])))
+
(def (check-capability! type permission . detail)
;; Check if current context has the required capability.
;; Raises &capability-violation if not.
diff --git a/tests/test-security-capability.ss b/tests/test-security-capability.ss
index baa64be..170815f 100644
--- a/tests/test-security-capability.ss
+++ b/tests/test-security-capability.ss
@@ -97,6 +97,40 @@
(check (sc:with-capabilities (list fs-cap)
(lambda () (sc:check-capability! 'filesystem 'read) #t)) => #t))
+;; Runtime capability plan allows declared grants.
+(let ([plan (list (list 'filesystem
+ (cons 'read #t)
+ (cons 'write #f)
+ (cons 'execute #f)
+ (cons 'paths '("/tmp")))
+ (list 'network
+ (cons 'connect #t)
+ (cons 'listen #f)
+ (cons 'hosts '("example.com"))))])
+ (check (sc:with-capability-plan plan
+ (lambda ()
+ (and (sc:capability-plan-active?)
+ (sc:capability?
+ (sc:make-fs-capability 'read: #t 'write: #f 'paths: '("/tmp")))))) => #t)
+ (check (sc:with-capability-plan plan
+ (lambda ()
+ (and (sc:capability?
+ (sc:make-net-capability 'connect: #t 'hosts: '("example.com")))
+ #t))) => #t))
+
+;; Runtime capability plan refuses undeclared grants.
+(let ([plan (list (list 'filesystem
+ (cons 'read #t)
+ (cons 'write #f)
+ (cons 'execute #f)
+ (cons 'paths '("/tmp"))))])
+ (check-error
+ (sc:with-capability-plan plan
+ (lambda () (sc:make-fs-capability 'read: #t 'write: #t 'paths: '("/tmp")))))
+ (check-error
+ (sc:with-capability-plan plan
+ (lambda () (sc:make-net-capability 'connect: #t 'hosts: '("example.com"))))))
+
;; check-capability! raises violation when permission missing
(let ([fs-cap (sc:make-fs-capability 'read: #t 'write: #f)])
(check-error