From 6399979f3b39cf044d73a6a8f34f717516a5fd71 Mon Sep 17 00:00:00 2001 From: Rafael Richards Date: Tue, 16 Jun 2026 18:43:31 -0400 Subject: [PATCH] M4: VSLSEC (security/authz S5) + VSLLOG (audit sink S3) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Bind the security and audit seams in v-stdlib, dual-engine GREEN 11/11 (vehu YDB + foia-t12 IRIS); full suite 33/33, no regression. VSLSEC — the VistA authorization decision (authz-only). Grounded that no portable Kernel generic-hash entry point exists ($$SHAHASH^XUSHSH absent on vehu; classic ^XUSHSH returns a constant on both engines), so portable crypto stays in STDCRYPTO and VSLSEC binds none (architecture 3.4). $$hasKey over ^XUSEC (Supported reference, notional ICR; a DENY is a normal 0, not an error), $$duz (#200 IEN principal), $$user (#200 NAME via VSLFS reuse, v->v). Loud ,U-VSL-SEC-ARG, on a malformed call (empty key). VSLLOG — the first v->v composition: the audit sink reuses VSLFS (no FileMan DBS re-bind), files a $$now^STDDATE() (v->m) timestamped line as .01, and maps a VSLFS ,U-VSL-FS-DIERR, to ,U-VSL-LOG-WRITE,. No @icr (no direct L4 call). Lane A no-op: no MSL seam change, so m-stdlib is untouched, no v0.10.0 tag, and the pin stays v0.9.0. Gates green: check-icr 9, check-citations 9 (new XU/krn_8_0_dg_security_keys_ug#key-lookup verified vs gold), check-namespaces 5, check-seams 0, check-msl-pin v0.9.0; make check-fast clean. Fixtures are existing low-risk entries probed read-only (a real ^XUSEC(key,duz) pair; #200 IEN 1; a #8989.51 ZZ throwaway audit record). Deferred (non-gating): the optional MailMan alert and context-option authz ($$inContext via CRCONTXT^XWBSEC). Co-Authored-By: Claude Opus 4.8 (1M context) --- dist/icr-registry.json | 12 ++++ dist/namespace-registry.json | 4 +- docs/memory/MEMORY.md | 1 + docs/memory/m4-vslsec-vsllog.md | 114 ++++++++++++++++++++++++++++++++ src/VSLLOG.m | 63 ++++++++++++++++++ src/VSLSEC.m | 78 ++++++++++++++++++++++ tests/VSLLOGTST.m | 61 +++++++++++++++++ tests/VSLSECTST.m | 65 ++++++++++++++++++ 8 files changed, 397 insertions(+), 1 deletion(-) create mode 100644 docs/memory/m4-vslsec-vsllog.md create mode 100644 src/VSLLOG.m create mode 100644 src/VSLSEC.m create mode 100644 tests/VSLLOGTST.m create mode 100644 tests/VSLSECTST.m diff --git a/dist/icr-registry.json b/dist/icr-registry.json index 19e6a3c..45f63b5 100644 --- a/dist/icr-registry.json +++ b/dist/icr-registry.json @@ -84,5 +84,17 @@ }, "status": "Supported" } + ], + "VSLSEC": [ + { + "call": "^XUSEC", + "custodian": "XU", + "icr": "notional", + "source": { + "anchor": "key-lookup", + "doc_key": "XU/krn_8_0_dg_security_keys_ug" + }, + "status": "Supported" + } ] } diff --git a/dist/namespace-registry.json b/dist/namespace-registry.json index 562b0c6..fd683eb 100644 --- a/dist/namespace-registry.json +++ b/dist/namespace-registry.json @@ -12,7 +12,9 @@ "routines": [ "VSLCFG", "VSLFS", - "VSLIO" + "VSLIO", + "VSLLOG", + "VSLSEC" ] } } diff --git a/docs/memory/MEMORY.md b/docs/memory/MEMORY.md index 2748abe..09b4fdf 100644 --- a/docs/memory/MEMORY.md +++ b/docs/memory/MEMORY.md @@ -2,6 +2,7 @@ One line per memory file. Content lives in the files, not here. +- [m4-vslsec-vsllog](m4-vslsec-vsllog.md) — VSL/MSL **M4 DONE** (2026-06-16): **VSLSEC** (security/authz seam S5) + **VSLLOG** (audit sink S3). **Dual-engine GREEN 11/11** (vehu YDB + foia-t12 IRIS); suite 33/33 no regression. **VSLSEC = authz-only** — GROUNDED that there is **no portable Kernel generic-hash** (`$$SHAHASH^XUSHSH` absent on vehu; classic `^XUSHSH` returns a constant on both) so crypto stays in **STDCRYPTO**; binds `$$hasKey` over **`^XUSEC`** (Supported reference, notional ICR; a DENY is a normal `0`), `$$duz` (#200 IEN), `$$user` (#200 NAME via **VSLFS reuse**); loud **`,U-VSL-SEC-ARG,`** on a malformed call. **VSLLOG = first v→v composition** — reuses VSLFS (no DBS re-bind), audit line via `$$now^STDDATE` (v→m), maps VSLFS DIERR → **`,U-VSL-LOG-WRITE,`**; no `@icr` (no direct L4 call). **Lane A NO-OP** (no MSL seam change; pin stays **v0.9.0**). GOTCHA: `zgoto`-`$ETRAP` aborts the resident harness 0/0 → use the flag-based `$ETRAP` (clear OUR trap before re-raising). Gates: check-icr 9 / check-citations 9 / check-namespaces 5. MailMan alert + `$$inContext` (CRCONTXT) deferred. Branch `m4-vslsec-vsllog`. Next: M5 (VSLBLD/VSLTASK). - [m3-vslfs](m3-vslfs.md) — VSL/MSL **M3 Lane B DONE** (2026-06-16): **VSLFS** binds the `STDKV` storage seam (MSL **v0.9.0**) to VistA's FileMan DBS — `$$set`=`UPDATE^DIE` (returns resolved IENS; `"+1,"` adds), `$$get`/`$$exists`=`$$GET1^DIQ`, `$$kill`=`FILE^DIE` with FDA **`.01="@"`** (**no `DELETE^DIE` exists**; `^DIK`/direct KILL forbidden). Re-pinned `msl_ref` v0.8.0→v0.9.0. **Dual-engine GREEN 7/7** (vehu + foia-t12) over **#8989.51** (free-text `.01`, no other required fields → safe ZZ throwaway record; no DD install). DIERR→**`,U-VSL-FS-DIERR,`** `$ECODE` + `$$lastError`; MSG_ROOT="ERR" keeps errors private. **No `$ZVERSION` arm** (FileMan DBS portable). ICR **notional** (`@icr DBS` marker — gen-icr.py taught NOTIONAL_MARKERS; see [[notional-dbia-not-a-blocker]]). 3 boundaries green; suite **22/22** no regression. Branch `m3-vslfs` **stacked on `m2-vslio`** (unmerged). Next: M4 (VSLSEC+VSLLOG). - [t1.2-vslcfg](t1.2-vslcfg.md) — VSL T1.2 (2026-06-16): **VSLCFG**, the first VSL* module — binds the STDENV config seam to XPAR at the **SYS entity** (`$$get`=`$$GET^XPAR("SYS",…)`, `$$set`=`EN^XPAR("SYS",…)`), validated live on vehu. **All 3 determinism boundaries GREEN** (① re-pin `msl_ref`→v0.7.0 carrying real STDENV; ② check-icr ICR #2263; ③ check-citations vs gold corpus). Citation reconciled: **XU/krn_8_0_dg_toolkit_ug / ICR #2263**, not the plan's XT guess. **Keystone unblock:** driver→live XPAR via `M_YDB_GBLDIR`/`M_YDB_ROUTINES`. **Remaining blocker:** `m test --docker` honors gbldir but NOT M_YDB_ROUTINES → VSLCFGTST aborts 0/0 (XPAR routines unresolved); fix = layer the resident routine base in the m test/m-ydb path (m-cli/m-ydb session) or test-in-place `--resident`. - [meta-root + owed VSLSEED filer](meta-root-and-owed.md) — layer declared in **root `repo.meta.json`** (migrated off `dist/` 2026-06-15, Phase B item 1); the owed `fileViaDie^VSLSEED` FileMan filer (re-homed from m-stdlib STDSEED per the G2 waterline decision) lands here when a v-layer seeding consumer needs it. diff --git a/docs/memory/m4-vslsec-vsllog.md b/docs/memory/m4-vslsec-vsllog.md new file mode 100644 index 0000000..654956e --- /dev/null +++ b/docs/memory/m4-vslsec-vsllog.md @@ -0,0 +1,114 @@ +--- +name: m4-vslsec-vsllog +description: VSL/MSL M4 DONE — VSLSEC (security/authz seam S5) + VSLLOG (audit sink S3) in v-stdlib. Dual-engine GREEN 11/11 (vehu YDB + foia-t12 IRIS). VSLSEC = authz-only (NO Kernel hash — grounded: no portable Kernel generic-hash exists; crypto stays in STDCRYPTO): hasKey over ^XUSEC, duz (#200 IEN), user (#200 NAME via VSLFS reuse), loud ,U-VSL-SEC-ARG,. VSLLOG = first v→v composition (reuses VSLFS, no DBS re-bind), audit line via $$now^STDDATE, maps VSLFS DIERR → ,U-VSL-LOG-WRITE,. Lane A NO-OP (no MSL seam change; pin stays v0.9.0). +metadata: + type: project +--- + +# VSL T-M4 — VSLSEC (security/authz S5) + VSLLOG (audit sink S3), 2026-06-16 + +The security + audit seams. Branch `m4-vslsec-vsllog` off `main` (M3 merged). +4th + 5th `VSL*` modules (after VSLCFG, VSLIO, VSLFS). **Dual-engine GREEN 11/11** +(VSLSEC 6 + VSLLOG 5) on `vehu` (YDB) + `foia-t12` (IRIS); full v-stdlib suite +**33/33** on vehu (no regression). + +## Lane A was a NO-OP — no MSL seam change (the key design call) +M4 needed **no** new/changed MSL seam, so m-stdlib was untouched and **no +`v0.10.0` tag** was cut; `dist/msl-seam-pin.json` stays **`v0.9.0`**. Why: +- **VSLSEC is authz-only — it has no portable MSL counterpart.** The + authorization decision (does DUZ hold a key / a context) cannot run on a bare + engine, so there is nothing to put below the waterline (architecture §3.4: + "portable token crypto stays in STD*; the VistA authorization decision lives + in VSL"). Portable crypto already lives in `STDCRYPTO`. +- **STDLOG's sink** is process-local (stderr/global); VSLLOG does NOT hook it — + it's an independent VistA audit-record writer. No STDLOG `@seam` was added. + +## GROUNDED: there is NO portable Kernel generic-hash entry point (so VSLSEC binds none) +Resolved Q1 by probing both live engines through the driver stack: +- **`$$SHAHASH^XUSHSH(bits,str)`** (SHA hex, XU*8.0*655) is **ABSENT on vehu** + (older FOIA) → ZLINK FILENOTFND; present on IRIS. +- **Classic top-level `^XUSHSH`** (X in/out) returns a **CONSTANT** on BOTH + engines (probe: "distinct inputs distinct" assertion failed on both) — it is + NOT a usable generic string hash. +So VSLSEC binds **no** Kernel hash; a consumer needing a digest calls +`STDCRYPTO` (libcrypto on YDB / `$SYSTEM.Encryption` on IRIS, dual-engine +proven). Do NOT re-open "wire a Kernel hash into VSLSEC" — it's a dead end. + +## VSLSEC — the VistA authorization decision (3 bindings, all VistA-only) +- `$$hasKey^VSLSEC(key,duz)` → `''$D(^XUSEC(key,duz))`. The security-key + decision. **A DENY is a normal `0`, NOT an error** (kickoff decision 4). `duz` + defaults to `+$G(DUZ)` via `$$pduz`. +- `$$duz^VSLSEC()` → `+$G(DUZ)` — the ambient principal (the #200 IEN binding). +- `$$user^VSLSEC(duz)` → `$$get^VSLFS(200,duz_",",".01","")` — the principal→#200 + NAME, **reusing VSLFS** (v→v; no DBS re-bind). +- **Loud path = a malformed call:** `$$hasKey("")` → clean **`,U-VSL-SEC-ARG,`** + `$ECODE` + detail in `^TMP($job,"vslsec","err")` (`$$lastError`). (Decision 4: + "a malformed call or a Kernel fault is loud; a DENY is not.") +- **ICR:** `^XUSEC` is the documented **Supported reference** ("check the ^XUSEC + global … do not reference SECURITY KEY #19.1" — Kernel DG Security Keys), no + numeric DBIA in the corpus → tagged **notional** `@icr notional @call ^XUSEC + @status Supported @custodian XU @source XU/krn_8_0_dg_security_keys_ug#key-lookup`. + A `$D` **read** (not a set/kill), so the no-direct-global rule (writes only) is + satisfied; the REF_RE scan still requires the declaration, which it has. + +## VSLLOG — the first v→v composition (reuses VSLFS; no DBS re-bind) +- `$$write^VSLLOG(file,event,detail)` → `line=$$now^STDDATE()_" "_event_" "_detail` + then `$$set^VSLFS(file,"+1,",".01",line)` → resolved IENS. Timestamp from + `$$now^STDDATE` (portable, **v→m** call up). Value-add = the log-record→.01 + mapping + the loud error map. +- `$$read^VSLLOG(file,iens)` → `$$get^VSLFS(file,iens,".01","")`. +- **Loud map:** a VSLFS `,U-VSL-FS-DIERR,` is caught (flag-based `$ETRAP`, see + gotcha) and re-raised as **`,U-VSL-LOG-WRITE,`** with the VSLFS detail in + `^TMP($job,"vsllog","err")`. +- **No `@icr` in VSLLOG** — it makes NO direct L4 call (DIQ/DIE are inside + VSLFS; STDDATE is `m`-layer). v→v + v→m is invisible to the ICR/no-direct-global + gate, correct by construction. `m arch check` is happy with VSL*→VSL*. + +## GOTCHA — `zgoto`-based `$ETRAP` aborts the resident harness (0/0) +First VSLLOG.write used the STDJSON idiom `set $etrap="set $ecode="""" zgoto +"_lvl_":writeFault"` — the suite **aborted 0/0 with NO diagnostic** (the +"unattributable rc=1" class in m-stdlib discoveries.md). Fix = the **flag-based +`$ETRAP`** (STDCSPRNG pattern), no zgoto: +``` +new $etrap,iens,line,ok set ok=1 +set $etrap="set ok=0,$ecode="""" quit" +set line=… set iens=$$set^VSLFS(…) +if ok quit iens +set $etrap="" do raiseWrite quit "" ; clear OUR trap before re-raising +``` +Must `set $etrap=""` before re-raising or write's own trap swallows the mapped +error. Keep ≤3 commands/line (M-MOD-009 — the Go `m --check` reds on any finding, +incl. *style*; same lesson as VSLFS's stashDierr). + +## Test fixtures — EXISTING low-risk entries, probed read-only (Q3) +- **VSLSEC:** an existing `^XUSEC(key,duz)` pair found via `$O` (test ground + truth) → assert `$$hasKey=1`; a bogus key → assert `0`. `#200` IEN 1 (the + postmaster) for `$$user`. No keys granted/revoked; no users altered. +- **VSLLOG:** the same **#8989.51** free-text `.01` file VSLFS uses (uppercased, + no other required fields) → a ZZ throwaway audit record, created + killed via + VSLFS. Round-trip asserts the read-back **contains** event+detail (the + timestamp is generated, and #8989.51 uppercases, so not byte-predictable). + DD-install of a dedicated audit file stays the deferred v-pkg track. + +## Gates (all green) + engine recipe +`make check-fast`: fmt/lint (0 findings) + `m arch check .` (layer v) + +check-seams (0 — both are consumers) + **check-icr (9: VSLCFG 2 + VSLIO 2 + +VSLFS 4 + VSLSEC 1)** + **check-citations (9 vs gold corpus — the new +`XU/krn_8_0_dg_security_keys_ug#key-lookup` verified)** + check-namespaces +(**5 routines**) + check-msl-pin (**v0.9.0**, unchanged) + check-engine-access. +Recipe (driver stack ONLY): `m test --engine ydb --docker vehu --chset m +--routines src --routines /src tests/VSLSECTST.m tests/VSLLOGTST.m` +(IRIS: `--engine iris --docker foia-t12 --namespace VISTA`). + +## Owed / next +- **Optional MailMan alert** (kickoff "+optional") deliberately OMITTED — + `SETUP^XQALERT` (ICR 10081, Supported) / `EN^XMB` (DBIA 10069) send a REAL + alert/bulletin to a user (a side effect); deferred, not green-gating. +- **Context-option authz** (`$$inContext` via `CRCONTXT^XWBSEC`, ICR 4053, + Controlled Subscription) deferred: it needs the **encrypted** B-type option + name and sets context (side-effecting) — too fragile for a safe read-only + probe. hasKey covers the authz-decision milestone. Next consumer can add it. +- **Next: M5** (VSLBLD/VSLTASK — KIDS build + TaskMan listener, §12.2) + the + §6.2 worked examples (S3 log egress, FHIR façade). +Companion to [[m3-vslfs]] (VSLLOG reuses its DBS binding) + [[m2-vslio]] (adapter +rhythm) + shared [[notional-dbia-not-a-blocker]]. diff --git a/src/VSLLOG.m b/src/VSLLOG.m new file mode 100644 index 0000000..f0f7915 --- /dev/null +++ b/src/VSLLOG.m @@ -0,0 +1,63 @@ +VSLLOG ; v-stdlib — VistA FileMan audit-sink adapter (the S3 audit seam). + ; + ; Binds the observability sink to a VistA FileMan audit file. VSLLOG is the + ; first v->v composition: it writes audit records by REUSING VSLFS (the + ; FileMan DBS record writer) rather than re-binding UPDATE^DIE/$$GET1^DIQ + ; itself — the in-`v` analog of the waterline no-duplication rule (a `v` tool + ; consumes a lower `v` capability; only `v->m`/leaked-VistA-symbols are + ; forbidden, never a VSL*->VSL* call). VSLLOG adds ONLY the log-record -> + ; FileMan-field mapping: it composes a timestamped audit line (the timestamp + ; from $$now^STDDATE(), portable, called up — v->m) and files it as the + ; record's .01 via $$set^VSLFS. + ; + ; Public API (the handle is the FileMan IENS VSLFS returns): + ; $$write^VSLLOG(file,event,detail) — file one audit record -> resolved IENS + ; $$read^VSLLOG(file,iens) — read an audit line back, else "" + ; $$lastError^VSLLOG() — last error detail, else "" + ; + ; *** ERROR CONTRACT — loud, never a silent lost record *** + ; A FileMan write failure surfaces from VSLFS as ,U-VSL-FS-DIERR,; VSLLOG + ; catches it and re-raises a clean ,U-VSL-LOG-WRITE, $ECODE, carrying the + ; underlying VSLFS detail in ^TMP($job,"vsllog","err") for $$lastError. The + ; "audit log must never silently drop a record" goal (§6.2): a sink failure is + ; loud, not swallowed. Reads of an absent record return "" (as VSLFS reads do). + ; + ; No @icr declarations here: VSLLOG makes NO direct L4 call — every FileMan + ; DBS call is inside VSLFS (declared there), and $$now^STDDATE is an `m`-layer + ; (STD*) call up, not an L4 reference. The v->v + v->m composition is correct + ; by construction and invisible to the ICR/no-direct-global gate. + ; + quit + ; + ; ---------- the audit sink, bound to FileMan via VSLFS (v->v) ---------- + ; +write(file,event,detail) ; File one audit record into `file`; return the resolved IENS, else raise. + ; doc: @param file numeric FileMan audit-file number + ; doc: @param event string short event name (audit category) + ; doc: @param detail string free-text detail for the record + ; doc: @returns string the resolved IENS of the new audit record + ; doc: @raises U-VSL-LOG-WRITE the FileMan write failed (detail in $$lastError) + new $etrap,iens,line,ok + set ok=1 + set $etrap="set ok=0,$ecode="""" quit" + set line=$$now^STDDATE()_" "_event_" "_detail + set iens=$$set^VSLFS(file,"+1,",".01",line) + if ok quit iens + set $etrap="" do raiseWrite quit "" + ; +raiseWrite ; (private) map a downstream VSLFS fault to a loud ,U-VSL-LOG-WRITE,. + new detail + set detail=$$lastError^VSLFS() + set ^TMP($job,"vsllog","err")="write: "_$select(detail'="":detail,1:"FileMan write failed") + set $ecode=",U-VSL-LOG-WRITE," + quit + ; +read(file,iens) ; Read the audit line stored at (file,iens) .01, else "". + ; doc: @param file numeric FileMan audit-file number + ; doc: @param iens string IENS of the audit record + ; doc: @returns string the stored audit line, or "" if absent + quit $$get^VSLFS(file,iens,".01","") + ; +lastError() ; The last VSLLOG error message (the composed FileMan detail). + ; doc: @returns string ^TMP($job,"vsllog","err"), or "" if none + quit $get(^TMP($job,"vsllog","err")) diff --git a/src/VSLSEC.m b/src/VSLSEC.m new file mode 100644 index 0000000..21d2c9f --- /dev/null +++ b/src/VSLSEC.m @@ -0,0 +1,78 @@ +VSLSEC ; v-stdlib — VistA identity/authorization adapter (Kernel). + ; + ; Binds the VistA *authorization decision* — the part of the security seam + ; that has NO portable analog and so cannot live below the waterline. Three + ; bindings, each VistA-only: + ; - the security-key check ($$hasKey, over Kernel's ^XUSEC); + ; - the ambient principal ($$duz, the NEW PERSON #200 IEN); + ; - the principal -> #200 NAME resolution ($$user), which REUSES VSLFS + ; (v->v composition; no FileMan DBS re-bind — waterline §9 no-duplication + ; applies within `v` too). + ; + ; *** NO portable crypto here — STDCRYPTO owns it. *** Portable token crypto + ; (SHA digests, HMAC, constant-time compare) lives in STDCRYPTO (libcrypto on + ; YDB / $SYSTEM.Encryption on IRIS, dual-engine proven) and is called up by a + ; consumer that needs it. VSLSEC binds NO Kernel hash back end: grounded + ; 2026-06-16, there is no portable Kernel generic-hash entry point — + ; $$SHAHASH^XUSHSH is absent on the YDB-VistA test engine (pre XU*8.0*655) + ; and the classic top-level ^XUSHSH returns a constant on both engines. The + ; architecture (§3.4) is explicit: "Portable token crypto stays in STD*; the + ; VistA authorization decision lives in VSL." This module is that decision. + ; + ; Public API: + ; $$hasKey^VSLSEC(key,duz) — 1 iff `duz` holds security key `key`, else 0 + ; $$duz^VSLSEC() — the ambient principal (+$GET(DUZ), the #200 IEN) + ; $$user^VSLSEC(duz) — the #200 NAME for `duz` (via VSLFS), else "" + ; $$lastError^VSLSEC() — last error detail, else "" + ; + ; *** ERROR CONTRACT — loud on a malformed call, never on a normal DENY *** + ; An authorization DENY is a normal `0` from $$hasKey — NOT an error. A + ; malformed call (an empty key name) maps to a clean ,U-VSL-SEC-ARG, $ECODE, + ; with the detail in ^TMP($job,"vslsec","err") for $$lastError. This mirrors + ; VSLFS's loud-failure posture (a real fault is loud; an absent value is not). + ; + ; ICR note: ^XUSEC is the documented Supported *reference* for security-key + ; membership ("do not reference the SECURITY KEY (#19.1) file ... check the + ; ^XUSEC global ... this is (and continues to be) a supported reference" — + ; Kernel DG, Security Keys). It carries no numeric DBIA in the gold corpus, so + ; the call is tagged with the notional ICR marker (a read, never a write — the + ; no-direct-global rule forbids set/kill, not the Supported $D reference). See + ; docs/memory notional-dbia-not-a-blocker + plan §5.4. + ; + quit + ; + ; ---------- the authorization decision (the VistA binding) ---------- + ; +hasKey(key,duz) ; 1 iff `duz` (default: the ambient DUZ) holds security key `key`. + ; doc: @param key string security-key name (SECURITY KEY #19.1 .01) + ; doc: @param duz numeric the user's #200 IEN; defaults to +$GET(DUZ) + ; doc: @returns bool 1 iff the user holds the key; 0 (a normal DENY) otherwise + ; doc: @raises U-VSL-SEC-ARG the call is malformed (an empty key name) + ; doc: @icr notional @call ^XUSEC @status Supported @custodian XU @source XU/krn_8_0_dg_security_keys_ug#key-lookup + if $get(key)="" do raiseArg("hasKey","a key name is required") quit "" + quit ''$data(^XUSEC(key,$$pduz(duz))) + ; +duz() ; The ambient principal — +$GET(DUZ), the caller's NEW PERSON (#200) IEN. + ; doc: @returns numeric the ambient DUZ (0 when no signon context is set) + quit +$get(DUZ) + ; +user(duz) ; The #200 NAME for `duz` (default: the ambient DUZ), resolved via VSLFS. + ; doc: @param duz numeric the user's #200 IEN; defaults to +$GET(DUZ) + ; doc: @returns string the NEW PERSON (#200) .01 NAME, or "" if absent + ; doc: Reuses $$get^VSLFS (FileMan DBS) — the principal->#200 binding without + ; doc: re-binding the DBS (v->v composition; waterline §9 no-duplication). + quit $$get^VSLFS(200,$$pduz(duz)_",",".01","") + ; +lastError() ; The last VSLSEC error message (the composed malformed-call detail). + ; doc: @returns string ^TMP($job,"vslsec","err"), or "" if none + quit $get(^TMP($job,"vslsec","err")) + ; + ; ---------- internals ---------- + ; +pduz(duz) ; Resolve the effective principal: `duz` if supplied, else the ambient DUZ. + quit $select($get(duz)'="":duz,1:+$get(DUZ)) + ; +raiseArg(who,msg) ; Stash the detail, then raise the clean ,U-VSL-SEC-ARG,. + set ^TMP($job,"vslsec","err")=who_": "_msg + set $ecode=",U-VSL-SEC-ARG," + quit diff --git a/tests/VSLLOGTST.m b/tests/VSLLOGTST.m new file mode 100644 index 0000000..b488e78 --- /dev/null +++ b/tests/VSLLOGTST.m @@ -0,0 +1,61 @@ +VSLLOGTST ; v-stdlib — VSLLOG (FileMan audit-sink adapter) test suite. + ; Exercises VSLLOG against a live VistA's FileMan DBS API, over the driver + ; stack only (m/v waterline — the ONLY path): + ; m test --engine ydb --docker vehu --chset m \ + ; --routines src --routines /src tests/VSLLOGTST.m + ; m test --engine iris --docker foia-t12 --namespace VISTA \ + ; --routines src --routines /src tests/VSLLOGTST.m + ; + ; VSLLOG is the audit sink: it writes a log record to a FileMan audit file by + ; REUSING VSLFS (v->v composition; it does NOT re-bind the FileMan DBS) and + ; maps a write failure to a clean ,U-VSL-LOG-WRITE, $ECODE. The "audit file" + ; is the same EXISTING low-risk file VSLFS uses — #8989.51 PARAMETER + ; DEFINITION — whose .01 is free-text (uppercased) with no other required + ; fields, so a throwaway ZZ-namespaced audit record is created and removed + ; cleanly (no DD install; the dedicated-audit-file DD is a deferred v-pkg + ; track). The audit line carries a $$now^STDDATE() timestamp (portable, v->m) + ; + the event + detail; the round-trip asserts the read-back CONTAINS the + ; event and detail (the timestamp is generated, so not byte-predictable; the + ; #8989.51 .01 uppercases, so the test content is uppercase). + new pass,fail + do start^STDASSERT(.pass,.fail) + ; + do tWriteReadRoundtrip(.pass,.fail) + do tWriteFailureIsLoud(.pass,.fail) + ; + do report^STDASSERT(pass,fail) + quit + ; +tWriteReadRoundtrip(pass,fail) ;@TEST "$$write files an audit record via VSLFS and $$read returns a line carrying the event and detail" + new file,event,detail,iens,line + do setup(.file) + set event="ZZVSLLOG-LOGIN" + set detail="USER=1 JOB="_$job + set iens=$$write^VSLLOG(file,event,detail) + do true^STDASSERT(.pass,.fail,iens'="","audit record written (got a resolved IENS)") + quit:iens="" + set line=$$read^VSLLOG(file,iens) + do true^STDASSERT(.pass,.fail,line[event,"read-back audit line contains the event") + do true^STDASSERT(.pass,.fail,line[detail,"read-back audit line contains the detail") + do teardown(file,iens) + quit + ; +tWriteFailureIsLoud(pass,fail) ;@TEST "a FileMan write failure maps to a clean ,U-VSL-LOG-..., $ECODE with detail in $$lastError" + new file + do setup(.file) + do raises^STDASSERT(.pass,.fail,"set x=$$write^VSLLOG(99999999,""ZZ"",""X"")","U-VSL-LOG","$$write into a bogus file raises U-VSL-LOG-...") + do true^STDASSERT(.pass,.fail,$$lastError^VSLLOG()'="","lastError carries the underlying FileMan detail") + quit + ; + ; ---------- fixtures ---------- + ; +setup(file) ; FileMan programmer context + the safe audit file (#8989.51). + set DUZ=1,DUZ(0)="@",U="^",DT=$$DT^XLFDT + set file=8989.51 + quit + ; +teardown(file,iens) ; Remove the throwaway audit record if it still exists (via VSLFS). + new x + quit:'$$exists^VSLFS(file,iens) + set x=$$kill^VSLFS(file,iens) + quit diff --git a/tests/VSLSECTST.m b/tests/VSLSECTST.m new file mode 100644 index 0000000..a09e167 --- /dev/null +++ b/tests/VSLSECTST.m @@ -0,0 +1,65 @@ +VSLSECTST ; v-stdlib — VSLSEC (VistA identity/authorization adapter) test suite. + ; Exercises VSLSEC against a live VistA's Kernel identity surface, over the + ; driver stack only (m/v waterline — the ONLY path): + ; m test --engine ydb --docker vehu --chset m \ + ; --routines src --routines /src tests/VSLSECTST.m + ; m test --engine iris --docker foia-t12 --namespace VISTA \ + ; --routines src --routines /src tests/VSLSECTST.m + ; + ; VSLSEC is the VistA *authorization decision* (no portable crypto — that + ; stays in STDCRYPTO; grounded 2026-06-16: no portable Kernel generic-hash + ; entry point exists — SHAHASH^XUSHSH is absent on vehu and classic ^XUSHSH + ; gives constant output on both engines). The seam binds three things: + ; - $$hasKey: a security-key authorization decision over ^XUSEC (the + ; documented Supported reference; a DENY is a normal 0, NOT an error); + ; - $$duz: the ambient principal (DUZ = the #200 IEN binding); + ; - $$user: the principal -> NEW PERSON (#200) NAME, resolved by REUSING + ; VSLFS (v->v composition; no FileMan DBS re-bind). + ; Fixtures are EXISTING low-risk entries probed read-only (an existing + ; ^XUSEC(key,duz) pair; #200 IEN 1 = the postmaster). No keys are granted or + ; revoked and no users are altered. + new pass,fail + do start^STDASSERT(.pass,.fail) + ; + do tHasKeyDecision(.pass,.fail) + do tDuzAndUser(.pass,.fail) + do tMalformedIsLoud(.pass,.fail) + ; + do report^STDASSERT(pass,fail) + quit + ; +tHasKeyDecision(pass,fail) ;@TEST "$$hasKey is true for a held key (probed read-only) and false for an unheld key (a DENY is a normal 0)" + new key,duz + do setup + do probeHeldKey(.key,.duz) + if (key'="")&(duz'="") do eq^STDASSERT(.pass,.fail,$$hasKey^VSLSEC(key,duz),1,"hasKey is 1 for a key the user holds") + do eq^STDASSERT(.pass,.fail,$$hasKey^VSLSEC("ZZ NO SUCH KEY",+$get(duz)),0,"hasKey is 0 (a normal DENY) for an unheld key") + quit + ; +tDuzAndUser(pass,fail) ;@TEST "$$duz returns the ambient principal and $$user resolves its #200 NAME via VSLFS" + new nm + do setup + do eq^STDASSERT(.pass,.fail,$$duz^VSLSEC(),1,"$$duz returns the ambient DUZ") + set nm=$$user^VSLSEC(1) + do true^STDASSERT(.pass,.fail,nm'="","$$user resolves the #200 NAME for IEN 1 (got: "_nm_")") + quit + ; +tMalformedIsLoud(pass,fail) ;@TEST "a malformed call (empty key) maps to a clean ,U-VSL-SEC-..., $ECODE with detail in $$lastError" + do setup + do raises^STDASSERT(.pass,.fail,"set x=$$hasKey^VSLSEC("""",1)","U-VSL-SEC","$$hasKey with an empty key raises U-VSL-SEC-...") + do true^STDASSERT(.pass,.fail,$$lastError^VSLSEC()'="","lastError carries the malformed-call detail") + quit + ; + ; ---------- fixtures ---------- + ; +setup ; FileMan programmer context (needed for the #200 NAME read via VSLFS). + set DUZ=1,DUZ(0)="@",U="^",DT=$$DT^XLFDT + quit + ; +probeHeldKey(key,duz) ; Find an existing ^XUSEC(key,duz) pair, read-only (test ground truth). + new $etrap + set key="",duz="" + set $etrap="set $ecode="""" quit" + set key=$order(^XUSEC("")) + if key'="" set duz=$order(^XUSEC(key,0)) + quit