From f41a8dd6b78da67639814a08734784f0375ed284 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Fri, 24 Jul 2026 04:18:25 +1000 Subject: [PATCH] G-117 emission + verification: sidecar derives from the embedded record; family_check embed probe family_artifacts.tcl: reads the embedded record back out of each finished kit (exec with a piped //zipfs:/app/punkbin-artifact.toml reader - another executes-self-contained proof), verifies it against the invocation (schema/ name/variant/working_name/revision/target/tcl_patchlevel/batteries - stale- staging tripwire), and derives the sidecar's identity fields from it (build_id/origin/packager/project/project_url/license/build_host_platform - identical build_id by construction). Sidecar carries schema = 1, '#' comments on the non-obvious fields, and keeps sha1/size/built as its finished-binary additions. family_check.tcl: new embedrecord probe (record exists in the attached image; schema/variant/patchlevel/working_name/piperepl/batteries MATCH probed facts; v1 fields present; -expectrev asserts revision + the -r artifact name) and the gate probe now asserts ::tclsh(reopened) publication (0 at gate-open start, absent on plain/opt-out - G-118 item 7 patch-rev verification). build905.zig passes -expectrev; configure-compiles clean, both tools parse. Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com --- src/buildsuites/suite_tcl90/build905.zig | 1 + .../suite_tcl90/tools/family_artifacts.tcl | 93 ++++++++++++++++++- .../suite_tcl90/tools/family_check.tcl | 73 ++++++++++++++- 3 files changed, 160 insertions(+), 7 deletions(-) diff --git a/src/buildsuites/suite_tcl90/build905.zig b/src/buildsuites/suite_tcl90/build905.zig index 5eb614a9..f637e24b 100644 --- a/src/buildsuites/suite_tcl90/build905.zig +++ b/src/buildsuites/suite_tcl90/build905.zig @@ -2560,6 +2560,7 @@ pub fn build(b: *std.Build) !void { check.has_side_effects = true; check.addFileArg(b.path("tools/family_check.tcl")); check.addArgs(&.{ "-exe", installed_path, "-variant", fk.variant, "-expectpatch", tcl_h_patchlevel }); + check.addArgs(&.{ "-expectrev", b.fmt("{d}", .{familyrev}) }); check.addArgs(&.{ "-thread", thread_build.version, "-vfs", tclvfs_info.dotversion, "-tcllib", tcllib_ver }); if (std.mem.eql(u8, fk.variant, "punk-bi")) { check.addArgs(&.{ "-tk", tkb.patchlevel, "-tklib", tklib_ver }); diff --git a/src/buildsuites/suite_tcl90/tools/family_artifacts.tcl b/src/buildsuites/suite_tcl90/tools/family_artifacts.tcl index 83ee3e3c..1b499256 100644 --- a/src/buildsuites/suite_tcl90/tools/family_artifacts.tcl +++ b/src/buildsuites/suite_tcl90/tools/family_artifacts.tcl @@ -1,5 +1,10 @@ -#family_artifacts.tcl (G-103): emit punkbin-layout artifact copies + per-artifact -#toml metadata + sha1sums for the verified runtime kit family members. +#family_artifacts.tcl (G-103, schema v1 per G-117): emit punkbin-layout artifact +#copies + per-artifact toml metadata + sha1sums for the verified runtime kit +#family members. The sidecar's identity fields (schema, build_id, origin, +#packager, project, license, build_host_platform) are DERIVED from the record +#embedded in each kit's attached image at staging (read back by executing the +#kit) - single source of truth; the sidecar adds the finished-binary facts +#(sha1, size, built) per the embed-then-hash ordering. # #Deliberately run UNDER THE PLAIN FAMILY KIT itself (not the builder shell): the #sha1 digests come from the kit's attached tcllib/tcllibc, so every emission run @@ -57,6 +62,43 @@ proc exe_split {name} { return [list $name ""] } +proc read_embedded {kitpath} { + #G-117: exec the kit itself with a piped reader script - its attached image + #mounts at //zipfs:/app, so the embedded record is a plain file read. Trusted + #just-built kits only; identifying STRAY binaries without execution is the + #punk-runtime 'info' zip-central-directory read. + set reader { + fconfigure stdout -translation binary + if {[catch { + set f [open //zipfs:/app/punkbin-artifact.toml r] + fconfigure $f -translation binary + puts -nonewline [read $f] + close $f + } errM]} { + puts -nonewline "PUNKBIN-EMBED-MISSING: $errM" + } + exit 0 + } + if {[catch {exec $kitpath << $reader} out]} { + fail "embedded-record read failed for $kitpath: $out" + } + if {[string match "PUNKBIN-EMBED-MISSING*" $out]} { + fail "no embedded record in $kitpath ([string range $out 0 200]) - kit predates the G-117 staging embed?" + } + return [string map [list \r ""] $out] +} + +proc record_field {recordtext key} { + #line-based tolerant lookup (same consumer style as punk-runtime): quoted + #string or bare integer values; '#' comment lines never match + foreach line [split $recordtext \n] { + set line [string trim $line] + if {[regexp -- [format {^%s\s*=\s*"(.*)"\s*$} $key] $line -> v]} {return $v} + if {[regexp -- [format {^%s\s*=\s*([0-9]+)\s*$} $key] $line -> v]} {return $v} + } + return "" +} + file mkdir $opt(-outdir) set built [clock format [clock seconds] -format %Y-%m-%dT%H:%M:%SZ -timezone :UTC] set sha1lines {} @@ -79,9 +121,36 @@ foreach {variant kitpath} $opt(-kits) { if {$variant eq "punk-bi"} {lappend components {*}$opt(-bicomponents)} set batteries {} foreach {n v} $components {lappend batteries [toml_str "$n $v"]} + set batteries_line "attached_batteries = \[[join $batteries {, }]\]" + + #G-117: read the EMBEDDED record back out of the finished kit and derive the + #sidecar's shared identity fields from it - single source of truth, identical + #build_id by construction; every emission inherently verifies the embed exists + #and matches this invocation (stale-staging tripwire). + set embedded [read_embedded $kitpath] + foreach {ekey expect} [list schema 1 name $artifact variant $variant working_name $working revision $opt(-rev) target $opt(-target) tcl_patchlevel $opt(-tclpatch)] { + set got [record_field $embedded $ekey] + if {$got ne $expect} {fail "$artifact embedded record mismatch: $ekey = '$got', expected '$expect' (stale staging?)"} + } + if {[string first $batteries_line $embedded] < 0} { + fail "$artifact embedded record attached_batteries does not match the emission components" + } + set e_build_id [record_field $embedded build_id] + if {$e_build_id eq ""} {fail "$artifact embedded record has no build_id"} + set evars [dict create] + foreach k {origin packager project project_url license build_host_platform} { + set v [record_field $embedded $k] + if {$v eq ""} {fail "$artifact embedded record missing v1 field '$k'"} + dict set evars $k $v + } set m {} - lappend m "#punkshell runtime artifact metadata (G-103) - generated by family_artifacts.tcl" + lappend m "#punkshell runtime artifact metadata (G-117 schema v1) - generated by family_artifacts.tcl" + lappend m "#sidecar copy: the embedded record carried inside the artifact's attached image" + lappend m "#(punkbin-artifact.toml) plus the finished-binary facts (sha1, size, built)." + lappend m "#The sidecar + sha1sums.txt remain the integrity authority." + lappend m "schema = 1" + lappend m "" lappend m "\[artifact\]" lappend m "name = [toml_str $artifact]" lappend m "class = \"runtime\"" @@ -92,6 +161,22 @@ foreach {variant kitpath} $opt(-kits) { lappend m "sha1 = [toml_str $sha1]" lappend m "size = $size" lappend m "built = [toml_str $built]" + lappend m "#build_id: offline correlation key re-joining a renamed copy to its record;" + lappend m "#identical in the embedded and sidecar copies (a deterministic identity digest," + lappend m "#not an integrity key - sha1 above is the integrity fact)." + lappend m "build_id = [toml_str $e_build_id]" + lappend m "#origin: canonical artifact repo this artifact was BUILT FOR - not necessarily" + lappend m "#where it is hosted; mirrors preserve it." + lappend m "origin = [toml_str [dict get $evars origin]]" + lappend m "#packager: declared identity, not proof - signing (minisign sidecars) is the" + lappend m "#verification layer." + lappend m "packager = [toml_str [dict get $evars packager]]" + lappend m "project = [toml_str [dict get $evars project]]" + lappend m "project_url = [toml_str [dict get $evars project_url]]" + lappend m "#license: summary for the distributed artifact; component license texts ride" + lappend m "#inside the attached image (tcl_library/license.terms etc)." + lappend m "license = [toml_str [dict get $evars license]]" + lappend m "build_host_platform = [toml_str [dict get $evars build_host_platform]]" lappend m "" lappend m "\[runtime\]" lappend m "tcl_patchlevel = [toml_str $opt(-tclpatch)]" @@ -101,7 +186,7 @@ foreach {variant kitpath} $opt(-kits) { lappend m "piperepl_default = \"on\"" lappend m "piperepl_opt_out = \"TCLSH_PIPEREPL=0\"" } - lappend m "attached_batteries = \[[join $batteries {, }]\]" + lappend m $batteries_line lappend m "" lappend m "\[provenance\]" lappend m "suite = [toml_str $opt(-suite)]" diff --git a/src/buildsuites/suite_tcl90/tools/family_check.tcl b/src/buildsuites/suite_tcl90/tools/family_check.tcl index 34f0b657..6beaeb9f 100644 --- a/src/buildsuites/suite_tcl90/tools/family_check.tcl +++ b/src/buildsuites/suite_tcl90/tools/family_check.tcl @@ -18,11 +18,12 @@ # #args: -exe -variant plain|punk|punk-bi -expectpatch # -thread -vfs -tcllib ?-tk ? ?-tklib ? +# ?-expectrev ? (G-117: asserts the embedded record's revision + -r name) proc fail {msg} {puts stderr "family_check FAIL: $msg"; flush stderr; exit 1} proc note {msg} {puts stdout "family_check: $msg"; flush stdout} -array set opt {-exe {} -variant {} -expectpatch {} -thread {} -vfs {} -tcllib {} -tk {} -tklib {}} +array set opt {-exe {} -variant {} -expectpatch {} -expectrev {} -thread {} -vfs {} -tcllib {} -tk {} -tklib {}} foreach {k v} $argv { if {![info exists opt($k)]} {fail "unknown option '$k'"} set opt($k) $v @@ -180,21 +181,87 @@ if {$opt(-variant) eq "punk-bi"} { } #-- probe: piperepl gate (variant discriminator) ------------------------------ -set gate_script {puts [list CHECK tclshmachinery [info exists ::tclsh(istty)]]; exit 0} +#tclshreopened: G-118 item 7 patch rev - gate-open punk kits publish +#::tclsh(reopened) as 0 at startup (the console-reopen flip itself needs a real +#console and is outside this harness) +set gate_script { + puts [list CHECK tclshmachinery [info exists ::tclsh(istty)]] + puts [list CHECK tclshreopened [expr {[info exists ::tclsh(reopened)] ? $::tclsh(reopened) : "absent"}]] + exit 0 +} set d_default [checks [probe gate_default $gate_script]] set d_optout [checks [probe gate_optout $gate_script TCLSH_PIPEREPL 0]] if {$opt(-variant) eq "plain"} { #unpatched: no machinery regardless of the env var (even explicitly enabled) asserteq $d_default tclshmachinery 0 "piperepl (plain, env unset)" + asserteq $d_default tclshreopened absent "piperepl (plain, env unset)" set d_on [checks [probe gate_on $gate_script TCLSH_PIPEREPL 1]] asserteq $d_on tclshmachinery 0 "piperepl (plain, TCLSH_PIPEREPL=1)" note "piperepl OK (plain): stock behaviour - no ::tclsh machinery with env unset or =1" } else { #punk kits: ACTIVE BY DEFAULT (machinery published), documented opt-out =0 asserteq $d_default tclshmachinery 1 "piperepl ($opt(-variant), env unset - default must be ON)" + asserteq $d_default tclshreopened 0 "piperepl ($opt(-variant), env unset - reopened published 0 at start)" asserteq $d_optout tclshmachinery 0 "piperepl ($opt(-variant), TCLSH_PIPEREPL=0 opt-out)" - note "piperepl OK ($opt(-variant)): active by default, disabled via TCLSH_PIPEREPL=0" + asserteq $d_optout tclshreopened absent "piperepl ($opt(-variant), TCLSH_PIPEREPL=0 opt-out)" + note "piperepl OK ($opt(-variant)): active by default (reopened published 0), disabled via TCLSH_PIPEREPL=0" +} + +#-- probe: embedded artifact record (G-117 schema v1) ------------------------- +set embed_script { + proc out {k v} {puts [list CHECK $k $v]} + proc rfield {rec k} { + foreach line [split $rec \n] { + set line [string trim $line] + if {[regexp [format {^%s\s*=\s*"(.*)"\s*$} $k] $line -> v]} {return $v} + if {[regexp [format {^%s\s*=\s*([0-9]+|true|false)\s*$} $k] $line -> v]} {return $v} + } + return "" + } + if {[catch {open //zipfs:/app/punkbin-artifact.toml r} f]} { + out embed_exists 0 + exit 0 + } + fconfigure $f -translation binary + set rec [read $f] + close $f + out embed_exists 1 + foreach k {schema variant tcl_patchlevel working_name name revision build_id piperepl origin packager project license build_host_platform} { + out embed_$k [rfield $rec $k] + } + foreach line [split $rec \n] { + set line [string trim $line] + if {[string match "attached_batteries*" $line]} {out embed_batteries $line; break} + } + exit 0 +} +set d [checks [probe embedrecord $embed_script]] +asserteq $d embed_exists 1 "embedded record (G-117)" +asserteq $d embed_schema 1 "embedded record" +asserteq $d embed_variant $opt(-variant) "embedded record" +asserteq $d embed_tcl_patchlevel $opt(-expectpatch) "embedded record" +asserteq $d embed_working_name $kitname "embedded record" +asserteq $d embed_piperepl [expr {$opt(-variant) eq "plain" ? "false" : "true"}] "embedded record" +if {[dict get $d embed_build_id] eq ""} {fail "embedded record: empty build_id"} +foreach k {embed_origin embed_packager embed_project embed_license embed_build_host_platform} { + if {![dict exists $d $k] || [dict get $d $k] eq ""} {fail "embedded record: missing v1 field [string range $k 6 end]"} +} +if {$opt(-expectrev) ne ""} { + asserteq $d embed_revision $opt(-expectrev) "embedded record" + if {[string match -nocase *.exe $kitname]} { + set expname "[string range $kitname 0 end-4]-r$opt(-expectrev).exe" + } else { + set expname "$kitname-r$opt(-expectrev)" + } + asserteq $d embed_name $expname "embedded record" +} +set bl [expr {[dict exists $d embed_batteries] ? [dict get $d embed_batteries] : ""}] +set expected_batteries [list Thread $opt(-thread) vfs $opt(-vfs) tcllib $opt(-tcllib) tcllibc $opt(-tcllib)] +if {$opt(-variant) eq "punk-bi"} {lappend expected_batteries Tk $opt(-tk) tklib $opt(-tklib)} +foreach {bn bv} $expected_batteries { + if {[string first "\"$bn $bv\"" $bl] < 0} {fail "embedded record: attached_batteries missing '$bn $bv' (line: $bl)"} } +note "embedded record OK: schema 1, name [dict get $d embed_name], build_id [dict get $d embed_build_id]" file delete -force $scratch puts "family_check OK: $opt(-variant) $kitname self-contained (scratch-dir probes, scrubbed env)"