diff --git a/lib/acl/audit.sx b/lib/acl/audit.sx index 506a6786..94324db5 100644 --- a/lib/acl/audit.sx +++ b/lib/acl/audit.sx @@ -3,12 +3,23 @@ ;; Every decision routed through acl-audit-decide! is appended to an in-memory ;; log with a monotonic sequence number (no wall-clock — deterministic and ;; testable; a host can stamp time at the serializer boundary). The log is -;; append-only: there is no mutate or delete, only append, tail, clear, and -;; serialize-for-disk. +;; append-only: there is no mutate or delete, only append, tail, clear, +;; snapshot/restore, and serialize-for-disk. (define acl-audit-log (list)) (define acl-audit-seq 0) +;; Copy a list into a fresh, append!-able list. `map`/`rest`-derived lists are +;; NOT extensible by append! in this runtime (it silently no-ops), so the live +;; log must always be a list built with `list` + `append!`. +(define + acl-audit-copy + (fn + (xs) + (let + ((fresh (list))) + (do (for-each (fn (e) (append! fresh e)) xs) fresh)))) + (define acl-audit-clear! (fn @@ -57,8 +68,25 @@ (xs k) (if (<= k 0) xs (acl-audit-drop (rest xs) (- k 1))))) +;; Structured snapshot for save/restore — a {:seq :entries} value carrying a +;; copy of the log (so later appends don't mutate a held snapshot). +(define acl-audit-snapshot (fn () {:seq acl-audit-seq :entries (acl-audit-copy acl-audit-log)})) + +;; Replace the live log from a snapshot. Restores both entries and the seq +;; counter so subsequent records continue numbering correctly. The log is +;; rebuilt as a fresh append!-able list (see acl-audit-copy). +(define + acl-audit-restore! + (fn + (snap) + (do + (set! acl-audit-log (acl-audit-copy (get snap :entries))) + (set! acl-audit-seq (get snap :seq)) + nil))) + ;; Serialize the whole log to a disk-ready string: one record per line, -;; "seq\tsubj\tact\tres\tallowed?". A host writes this; reload is out of scope. +;; "seq\tsubj\tact\tres\tallowed?". A host writes this; structured reload is via +;; snapshot/restore. (define acl-audit-serialize (fn diff --git a/lib/acl/conformance.conf b/lib/acl/conformance.conf index f39964a0..5992b8ce 100644 --- a/lib/acl/conformance.conf +++ b/lib/acl/conformance.conf @@ -28,4 +28,5 @@ SUITES=( "inherit:lib/acl/tests/inherit.sx:(acl-inherit-tests-run!)" "explain:lib/acl/tests/explain.sx:(acl-explain-tests-run!)" "fed:lib/acl/tests/fed.sx:(acl-fed-tests-run!)" + "harden:lib/acl/tests/harden.sx:(acl-harden-tests-run!)" ) diff --git a/lib/acl/schema.sx b/lib/acl/schema.sx index 04beac45..21f78c46 100644 --- a/lib/acl/schema.sx +++ b/lib/acl/schema.sx @@ -50,3 +50,22 @@ (and (has-key? acl-edb-arity pred) (= (- (len f) 1) (get acl-edb-arity pred))))))) + +;; Return the sublist of facts that fail acl-fact-valid?. Empty list means the +;; whole set is well-formed. acl-build-db stays lenient (Datalog accepts any +;; tuple, and custom action symbols are allowed); callers opt in to checking. +(define + acl-validate-facts + (fn + (facts) + (let + ((bad (list))) + (do + (for-each + (fn (f) (when (not (acl-fact-valid? f)) (append! bad f))) + facts) + bad)))) + +(define + acl-facts-valid? + (fn (facts) (= (len (acl-validate-facts facts)) 0))) diff --git a/lib/acl/scoreboard.json b/lib/acl/scoreboard.json index a93ecedc..2eb9ee59 100644 --- a/lib/acl/scoreboard.json +++ b/lib/acl/scoreboard.json @@ -1,13 +1,14 @@ { "lang": "acl", - "total_passed": 120, + "total_passed": 145, "total_failed": 0, - "total": 120, + "total": 145, "suites": [ {"name":"direct","passed":24,"failed":0,"total":24}, {"name":"inherit","passed":30,"failed":0,"total":30}, {"name":"explain","passed":35,"failed":0,"total":35}, - {"name":"fed","passed":31,"failed":0,"total":31} + {"name":"fed","passed":31,"failed":0,"total":31}, + {"name":"harden","passed":25,"failed":0,"total":25} ], - "generated": "2026-06-06T16:53:44+00:00" + "generated": "2026-06-06T22:43:27+00:00" } diff --git a/lib/acl/scoreboard.md b/lib/acl/scoreboard.md index 88e69e18..7de786ea 100644 --- a/lib/acl/scoreboard.md +++ b/lib/acl/scoreboard.md @@ -1,6 +1,6 @@ # acl scoreboard -**120 / 120 passing** (0 failure(s)). +**145 / 145 passing** (0 failure(s)). | Suite | Passed | Total | Status | |-------|--------|-------|--------| @@ -8,3 +8,4 @@ | inherit | 30 | 30 | ok | | explain | 35 | 35 | ok | | fed | 31 | 31 | ok | +| harden | 25 | 25 | ok | diff --git a/lib/acl/tests/harden.sx b/lib/acl/tests/harden.sx new file mode 100644 index 00000000..b32c3098 --- /dev/null +++ b/lib/acl/tests/harden.sx @@ -0,0 +1,228 @@ +;; lib/acl/tests/harden.sx — adversarial / cross-phase hardening. +;; +;; Diamond hierarchies, conflict resolution where deny must win through every +;; path, chain inheritance, cycle termination, multi-peer delegation, fact +;; validation, and audit save/restore. +;; +;; PROVER-FREE BY DESIGN: this suite calls only acl-permit? (which runs in +;; compiled Datalog, safe at any depth) plus pure data ops — never acl-explain / +;; acl-prove-d. The SX-side proof reconstructor recurses, and once the kernel +;; JIT-compiles it (after the explain/fed suites warm the process) it loops on +;; chains deeper than ~3 (substrate JIT bug — see plan Blockers). Proof +;; reconstruction is covered by tests/explain.sx (and federated proofs by +;; tests/fed.sx), both of which stay under the warm-process depth threshold. + +(define acl-hd-pass 0) +(define acl-hd-fail 0) +(define acl-hd-failures (list)) + +(define + acl-hd-check! + (fn + (name got expected) + (if + (= got expected) + (set! acl-hd-pass (+ acl-hd-pass 1)) + (do + (set! acl-hd-fail (+ acl-hd-fail 1)) + (append! + acl-hd-failures + (str name "\n expected: " expected "\n got: " got)))))) + +(define acl-hd-p? (fn (db s a r) (acl-permit? db s a r))) + +(define + acl-hd-run-all! + (fn + () + (do + (let + ((grant-deny (acl-build-db (list (acl-child-of (quote r) (quote p1)) (acl-child-of (quote r) (quote p2)) (acl-grant (quote u) (quote read) (quote p1)) (acl-deny (quote u) (quote read) (quote p2))))) + (both-grant + (acl-build-db + (list + (acl-child-of (quote r) (quote p1)) + (acl-child-of (quote r) (quote p2)) + (acl-grant (quote u) (quote read) (quote p1)) + (acl-grant (quote u) (quote read) (quote p2)))))) + (do + (acl-hd-check! + "diamond resource: grant+deny parents -> deny wins" + (acl-hd-p? grant-deny (quote u) (quote read) (quote r)) + false) + (acl-hd-check! + "diamond resource: both grant -> permit" + (acl-hd-p? both-grant (quote u) (quote read) (quote r)) + true) + (acl-hd-check! + "diamond resource: deny does not leak to other parent" + (acl-hd-p? grant-deny (quote u) (quote read) (quote p1)) + true))) + (let + ((grant-deny (acl-build-db (list (acl-member-of (quote alice) (quote g1)) (acl-member-of (quote alice) (quote g2)) (acl-grant (quote g1) (quote read) (quote doc)) (acl-deny (quote g2) (quote read) (quote doc))))) + (both-grant + (acl-build-db + (list + (acl-member-of (quote alice) (quote g1)) + (acl-member-of (quote alice) (quote g2)) + (acl-grant (quote g1) (quote read) (quote doc)) + (acl-grant (quote g2) (quote read) (quote doc)))))) + (do + (acl-hd-check! + "diamond group: grant+deny groups -> deny wins" + (acl-hd-p? grant-deny (quote alice) (quote read) (quote doc)) + false) + (acl-hd-check! + "diamond group: both grant -> permit" + (acl-hd-p? both-grant (quote alice) (quote read) (quote doc)) + true))) + (let + ((chain (acl-build-db (list (acl-member-of (quote a0) (quote a1)) (acl-member-of (quote a1) (quote a2)) (acl-member-of (quote a2) (quote a3)) (acl-member-of (quote a3) (quote a4)) (acl-grant (quote a4) (quote read) (quote res))))) + (chain-deny + (acl-build-db + (list + (acl-member-of (quote a0) (quote a1)) + (acl-member-of (quote a1) (quote a2)) + (acl-member-of (quote a2) (quote a3)) + (acl-member-of (quote a3) (quote a4)) + (acl-grant (quote a4) (quote read) (quote res)) + (acl-deny (quote a0) (quote read) (quote res)))))) + (do + (acl-hd-check! + "chain: top-group grant reaches leaf member" + (acl-hd-p? chain (quote a0) (quote read) (quote res)) + true) + (acl-hd-check! + "chain: intermediate also covered" + (acl-hd-p? chain (quote a2) (quote read) (quote res)) + true) + (acl-hd-check! + "chain: leaf-member deny overrides top grant" + (acl-hd-p? chain-deny (quote a0) (quote read) (quote res)) + false) + (acl-hd-check! + "chain: deny on leaf does not block sibling level" + (acl-hd-p? chain-deny (quote a1) (quote read) (quote res)) + true))) + (let + ((self-member (acl-build-db (list (acl-member-of (quote a) (quote a)) (acl-grant (quote a) (quote read) (quote r))))) + (self-child + (acl-build-db + (list + (acl-child-of (quote r) (quote r)) + (acl-grant (quote u) (quote read) (quote r))))) + (two-cycle + (acl-build-db + (list + (acl-member-of (quote x) (quote y)) + (acl-member-of (quote y) (quote x)) + (acl-grant (quote y) (quote read) (quote r)))))) + (do + (acl-hd-check! + "self-membership cycle terminates and grants" + (acl-hd-p? self-member (quote a) (quote read) (quote r)) + true) + (acl-hd-check! + "self-child cycle terminates and grants" + (acl-hd-p? self-child (quote u) (quote read) (quote r)) + true) + (acl-hd-check! + "two-node membership cycle terminates" + (acl-hd-p? two-cycle (quote x) (quote read) (quote r)) + true))) + (let + ((db (acl-build-db (list (acl-trust (quote alpha) (quote full)) (acl-level-covers (quote full) (quote read)) (acl-member-of (quote alice) (quote team)) (acl-delegate (quote alpha) (quote team) (quote read) (quote doc)) (acl-deny (quote alice) (quote read) (quote doc)))))) + (acl-hd-check! + "federated group grant, local member deny -> deny wins" + (acl-hd-p? db (quote alice) (quote read) (quote doc)) + false)) + (let + ((db (acl-build-db (list (acl-trust (quote alpha) (quote full)) (acl-level-covers (quote full) (quote read)) (acl-delegate (quote alpha) (quote bob) (quote read) (quote doc)) (acl-delegate (quote beta) (quote bob) (quote read) (quote doc)))))) + (acl-hd-check! + "two peers delegate, one trusted -> permit" + (acl-hd-p? db (quote bob) (quote read) (quote doc)) + true)) + (let + ((db (acl-build-db (list (acl-trust (quote alpha) (quote full)) (acl-trust (quote beta) (quote full)) (acl-level-covers (quote full) (quote read)) (acl-delegate (quote alpha) (quote bob) (quote read) (quote doc)) (acl-delegate (quote beta) (quote bob) (quote read) (quote doc)))))) + (acl-hd-check! + "two peers both trusted -> permit" + (acl-hd-p? db (quote bob) (quote read) (quote doc)) + true)) + (let + ((empty (acl-build-db (list)))) + (acl-hd-check! + "empty db: nothing permitted" + (acl-hd-p? empty (quote u) (quote read) (quote r)) + false)) + (do + (acl-hd-check! + "validate: clean set has no bad facts" + (len + (acl-validate-facts + (list + (acl-grant (quote u) (quote read) (quote p)) + (acl-member-of (quote u) (quote g)) + (acl-delegate (quote pe) (quote u) (quote read) (quote p))))) + 0) + (acl-hd-check! + "validate: facts-valid? true on clean set" + (acl-facts-valid? + (list (acl-grant (quote u) (quote read) (quote p)))) + true) + (acl-hd-check! + "validate: surfaces wrong-arity and unknown predicate" + (len + (acl-validate-facts + (list + (acl-grant (quote u) (quote read) (quote p)) + (list (quote grant) (quote u)) + (list (quote bogus) (quote x) (quote y))))) + 2) + (acl-hd-check! + "validate: empty set is valid" + (acl-facts-valid? (list)) + true)) + (let + ((db (acl-build-db (list (acl-grant (quote u) (quote read) (quote p)) (acl-deny (quote u) (quote edit) (quote p)))))) + (do + (acl-audit-clear!) + (acl-audit-decide! db (quote u) (quote read) (quote p)) + (acl-audit-decide! db (quote u) (quote edit) (quote p)) + (let + ((snap (acl-audit-snapshot))) + (do + (acl-audit-clear!) + (acl-hd-check! + "audit: cleared count is 0" + (acl-audit-count) + 0) + (acl-audit-restore! snap) + (acl-hd-check! + "audit: restored count" + (acl-audit-count) + 2) + (acl-hd-check! + "audit: restored last act" + (get (first (acl-audit-tail 1)) :act) + (quote edit)) + (acl-audit-decide! db (quote u) (quote comment) (quote p)) + (acl-hd-check! + "audit: seq continues after restore" + (get (first (acl-audit-tail 1)) :seq) + 2) + (acl-hd-check! + "audit: snapshot is an immutable copy" + (len (get snap :entries)) + 2) + (acl-audit-clear!)))))))) + +(define + acl-harden-tests-run! + (fn + () + (do + (set! acl-hd-pass 0) + (set! acl-hd-fail 0) + (set! acl-hd-failures (list)) + (acl-hd-run-all!) + {:failures acl-hd-failures :total (+ acl-hd-pass acl-hd-fail) :passed acl-hd-pass :failed acl-hd-fail}))) diff --git a/plans/acl-on-sx.md b/plans/acl-on-sx.md index ab303381..b100b2a3 100644 --- a/plans/acl-on-sx.md +++ b/plans/acl-on-sx.md @@ -15,7 +15,7 @@ and federation extension. Reuses `lib/datalog/` evaluator and term model where p ## Status (rolling) -`bash lib/acl/conformance.sh` → **120/120** (all four phases complete) +`bash lib/acl/conformance.sh` → **145/145** (all four phases + hardening) ## Ground rules @@ -224,6 +224,58 @@ One engine rule carries federation: forms. `sx_write_file`, `sx_validate`, `sx_find_all`, `sx_summarise`, `sx_eval` all work; used full-file rewrites instead of path edits throughout. +## Hardening (post-roadmap) + +- **`lib/acl/tests/harden.sx` (+25).** Adversarial / cross-phase coverage beyond + the per-phase suites. **Prover-free by design** (see JIT blocker below): only + `acl-permit?` (compiled Datalog, safe at any depth) + pure data ops, never + `acl-explain`/`acl-prove-d`. + - Diamond hierarchies (resource and group): grant on one path + deny on + another → deny wins; both-grant → permit; deny does not leak to siblings. + - Chain inheritance (literal 4-link): top-group grant reaches leaf member and + intermediates; leaf-member deny overrides the top grant; deny on the leaf + doesn't block a higher level. + - Cycle termination: self-membership, self-child, and 2-node membership cycles + all reach a fixpoint and decide correctly. + - Federation conflicts: federated group-grant with a locally-denied member → + deny; multi-peer delegation (one trusted, or both trusted) → permit. + - Degenerate inputs: empty db permits nothing. + - Fact validation: `acl-validate-facts` surfaces wrong-arity + unknown + predicates; `acl-facts-valid?` on clean/empty sets. + - Audit save/restore: snapshot → clear → restore round-trips entries + seq; + seq continues without collision after restore; snapshot is an immutable copy. + - Proof reconstruction itself is covered by tests/explain.sx + tests/fed.sx + (both stay under the warm-process JIT depth threshold); the depth-cap safety + net is verified manually in a warm REPL image but excluded from conformance. +- **New API:** `acl-validate-facts`/`acl-facts-valid?` (schema.sx, opt-in — build + stays lenient); `acl-audit-snapshot`/`acl-audit-restore!`/`acl-audit-copy` + (audit.sx). +- **Substrate gotcha (recorded):** `append!` extends a list built with `(list)` + but **silently no-ops on a `map`/`rest`-derived list** in this runtime. Bit the + first cut of `acl-audit-restore!` (rebuilt the live log via `map`, so later + records didn't append). Fix: always rebuild mutable lists via `(list)` + + `append!` (`acl-audit-copy`). Worth flagging to kernel owners; out of acl scope. + ## Blockers -(loop fills this in) +- **JIT loops on deep proof reconstruction (substrate, not acl).** Once the + kernel JIT-compiles the mutually-recursive prover (`acl-prove-d`/ + `acl-prove-rules`/`acl-prove-build` in `explain.sx`) — which happens after a + process has run enough explains to cross the compile threshold — the compiled + version **loops indefinitely** on a `member_of`/`child_of` chain deeper than + ~3. Symptoms: `acl-explain` over a 4+-deep chain returns instantly in a cold / + warm-REPL image but **hangs** in a long-lived process. The per-phase explain + and fed suites pass only because their proofs stay ≤3 deep; a 5th suite that + explained deeper chains hung the whole conformance run (no per-suite timeout + in dict mode). Matches `[[project_jit_bytecode_bug]]` (ACTIVE). + - *Impact beyond tests:* `acl-explain` is unsafe for deep hierarchies in a + warm production OCaml server. `acl-permit?` is unaffected (it reduces to + compiled Datalog, no SX-side recursion) — only the SX proof reconstructor is. + - *Workaround in acl:* harden suite is prover-free; explain is exercised only + at shallow depth. *Real fix is in the kernel JIT* (out of acl scope) — e.g. + the `_jit_compiling` guard / disabling JIT for the recursive prover, or + fixing the bytecode loop. Recommend the kernel owners reproduce with: + `acl-explain` over a 6-deep `member_of` chain after ~70 prior explains. + - *Minimal repro recorded.* Until fixed, callers needing explanations for + deep hierarchies should flatten or cap depth, or run explain in a cold + worker.