rajamesandClaude Opus 5.5
c1bbcaaba4
- Each entry's flags cell also holds v3's four fields: denied, pinned, mode and a 16-bit TTL. - compile.v4: INTERPRET checks every word it is about to execute or compile -- recheck at TTL 0, else count down; a denied word is refused with v3's line, the stack emptied and the line ended. - capsule/acl.v4: ACL-MODE@ ACL-MODE! ACL-TTL@ ACL-TTL! ACL-ALLOW@ ACL-ALLOW! ACL-PINNED? ACL-PIN ACL-INHERIT ACL-INIT-PRIMITIVES ACL-HEAT@ ACL-WORD-ID, and ACL-HOOK. - capsule/ACL.fth: v3's ACL.4th as FORTH source the node compiles; loading it switches access control on. - v3 checks every execution, inside definitions too. v4's code is native, so it checks a word when it is compiled as well as when interpreted; a call compiled while the word was allowed is not checked again. DECOMPOSITION.md 5.20 says so. - ACL-HEAT@ is 0 until heat is readable (D-6). - tests/test_host_quit.c: seven transcripts of the v3 binary; the policy file loaded and exercised; COLD. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
58 lines
2.0 KiB
Forth
58 lines
2.0 KiB
Forth
\ ACL.fth -- word-level access control: the policy.
|
|
\
|
|
\ This is v3's capsules/ACL.4th, as FORTH source the node compiles itself.
|
|
\ The capsule supplies the fields of an entry and the check (acl.v4,
|
|
\ compile.v4); what is strict, how long a TTL lasts and what is pinned is
|
|
\ decided here. Loading this file switches access control on: its last
|
|
\ line runs ACL-BOOT. A system that does not load it has none.
|
|
\
|
|
\ The xt these words take is what FIND and ['] give: the word's code.
|
|
|
|
FORTH DEFINITIONS
|
|
|
|
1 CONSTANT ACL-STRICT-MODE
|
|
0 CONSTANT ACL-TTL-MODE-VAL
|
|
\ the TTL of a cold word, tuned 2026-06-15 on v3
|
|
256 CONSTANT ACL-BASE-TTL
|
|
65535 CONSTANT ACL-MAX-TTL
|
|
|
|
\ ( xt -- xt ) for symmetry: the xt is the entry
|
|
: ACL-ENTRY ;
|
|
|
|
: 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! ;
|
|
|
|
\ ( xt -- ttl ) a hotter word earns a longer TTL: heat/4 + 256, at most 65535
|
|
: ACL-TTL-COMPUTE ACL-HEAT@ 4 / ACL-BASE-TTL + ACL-MAX-TTL MIN ;
|
|
|
|
\ ( xt -- ) what the check runs when a word's TTL is 0.
|
|
\ STRICT: allow, and leave the TTL 0 so that every use comes back here.
|
|
\ TTL: compute a TTL from the word's heat; allow.
|
|
: ACL-RECHECK
|
|
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! ;
|
|
|
|
\ the system CA's public key; placeholders, as in v3
|
|
0 CONSTANT ACL-CA-KEY-LO
|
|
0 CONSTANT ACL-CA-KEY-HI
|
|
|
|
\ ( req-hi req-lo -- allow? ) the fabric asks this word whether a channel
|
|
\ may be opened. The default approves every request; a policy edits this.
|
|
: HERMES-CHANNEL-OPEN? 2DROP 1 ;
|
|
|
|
\ ( -- ) default fields on every word; the words that enforce the policy
|
|
\ pinned; the recheck switched on
|
|
: ACL-BOOT
|
|
ACL-INIT-PRIMITIVES
|
|
['] ACL-RECHECK ACL-PIN ['] ACL-INIT-PRIMITIVES ACL-PIN
|
|
['] ACL-RECHECK ACL-HOOK !
|
|
LOG-INFO" ACL: active" ;
|
|
' ACL-BOOT ACL-PIN
|
|
|
|
ACL-BOOT
|