Robert Allan JamesandClaude Sonnet 5
f37aa0fb17
Added HERMES-CHANNEL-OPEN? ( req-hi req-lo -- allow? ) at capsules/ACL.4th block 4008 (default: approve everything) -- the one word policy authors edit. sk_hermes_channel_open_policy(VM*, VMUuid) (kernel_hermes.h/.c) is the C-side query that calls it via plain word-dispatch against the target VM's own dictionary/stack, never vm_interpret() (avoids task 3.4's input-buffer cursor hazard entirely) and never decides the answer itself. Fails closed: no policy word, a policy error, or stack underflow all deny, matching CLAUDE.md's posture that absence of policy must never mean "always allow." Two real bugs found and fixed before this was called done: missing current_executing_entry assignment before calling the word's func pointer (colon words silently no-op without it, vm_core.c:730 -- no crash, just a wrong answer); and a second FAIL with debug instrumentation still in place whose precise cause isn't reconstructable, since no intermediate commit exists for that attempt. Self-test proves the task's check four ways against the same unchanged C function: default approve, live redefinition to deny (zero C change), restore, and a VM with no ACL.4th loaded at all (fail closed). A fifth check wires the result into task 3.6's sk_hermes_channel_respond() end to end: a denied policy produces a NACK and no channel, ledger/stadium_conserved() holding throughout. Scope, per Captain Bob's ruling: closes with the query built and proven; sk_hermes_channel_respond() still takes a caller-supplied approved bool rather than calling the policy internally. Wiring a real channel-open call site to only this query is deferred to whichever later task first needs a live decision. dict_hash identical across amd64/aarch64/riscv64 for every VM, zero UNKNOWN WORD, mkcapsule --lint clean (38 files, 0 violations). Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
115 lines
4.2 KiB
Forth
115 lines
4.2 KiB
Forth
Block 4000
|
|
( ACL.4th - Word-Level Access Control for StarForth )
|
|
( DictEntry fields: acl_ttl acl_allow acl_mode acl_pinned )
|
|
( C prims: ACL-MODE@ ACL-MODE! ACL-PINNED? ACL-PIN )
|
|
( ACL-TTL@ ACL-TTL! ACL-ALLOW@ ACL-ALLOW! )
|
|
( ACL-HEAT@ ACL-WORD-ID ACL-INHERIT ACL-INIT-PRIMITIVES )
|
|
( Policy words (this file): ACL-STRICT ACL-TTL-MODE )
|
|
( ACL-TTL-COMPUTE ACL-RECHECK ACL-ENTRY ACL-BOOT )
|
|
( Self-activating: init.4th only needs S" ACL.4th" EXEC )
|
|
( Comment out that line in init.4th for no-security mode. )
|
|
( ACL-BASE-TTL=256: cold-word recheck floor, tuned 2026-06-15 )
|
|
( to cut aarch64/riscv64 TCG recheck overhead ~72% -> ~5%. )
|
|
1 CONSTANT ACL-STRICT-MODE
|
|
0 CONSTANT ACL-TTL-MODE-VAL
|
|
256 CONSTANT ACL-BASE-TTL
|
|
65535 CONSTANT ACL-MAX-TTL
|
|
|
|
Block 4001
|
|
( ACL-ENTRY ( xt -- xt ) )
|
|
( xt IS the DictEntry pointer in StarForth. ACL-ENTRY )
|
|
( is the identity word provided for API symmetry. )
|
|
: ACL-ENTRY ( xt -- xt ) ;
|
|
|
|
Block 4002
|
|
( Mode selector words -- pin-guarded )
|
|
: ACL-STRICT ( xt -- )
|
|
DUP ACL-PINNED? IF DROP EXIT THEN
|
|
ACL-STRICT-MODE SWAP ACL-MODE! ;
|
|
|
|
: ACL-TTL-MODE ( xt -- )
|
|
DUP ACL-PINNED? IF DROP EXIT THEN
|
|
ACL-TTL-MODE-VAL SWAP ACL-MODE! ;
|
|
|
|
Block 4003
|
|
( ACL-TTL-COMPUTE ( xt -- ttl ) )
|
|
( Adaptive TTL from execution heat. Hotter words earn )
|
|
( a longer TTL so recheck cost is amortised. )
|
|
( Formula: heat/4 + ACL-BASE-TTL (256), cap ACL-MAX-TTL. )
|
|
: ACL-TTL-COMPUTE ( xt -- ttl )
|
|
ACL-HEAT@
|
|
4 /
|
|
ACL-BASE-TTL +
|
|
ACL-MAX-TTL MIN ;
|
|
|
|
Block 4004
|
|
( ACL-RECHECK ( xt -- ) )
|
|
( Cold-path policy called by C acl_recheck() at TTL=0.)
|
|
( STRICT: always allow, TTL stays 0 (recheck always). )
|
|
( TTL: compute TTL from heat; set allow=1. )
|
|
: ACL-RECHECK ( xt -- )
|
|
DUP ACL-PINNED? IF DROP EXIT THEN
|
|
DUP ACL-MODE@ ACL-STRICT-MODE = IF
|
|
1 OVER ACL-ALLOW!
|
|
0 OVER ACL-TTL!
|
|
DROP EXIT
|
|
THEN
|
|
DUP ACL-TTL-COMPUTE OVER ACL-TTL!
|
|
1 SWAP ACL-ALLOW! ;
|
|
|
|
Block 4005
|
|
( ACL-BOOT ( -- ) )
|
|
( Stamps default ACL on all existing dict words, then )
|
|
( pins privileged words and ACL words themselves. )
|
|
( BIRTH/CAPSULE-BIRTH are omitted: kernel-only, not in )
|
|
( hosted VM. Pinned in C (kernel_main.c) after capsule )
|
|
( load instead, so this file stays host-portable. )
|
|
: ACL-BOOT ( -- )
|
|
ACL-INIT-PRIMITIVES
|
|
['] EXEC ACL-STRICT ['] EXEC ACL-PIN
|
|
['] BYE ACL-STRICT ['] BYE ACL-PIN
|
|
['] ACL-RECHECK ACL-PIN
|
|
['] ACL-INIT-PRIMITIVES ACL-PIN
|
|
LOG-INFO" ACL: active" ;
|
|
' ACL-BOOT ACL-PIN
|
|
|
|
Block 4006
|
|
( CA ROOT - Ed25519 public key of system CA. )
|
|
( Capsule hash IS the root-of-trust fingerprint; any )
|
|
( change to CA changes hash and birth-protocol rejects)
|
|
( the tampered image. )
|
|
( FUTURE: Replace placeholders at build time via )
|
|
( tools/mkcapsule. Two 16-bit halves for portability. )
|
|
( HUMAN-REVIEW: Verify CA key matches build manifest. )
|
|
0 CONSTANT ACL-CA-KEY-LO
|
|
0 CONSTANT ACL-CA-KEY-HI
|
|
|
|
Block 4007
|
|
( Self-activation placeholder - actual call is in Block 4015 )
|
|
( ACL-BOOT (Block 4005) is the live boot function. )
|
|
( init.4th only needs: S" ACL.4th" EXEC )
|
|
( HISTORICAL: Blocks 4010-4014 held an "ACL Rolling Window of )
|
|
( Truth" TTL mechanism (ACL-RECHECK-RW/ACL-TTL-COMPUTE-RW/ )
|
|
( ACL-RWT-SLOPE-COMPUTE) removed 2026-07-08. It was dead code )
|
|
( from the day it was written: the C hot path's acl_recheck() )
|
|
( looks up the word named exactly "ACL-RECHECK" (11 chars) -- )
|
|
( never "ACL-RECHECK-RW" (14 chars) -- so ACL-BOOT-RW pinning )
|
|
( ACL-RECHECK-RW never made it reachable. Removed rather than )
|
|
( rewired: physics-style regression belongs to the kernel )
|
|
( exclusively, and this file is deliberately host-portable. )
|
|
|
|
Block 4008
|
|
( HERMES-CHANNEL-OPEN? -- FABRIC-3.6.md task 3.7 hook. )
|
|
( Stack: req-hi req-lo -- allow? Kernel-Hermes asks )
|
|
( this word, never decides in C, never gates on )
|
|
( zuse_session (CLAUDE.md). Default: approve every )
|
|
( request. Policy authors edit THIS word's body only -- )
|
|
( kernel_hermes.c's own query function never changes. )
|
|
: HERMES-CHANNEL-OPEN? ( req-hi req-lo -- allow? )
|
|
2DROP 1 ;
|
|
|
|
Block 4015
|
|
( Self-activation - runs after all ACL words are defined )
|
|
ACL-BOOT
|
|
S" zuse.4th" EXEC
|