feat(v4.0.0): word-level access control at the prompt, as v3
- 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>
This commit is contained in:
rajames
co-authored by
Claude Opus 5.5
Claude Opus 5.5
parent
384a6c1cd2
commit
c1bbcaaba4
@@ -64,6 +64,7 @@
|
||||
#define SRC (BVARS + 8)
|
||||
#define SRC_HOOK (BVARS + 9)
|
||||
#define STORAGE_REG (BVARS + 10)
|
||||
#define ACL_HOOK (BUF0_W - 6) /* the xt of the access control recheck word, or 0 */
|
||||
#define LOG_LEVEL (BUF0_W - 5) /* the level at or below which a message is printed */
|
||||
#define BOOT_CELLS (BVARS + 14) /* (BOOT): DP and LATEST as the loader left them, 2 cells */
|
||||
#define BUF0_W (BVARS - 2 * 256) /* the two block buffers, 256 cells each */
|
||||
@@ -132,6 +133,7 @@ static int host_load(v4_text *tx, v4_node *n, const char *const *files, unsigned
|
||||
v4_text_constant(tx, "(B)", BVARS);
|
||||
v4_text_constant(tx, "(BOOT)", BOOT_CELLS);
|
||||
v4_text_constant(tx, "(LOG-LEVEL)", LOG_LEVEL);
|
||||
v4_text_constant(tx, "(ACL-HOOK)", ACL_HOOK);
|
||||
v4_text_constant(tx, "SCR", SCR);
|
||||
v4_text_constant(tx, "BLK", BLK);
|
||||
v4_text_constant(tx, "(SRC)", SRC);
|
||||
|
||||
@@ -102,6 +102,8 @@ static void boot_with(unsigned depth)
|
||||
n.mem[BOOT_CELLS + 1] = capsule_latest;
|
||||
n.mem[FENCE] = DICT_W;
|
||||
n.mem[LOG_LEVEL] = 2;
|
||||
n.mem[ACL_HOOK] = 0;
|
||||
for (v4_cell xt = capsule_latest; xt != 0; xt = n.mem[xt - 1]) n.mem[xt - 3] &= 31; /* the capsule's words: no access control fields set */
|
||||
n.mem[CONTEXT] = LATEST;
|
||||
n.mem[CURRENT] = LATEST;
|
||||
n.mem[VOC_LINK] = 0;
|
||||
@@ -165,7 +167,11 @@ static int load_source(const char *name)
|
||||
size_t len = strlen(line);
|
||||
num++;
|
||||
if (len == 0 || line[len - 1] != '\n' || len > 80) { printf(" %s line %u: too long\n", name, num); fclose(f); return 0; }
|
||||
if (strcmp(say(line), " ok\nok> ") != 0) { printf(" %s line %u: %s", name, num, line); printf(" -> "); fputs(out, stdout); printf("\n"); fclose(f); return 0; }
|
||||
(void)say(line);
|
||||
/* every line is accepted: whatever it printed, it ended with " ok" and never with ERROR */
|
||||
if (strlen(out) < 9 || strcmp(out + strlen(out) - 9, "\n ok\nok> ") != 0 || strstr(out, " ERROR\n")) {
|
||||
if (strcmp(out, " ok\nok> ") != 0) { printf(" %s line %u: %s", name, num, line); printf(" -> "); fputs(out, stdout); printf("\n"); fclose(f); return 0; }
|
||||
}
|
||||
}
|
||||
fclose(f);
|
||||
return n.mem[STATE] == 0;
|
||||
@@ -381,6 +387,29 @@ static const transcript script[] = {
|
||||
{ "Q.0 Q.LOG 65 EMIT\n-1 Q.FROM-INT Q.LOG\n", "Argument out of range\n ERROR\nok> Argument out of range\n ERROR\nok> ", 0 },
|
||||
{ "7 PAD -1 DUMP 65 EMIT\n.S\n", "Negative count\n ERROR\nok> <1> 7 \n ok\nok> ", 0 },
|
||||
{ "PAD 0 DUMP\n", " ok\nok> ", 1 },
|
||||
/* acl.v4: the fields of an entry, and the check, as v3 */
|
||||
{ ": FOO 65 EMIT ; ' FOO ACL-MODE@ . ' FOO ACL-TTL@ . ' FOO ACL-ALLOW@ .\n' FOO ACL-PINNED? .\n", "0 0 -1 ok\nok> 0 ok\nok> ", 1 },
|
||||
{ ": FOO 65 EMIT ; 1 ' FOO ACL-MODE! 77 ' FOO ACL-TTL! ' FOO ACL-MODE@ .\n' FOO ACL-TTL@ . FOO ' FOO ACL-TTL@ .\n", "1 ok\nok> 77 A76 ok\nok> ", 1 },
|
||||
{ ": FOO 65 EMIT ; ' FOO ACL-PIN ' FOO ACL-PINNED? . 5 ' FOO ACL-TTL!\n0 ' FOO ACL-ALLOW! 1 ' FOO ACL-MODE!\n' FOO ACL-TTL@ . ' FOO ACL-ALLOW@ . ' FOO ACL-MODE@ .\n",
|
||||
"-1 ok\nok> ok\nok> 0 -1 0 ok\nok> ", 1 },
|
||||
{ ": A 1 ; : B 2 ; 1 ' A ACL-MODE! ' A ACL-PIN ' B ACL-PIN ' A ' B ACL-INHERIT\n' B ACL-MODE@ . ' B ACL-PINNED? . ' B ACL-TTL@ . ' B ACL-ALLOW@ .\n",
|
||||
" ok\nok> 1 0 0 -1 ok\nok> ", 1 },
|
||||
{ "-5 ' DUP ACL-TTL! ' DUP ACL-TTL@ . 3 ' DUP ACL-MODE! ' DUP ACL-MODE@ .\n", "0 3 ok\nok> ", 1 },
|
||||
{ "' DUP ACL-TTL@ . ' DUP ACL-MODE@ . ' DUP ACL-ALLOW@ . ' DUP ACL-PINNED? .\n", "0 0 -1 0 ok\nok> ", 1 },
|
||||
{ ": FOO 65 EMIT ; 5 ' FOO ACL-TTL! 0 ' FOO ACL-ALLOW! 1 2 FOO 66 EMIT\n.S ' FOO ACL-TTL@ .\n",
|
||||
"\033[33mWARN: \033[0mACL: denied 'FOO'\n ERROR\nok> <0> \n4 ok\nok> ", 1 },
|
||||
/* v4's own: the TTL is sixteen bits; a denied word cannot be compiled; with no policy a recheck allows */
|
||||
{ ": BAZ 67 EMIT ; 0 ' BAZ ACL-ALLOW! BAZ ' BAZ ACL-TTL@ . ' BAZ ACL-ALLOW@ .\n", "C65535 -1 ok\nok> ", 0 },
|
||||
{ ": FOO 65 EMIT ; 5 ' FOO ACL-TTL! 0 ' FOO ACL-ALLOW! : BAR FOO ; 66 EMIT\nBAR\n' FOO ACL-TTL@ .\n",
|
||||
"\033[33mWARN: \033[0mACL: denied 'FOO'\n ERROR\nok> UNKNOWN WORD: 'BAR'\n ERROR\nok> 4 ok\nok> ", 0 },
|
||||
{ ": FOO 65 EMIT ; : BAR FOO ; 5 ' FOO ACL-TTL! 0 ' FOO ACL-ALLOW! BAR\n", "A ok\nok> ", 0 },
|
||||
{ "99999 ' DUP ACL-TTL! ' DUP ACL-TTL@ . 65535 ' DUP ACL-TTL! ' DUP ACL-TTL@ .\n", "65535 65535 ok\nok> ", 0 },
|
||||
{ "258 ' DUP ACL-MODE! ' DUP ACL-MODE@ . 0 ' DUP ACL-ALLOW! ' DUP ACL-ALLOW@ .\n7 ' DUP ACL-ALLOW! ' DUP ACL-ALLOW@ . ' DUP ACL-TTL@ .\n", "2 0 ok\nok> -1 0 ok\nok> ", 0 },
|
||||
{ "7 0 ACL-MODE@ 65 EMIT\n0 ACL-PIN\n1 0 ACL-TTL!\n.S\n", "Not a word\n ERROR\nok> Not a word\n ERROR\nok> Not a word\n ERROR\nok> <2> 7 1 \n ok\nok> ", 0 },
|
||||
{ ": W1 ; ' W1 ACL-WORD-ID ' W1 = . ' W1 ACL-HEAT@ .\n", "-1 0 ok\nok> ", 0 },
|
||||
{ ": IM 65 EMIT ; IMMEDIATE 3 ' IM ACL-TTL! 0 ' IM ACL-ALLOW! : U IM ;\n", "\033[33mWARN: \033[0mACL: denied 'IM'\n ERROR\nok> ", 0 },
|
||||
{ ": P1 ; : P2 ; VOCABULARY VV VV DEFINITIONS : P3 ; FORTH DEFINITIONS\n9 ' P1 ACL-TTL! 1 ' P2 ACL-MODE! ' P2 ACL-PIN VV 9 ' P3 ACL-TTL!\nACL-INIT-PRIMITIVES ' P1 ACL-TTL@ . ' P2 ACL-MODE@ . ' P3 ACL-TTL@ . FORTH\n",
|
||||
" ok\nok> ok\nok> 0 1 0 ok\nok> ", 0 },
|
||||
/* log.v4: v3's lines, colours and all, without its time of day */
|
||||
{ "LOG-LEVEL@ . LOG-ERROR . LOG-WARN . LOG-INFO . LOG-TEST . LOG-DEBUG .\n",
|
||||
"2 0 1 2 3 4 ok\nok> ", 1 },
|
||||
@@ -578,8 +607,8 @@ int main(void)
|
||||
printf("v4 host prompt tests: V4_CELL_BITS=%d, V4_NODE_WORDS=%u\n", V4_CELL_BITS, (unsigned)V4_NODE_WORDS);
|
||||
|
||||
{
|
||||
static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4", "compile.v4", "quit.v4", "forth.v4", "numout.v4", "words.v4", "system.v4", "qmath.v4", "blocks.v4", "log.v4" };
|
||||
CHECK(host_load(&tx, &n, files, 13), "the capsule assembles");
|
||||
static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4", "compile.v4", "quit.v4", "forth.v4", "numout.v4", "words.v4", "system.v4", "qmath.v4", "blocks.v4", "log.v4", "acl.v4" };
|
||||
CHECK(host_load(&tx, &n, files, 14), "the capsule assembles");
|
||||
}
|
||||
CHECK(v4_text_finish(&tx), "everything is defined: %s", v4_text_error(&tx));
|
||||
CHECK(v4_text_here(&tx) < DICT_W, "code stays below the dictionary space");
|
||||
@@ -1100,6 +1129,28 @@ int main(void)
|
||||
CHECK(is(say("SEE NOSUCH\n"), "SEE: not found\n ok\nok> ") && is(say("SEE\n"), "SEE: not found\n ok\nok> "), "a word that is not there");
|
||||
CHECK(is(say("(.\")\n"), "(.\"): compile-only\n ERROR\nok> ") && is(say("(S\")\n"), "(S\"): compile-only\n ERROR\nok> "), "the string run-time words have names but cannot be run from the prompt");
|
||||
|
||||
/* ---- access control with its policy loaded: ACL.fth, FORTH source ---- */
|
||||
boot_bare();
|
||||
CHECK(load_source("ACL.fth"), "ACL.fth compiles, every line of it");
|
||||
CHECK(strstr(out, "\033[32mINFO: \033[0mACL: active\n") == out && n.mem[ACL_HOOK] != 0, "and its last line switches access control on");
|
||||
CHECK(is(say(": FOO 65 EMIT ; FOO ' FOO ACL-TTL@ . FOO ' FOO ACL-TTL@ .\n"), "A256 A255 ok\nok> "), "a word's first use is rechecked and earns it a TTL, which is then counted down");
|
||||
CHECK(is(say(": SFOO 66 EMIT ; ' SFOO ACL-STRICT SFOO SFOO ' SFOO ACL-TTL@ .\n"), "BB0 ok\nok> ") && is(say("' SFOO ACL-MODE@ .\n"), "1 ok\nok> "),
|
||||
"a strict word is rechecked every time: its TTL stays 0");
|
||||
CHECK(is(say("' SFOO ACL-TTL-MODE SFOO ' SFOO ACL-TTL@ . ' SFOO ACL-MODE@ .\n"), "B256 0 ok\nok> "), "and can be put back in TTL mode");
|
||||
CHECK(is(say("' ACL-RECHECK ACL-PINNED? . ' ACL-BOOT ACL-PINNED? .\n"), "-1 -1 ok\nok> ") && is(say("' ACL-INIT-PRIMITIVES ACL-PINNED? .\n"), "-1 ok\nok> "),
|
||||
"the policy's own words are pinned");
|
||||
CHECK(is(say("0 ' ACL-RECHECK ACL-ALLOW! ' ACL-RECHECK ACL-STRICT ' ACL-RECHECK ACL-ALLOW@ .\n"), "-1 ok\nok> ")
|
||||
&& is(say("' ACL-RECHECK ACL-MODE@ . FOO\n"), "0 A ok\nok> "), "so they cannot be denied or changed");
|
||||
CHECK(is(say("0 ' FOO ACL-ALLOW! 67 EMIT FOO 68 EMIT\n"), "C\033[33mWARN: \033[0mACL: denied 'FOO'\n ERROR\nok> "), "a denied word is refused while its TTL lasts");
|
||||
CHECK(is(say("0 ' FOO ACL-TTL! FOO\n"), "A ok\nok> "), "and when its TTL runs out the policy is asked again: this one allows");
|
||||
CHECK(is(say(": NOFOO DUP ['] FOO = IF 0 SWAP ACL-ALLOW! ELSE ACL-RECHECK THEN ;\n"), " ok\nok> ")
|
||||
&& is(say("' NOFOO ACL-HOOK ! 0 ' FOO ACL-TTL!\n"), " ok\nok> "), "a policy that denies one word");
|
||||
CHECK(is(say("69 EMIT FOO\n"), "E\033[33mWARN: \033[0mACL: denied 'FOO'\n ERROR\nok> ") && is(say("SFOO : G FOO ;\n"), "B\033[33mWARN: \033[0mACL: denied 'FOO'\n ERROR\nok> ")
|
||||
&& is(say("1 2 + . SFOO\n"), "3 B ok\nok> "), "that word is refused, interpreted or compiled, and nothing else is");
|
||||
CHECK(is(say("1 2 HERMES-CHANNEL-OPEN? . ACL-CA-KEY-LO . ' DUP ACL-ENTRY ' DUP = .\n"), "1 0 -1 ok\nok> "), "the rest of v3's policy file is there");
|
||||
CHECK(is(say("COLD\n"), "FORTH-79 Cold Start\nSystem initialized.\n ok\nok> ") && n.mem[ACL_HOOK] == 0 && is(say("ACL-BOOT\n"), "UNKNOWN WORD: 'ACL-BOOT'\n ERROR\nok> "),
|
||||
"COLD takes the policy away with everything else that was loaded");
|
||||
|
||||
/* ---- the small system words ---- */
|
||||
boot_bare();
|
||||
CHECK(is(say("79-STANDARD .S\n"), "<0> \n ok\nok> "), "79-STANDARD is satisfied, and says nothing");
|
||||
|
||||
Reference in New Issue
Block a user