Browse Source
Payload fix, both payloads (found designing the coverage): fetch only retrieved beside-toml sidecars for -r<N> family names, so a fetched bare-named third-party artifact arrived WITHOUT the retroactive record its class display depends on. fetch now tries the sidecar for ANY name; absence stays tolerated (no-basis degradation unchanged). bin/punk-runtime.cmd re-wrapped. NEW binscripts suite runtimecmd_provenance.test (5 tests, both payload routes, httpfixture non-native tier testplat-x86_64: suite-built -r1 family artifact + bare third-party artifact with a retroactive-style schema-v2 sidecar + a record-less artifact): server-trust gate refusal from the non-canonical origin (canonical url + -trust-server named, no artifact lands), -trust-server flag fetch including sidecar retrieval, PUNKBIN_TRUST_SERVER=1 unattended form, class= tags in list -remote + plain list (third-party tagged, suite-built quiet, record-less untagged), and info schema-v2 fields + provenance_class row with the flat 'class = runtime' ordering-caveat pin and record-row parity between payloads. All green: new suite 5/5; pinned checkfile + freshness 12/12; roundtrip byte-identical under the tclsh9.0.5-punk baseline runner. Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.commaster
7 changed files with 510 additions and 45 deletions
@ -1,4 +1,4 @@
|
||||
[project] |
||||
name = "punkshell" |
||||
version = "0.34.0" |
||||
version = "0.35.0" |
||||
license = "BSD-2-Clause" |
||||
|
||||
@ -0,0 +1,419 @@
|
||||
package require tcltest |
||||
|
||||
#G-123: behaviour tests for punk-runtime's schema-v2 provenance surfacing and |
||||
#the server-trust consent gate, against a FIXTURE punkbin server carrying a |
||||
#NON-NATIVE tier: a child-process http file server |
||||
#(testsupport/httpfixture.tcl) serves a crafted punkbin layout whose |
||||
#testplat-x86_64 platform folder holds a suite-built -r<N> family artifact, a |
||||
#bare-named third-party artifact with a G-123 retroactive schema-v2 sidecar, |
||||
#and a record-less artifact; the PUNKBIN_URL override points both payloads at |
||||
#it (a NON-canonical origin - which is exactly what the consent gate keys on). |
||||
# |
||||
#Both payloads are exercised (parity discipline as in runtimecmd_freshness): |
||||
# - powershell payload: the committed bin/punk-runtime.cmd staged into a |
||||
# tempdir and driven via cmd.exe (the wrap-pinned windows launch path) |
||||
# - bash payload: src/scriptapps/bin/punk-runtime.bash staged beside it and |
||||
# driven directly via a probed msys/git bash |
||||
# |
||||
#Covered (G-123 acceptance): |
||||
# - server-trust consent gate: fetch from the non-canonical fixture origin |
||||
# REFUSES without acknowledgement (naming the canonical origin and the |
||||
# -trust-server flag), succeeds with the -trust-server flag and with the |
||||
# PUNKBIN_TRUST_SERVER=1 unattended form; refusal happens before any |
||||
# artifact lands in the store |
||||
# - fetch retrieves the beside-toml sidecar for BARE pre-family names too |
||||
# (the G-123 retroactive sidecars), not just -r<N> family names |
||||
# - list -remote / list: third-party rows carry the compact class= tag in the |
||||
# sparse identity column / bracketed metadata summary; suite-built rows |
||||
# stay quiet; record-less entries degrade as no-basis rows (no tag) |
||||
# - info: schema-v2 fields (builder/source_url/upstream_ref/retrieved) and |
||||
# the table-aware provenance_class row, while the flat field scan keeps |
||||
# reporting [artifact] class (= runtime) per the documented v2 ordering |
||||
# caveat; ps1/bash parity on the record rows |
||||
# |
||||
#NOTE for agents: bin/punk-runtime.cmd is GENERATED - fix the payloads under |
||||
#src/scriptapps/bin/ and re-wrap (see bin/AGENTS.md); the roundtrip pin lives in |
||||
#src/tests/modules/punk/mix/testsuites/scriptwrap/runtimecmd_roundtrip.test. |
||||
|
||||
namespace eval ::testspace { |
||||
namespace import ::tcltest::* |
||||
variable common { |
||||
set result "" |
||||
} |
||||
|
||||
variable testdir [file dirname [file normalize [info script]]] |
||||
variable testsroot [file normalize [file join $testdir .. .. ..]] |
||||
variable projectroot [file normalize [file join $testsroot .. ..]] |
||||
|
||||
variable target [file join $projectroot bin punk-runtime.cmd] |
||||
variable bashsource [file join $projectroot src scriptapps bin punk-runtime.bash] |
||||
testConstraint iswindows [expr {$::tcl_platform(platform) eq "windows"}] |
||||
testConstraint haveruntimecmd [file exists $target] |
||||
testConstraint havebashsource [file exists $bashsource] |
||||
testConstraint havecertutil [expr {[auto_execok certutil] ne ""}] |
||||
|
||||
proc find_msys_bash {} { |
||||
set candidates {} |
||||
foreach c [list \ |
||||
{C:/Program Files/Git/bin/bash.exe} \ |
||||
{C:/Program Files/Git/usr/bin/bash.exe} \ |
||||
{C:/msys64/usr/bin/bash.exe}] { |
||||
if {[file exists $c]} { lappend candidates $c } |
||||
} |
||||
set pathbash [lindex [auto_execok bash] 0] |
||||
if {$pathbash ne ""} { lappend candidates $pathbash } |
||||
foreach c $candidates { |
||||
if {![catch {exec -- $c -c "uname -s" << "" 2>@1} un]} { |
||||
set un [string trim $un] |
||||
if {[string match "MINGW*" $un] || [string match "MSYS*" $un]} { |
||||
if {![catch {exec -- $c -c "command -v curl >/dev/null && command -v sha1sum >/dev/null" << "" 2>@1}]} { |
||||
return $c |
||||
} |
||||
} |
||||
} |
||||
} |
||||
return "" |
||||
} |
||||
variable msysbash "" |
||||
if {[testConstraint iswindows] && [testConstraint havebashsource]} { |
||||
set msysbash [find_msys_bash] |
||||
} |
||||
testConstraint msysbash [expr {$msysbash ne ""}] |
||||
|
||||
proc writefile_raw {path content} { |
||||
set fd [open $path w] |
||||
fconfigure $fd -translation binary |
||||
puts -nonewline $fd $content |
||||
close $fd |
||||
} |
||||
proc sha1_of_file {path} { |
||||
set out [exec -- {*}[auto_execok certutil] -hashfile [file nativename $path] SHA1 << "" 2>@1] |
||||
foreach ln [split $out \n] { |
||||
set compact [string map {" " ""} [string trim $ln]] |
||||
if {[regexp {^[0-9a-fA-F]{40}$} $compact]} { |
||||
return [string tolower $compact] |
||||
} |
||||
} |
||||
error "no sha1 parsed from certutil output: $out" |
||||
} |
||||
|
||||
#--- fixture punkbin layout (server side) -------------------------------------- |
||||
variable plat testplat-x86_64 |
||||
variable artifacts [dict create \ |
||||
fakert-suite-r1.exe "FAKERT suite-built family payload 5555\n" \ |
||||
thirdkit.exe "THIRDKIT third-party runtime payload 6666\n" \ |
||||
norec.exe "NOREC recordless runtime payload 7777\n"] |
||||
#schema-v2 records: [artifact] class = "runtime" is deliberately the FIRST |
||||
#'class =' line (the documented ordering caveat the consumers pin against) |
||||
proc v2_toml_suite {name rev} { |
||||
variable plat |
||||
set l {} |
||||
lappend l "# punkbin artifact record (test fixture, schema v2 suite-built)" |
||||
lappend l "schema = 2" |
||||
lappend l "\[artifact\]" |
||||
lappend l "name = \"$name\"" |
||||
lappend l "class = \"runtime\"" |
||||
lappend l "variant = \"punk\"" |
||||
lappend l "revision = $rev" |
||||
lappend l "target = \"$plat\"" |
||||
lappend l "\[runtime\]" |
||||
lappend l "tcl_patchlevel = \"9.9.1\"" |
||||
lappend l "\[provenance\]" |
||||
lappend l "class = \"suite-built\"" |
||||
lappend l "suite = \"suite_fixture\"" |
||||
return "[join $l \n]\n" |
||||
} |
||||
proc v2_toml_thirdparty {name} { |
||||
variable plat |
||||
set l {} |
||||
lappend l "# punkbin artifact record (test fixture, schema v2 third-party)" |
||||
lappend l "schema = 2" |
||||
lappend l "\[artifact\]" |
||||
lappend l "name = \"$name\"" |
||||
lappend l "class = \"runtime\"" |
||||
lappend l "target = \"$plat\"" |
||||
lappend l "\[runtime\]" |
||||
lappend l "tcl_patchlevel = \"9.9.2\"" |
||||
lappend l "\[provenance\]" |
||||
lappend l "class = \"third-party\"" |
||||
lappend l "builder = \"Fixture Builder\"" |
||||
lappend l "source_url = \"https://example.invalid/thirdkit\"" |
||||
lappend l "upstream_ref = \"v9.9.2\"" |
||||
lappend l "retrieved = \"2026-07-31\"" |
||||
return "[join $l \n]\n" |
||||
} |
||||
|
||||
variable serverroot "" |
||||
variable stagedir "" |
||||
variable serverchan "" |
||||
variable baseurl "" |
||||
variable saved_env [dict create] |
||||
variable fixtureok 0 |
||||
|
||||
proc server_start {} { |
||||
variable serverroot |
||||
variable serverchan |
||||
variable baseurl |
||||
variable testsroot |
||||
set helper [file join $testsroot testsupport httpfixture.tcl] |
||||
if {![file exists $helper]} { return 0 } |
||||
if {[catch {open |[list [info nameofexecutable] $helper $serverroot] r+} chan]} { |
||||
return 0 |
||||
} |
||||
chan configure $chan -blocking 1 -buffering line |
||||
set line [gets $chan] |
||||
if {[regexp {^PORT (\d+)$} $line -> p]} { |
||||
set serverchan $chan |
||||
set baseurl "http://127.0.0.1:$p" |
||||
return 1 |
||||
} |
||||
catch {close $chan} |
||||
return 0 |
||||
} |
||||
proc server_stop {} { |
||||
variable serverchan |
||||
if {$serverchan ne ""} { |
||||
catch {close $serverchan} |
||||
set serverchan "" |
||||
} |
||||
} |
||||
|
||||
#--- local staging (the payloads' script dir + runtime store) ------------------ |
||||
proc reset_stage {} { |
||||
variable stagedir |
||||
variable plat |
||||
file delete -force [file join $stagedir runtime] |
||||
file mkdir [file join $stagedir runtime $plat] |
||||
} |
||||
proc stage_file {name content} { |
||||
variable stagedir |
||||
variable plat |
||||
writefile_raw [file join $stagedir runtime $plat $name] $content |
||||
} |
||||
proc staged_path {name} { |
||||
variable stagedir |
||||
variable plat |
||||
return [file join $stagedir runtime $plat $name] |
||||
} |
||||
|
||||
#--- payload drivers ------------------------------------------------------------ |
||||
proc run_cmdroute {args} { |
||||
variable stagedir |
||||
set comspec [expr {[info exists ::env(ComSpec)] ? $::env(ComSpec) : "cmd.exe"}] |
||||
set cmdfile [file nativename [file join $stagedir punk-runtime.cmd]] |
||||
set output "" |
||||
set code 0 |
||||
if {[catch {exec -- $comspec /c $cmdfile {*}$args << "" 2>@1} output opts]} { |
||||
set ec [dict get $opts -errorcode] |
||||
if {[lindex $ec 0] eq "CHILDSTATUS"} { |
||||
set code [lindex $ec 2] |
||||
} else { |
||||
set code -1 |
||||
} |
||||
} |
||||
return [dict create exit $code output $output] |
||||
} |
||||
proc run_bashroute {args} { |
||||
variable stagedir |
||||
variable msysbash |
||||
set sdir [string map {\\ /} $stagedir] |
||||
set script "cd '$sdir' && ./punk-runtime.bash" |
||||
foreach a $args { append script " $a" } |
||||
set output "" |
||||
set code 0 |
||||
if {[catch {exec -- $msysbash -c $script << "" 2>@1} output opts]} { |
||||
set ec [dict get $opts -errorcode] |
||||
if {[lindex $ec 0] eq "CHILDSTATUS"} { |
||||
set code [lindex $ec 2] |
||||
} else { |
||||
set code -1 |
||||
} |
||||
} |
||||
return [dict create exit $code output $output] |
||||
} |
||||
#normalized info-table record rows (leading-2-space field rows), for parity |
||||
#comparison of the provenance-bearing lines between payloads |
||||
proc recordrows {output keys} { |
||||
set res {} |
||||
foreach ln [split $output \n] { |
||||
set ln [string trimright $ln \r] |
||||
foreach k $keys { |
||||
if {[regexp [format {^ %s\s} $k] $ln]} { |
||||
#squeeze runs of spaces so column padding differences never |
||||
#enter the parity comparison |
||||
lappend res [regsub -all {\s+} $ln { }] |
||||
} |
||||
} |
||||
} |
||||
return $res |
||||
} |
||||
proc count_matches {output needle} { |
||||
set n 0 |
||||
foreach ln [split $output \n] { |
||||
if {[string first $needle $ln] >= 0} { incr n } |
||||
} |
||||
return $n |
||||
} |
||||
|
||||
#--- one-time fixture build + server launch ------------------------------------- |
||||
if {[testConstraint iswindows] && [testConstraint haveruntimecmd] |
||||
&& [testConstraint havebashsource] && [testConstraint havecertutil] |
||||
&& [testConstraint msysbash]} { |
||||
variable serverroot [makeDirectory rtprov_server] |
||||
variable stagedir [makeDirectory rtprov_stage] |
||||
file mkdir [file join $serverroot $plat] |
||||
file copy -force $target [file join $stagedir punk-runtime.cmd] |
||||
file copy -force $bashsource [file join $stagedir punk-runtime.bash] |
||||
set sums {} |
||||
dict for {aname acontent} $artifacts { |
||||
set af [file join $serverroot $plat $aname] |
||||
writefile_raw $af $acontent |
||||
lappend sums "[sha1_of_file $af] *$aname" |
||||
} |
||||
#sidecar tomls: suite-built for the family artifact, retroactive-style |
||||
#third-party for the bare name; norec.exe deliberately has none |
||||
set tf [file join $serverroot $plat fakert-suite-r1.toml] |
||||
writefile_raw $tf [v2_toml_suite fakert-suite-r1.exe 1] |
||||
lappend sums "[sha1_of_file $tf] *fakert-suite-r1.toml" |
||||
set tf [file join $serverroot $plat thirdkit.toml] |
||||
writefile_raw $tf [v2_toml_thirdparty thirdkit.exe] |
||||
lappend sums "[sha1_of_file $tf] *thirdkit.toml" |
||||
writefile_raw [file join $serverroot $plat sha1sums.txt] "[join $sums \n]\n" |
||||
writefile_raw [file join $serverroot defaults.txt] "# test fixture defaults\n$plat fakert-suite-r1.exe\n" |
||||
variable fixtureok [server_start] |
||||
if {$fixtureok} { |
||||
#point both payloads at the fixture (a NON-canonical origin - the |
||||
#consent gate's subject); shield the run from ambient punk-runtime |
||||
#env state. PUNKBIN_TRUST_SERVER stays UNSET at file level: the |
||||
#gate tests exercise refusal, and trusting tests pass the flag (or |
||||
#set the env per-test). |
||||
foreach v {PUNKBIN_URL PUNK_RUNTIME_PLATFORM PUNK_ACTIVE_RUNTIME PUNKBIN_TRUST_SERVER} { |
||||
if {[info exists ::env($v)]} { |
||||
dict set saved_env $v $::env($v) |
||||
unset ::env($v) |
||||
} |
||||
} |
||||
set ::env(PUNKBIN_URL) $baseurl |
||||
} |
||||
} |
||||
testConstraint fixtureserver $fixtureok |
||||
variable C {iswindows haveruntimecmd havebashsource havecertutil msysbash fixtureserver} |
||||
|
||||
#added 2026-07-31 (agent, G-123) - schema-v2 provenance + server-trust gate |
||||
#characterization, both payloads |
||||
|
||||
test runtimecmd_prov_gate_refusal {fetch from the non-canonical fixture origin with no acknowledgement: both payloads refuse naming the canonical origin and the -trust-server flag, exit nonzero, and no artifact lands in the store}\ |
||||
-constraints $C\ |
||||
-setup {reset_stage}\ |
||||
-body { |
||||
set result {} |
||||
foreach route {run_cmdroute run_bashroute} { |
||||
set r [$route fetch thirdkit.exe -platform $plat] |
||||
lappend result [expr {[dict get $r exit] != 0}] |
||||
lappend result [expr {[count_matches [dict get $r output] "not the canonical punkbin origin"] >= 1}] |
||||
lappend result [expr {[count_matches [dict get $r output] "-trust-server"] >= 1}] |
||||
} |
||||
lappend result [file exists [staged_path thirdkit.exe]] |
||||
set result |
||||
}\ |
||||
-result [list 1 1 1 1 1 1 0] |
||||
|
||||
test runtimecmd_prov_fetch_trustflag_bare_sidecar {fetch of a BARE third-party name with -trust-server: both payloads pass the gate, verify sha1, and also retrieve the retroactive sidecar toml}\ |
||||
-constraints $C\ |
||||
-body { |
||||
set result {} |
||||
foreach route {run_cmdroute run_bashroute} { |
||||
reset_stage |
||||
set r [$route fetch thirdkit.exe -platform $plat -trust-server] |
||||
lappend result [dict get $r exit] |
||||
lappend result [file exists [staged_path thirdkit.exe]] |
||||
lappend result [file exists [staged_path thirdkit.toml]] |
||||
} |
||||
set result |
||||
}\ |
||||
-result [list 0 1 1 0 1 1] |
||||
|
||||
test runtimecmd_prov_fetch_trustenv {PUNKBIN_TRUST_SERVER=1 is the unattended acknowledgement: fetch with no flag succeeds from both payloads}\ |
||||
-constraints $C\ |
||||
-setup { |
||||
reset_stage |
||||
set ::env(PUNKBIN_TRUST_SERVER) 1 |
||||
}\ |
||||
-cleanup { |
||||
unset -nocomplain ::env(PUNKBIN_TRUST_SERVER) |
||||
}\ |
||||
-body { |
||||
set result {} |
||||
foreach route {run_cmdroute run_bashroute} { |
||||
reset_stage |
||||
set r [$route fetch thirdkit.exe -platform $plat] |
||||
lappend result [dict get $r exit] |
||||
lappend result [file exists [staged_path thirdkit.exe]] |
||||
} |
||||
set result |
||||
}\ |
||||
-result [list 0 1 0 1] |
||||
|
||||
test runtimecmd_prov_list_class_tags {list -remote and plain list carry the compact class= tag for the third-party row only: suite-built stays quiet and the record-less artifact shows no tag (no-basis degradation)}\ |
||||
-constraints $C\ |
||||
-setup { |
||||
reset_stage |
||||
#fetch both record-carrying artifacts (sidecars ride along), stage the |
||||
#record-less one as a plain local file |
||||
run_cmdroute fetch thirdkit.exe -platform $plat -trust-server |
||||
run_cmdroute fetch fakert-suite-r1.exe -platform $plat -trust-server |
||||
stage_file norec.exe [dict get $artifacts norec.exe] |
||||
}\ |
||||
-body { |
||||
set result {} |
||||
foreach route {run_cmdroute run_bashroute} { |
||||
set r [$route list -remote -platform $plat] |
||||
lappend result [dict get $r exit] |
||||
lappend result [count_matches [dict get $r output] "class=third-party"] |
||||
lappend result [count_matches [dict get $r output] "class=suite-built"] |
||||
set rl [$route list -platform $plat] |
||||
lappend result [count_matches [dict get $rl output] "class=third-party"] |
||||
lappend result [count_matches [dict get $rl output] "class=suite-built"] |
||||
} |
||||
set result |
||||
}\ |
||||
-result [list 0 1 0 1 0 0 1 0 1 0] |
||||
|
||||
test runtimecmd_prov_info_fields_and_caveat_parity {info on the fetched third-party artifact: schema-v2 fields and the table-aware provenance_class row appear while the flat class row stays 'runtime' (ordering caveat); record rows identical from both payloads; the suite artifact reports provenance_class suite-built}\ |
||||
-constraints $C\ |
||||
-setup { |
||||
reset_stage |
||||
run_cmdroute fetch thirdkit.exe -platform $plat -trust-server |
||||
run_cmdroute fetch fakert-suite-r1.exe -platform $plat -trust-server |
||||
}\ |
||||
-body { |
||||
set result {} |
||||
set keys {class builder source_url upstream_ref retrieved provenance_class} |
||||
set rowsets {} |
||||
foreach route {run_cmdroute run_bashroute} { |
||||
set r [$route info thirdkit.exe -platform $plat] |
||||
lappend result [dict get $r exit] |
||||
set rows [recordrows [dict get $r output] $keys] |
||||
lappend rowsets $rows |
||||
lappend result [expr {[lsearch -exact $rows { class - runtime}] >= 0}] |
||||
lappend result [expr {[lsearch -exact $rows { provenance_class - third-party}] >= 0}] |
||||
lappend result [expr {[lsearch -exact $rows { builder - Fixture Builder}] >= 0}] |
||||
lappend result [expr {[lsearch -exact $rows { retrieved - 2026-07-31}] >= 0}] |
||||
} |
||||
lappend result [expr {[lindex $rowsets 0] eq [lindex $rowsets 1]}] |
||||
set rs [run_cmdroute info fakert-suite-r1.exe -platform $plat] |
||||
lappend result [expr {[lsearch -exact [recordrows [dict get $rs output] {provenance_class}] { provenance_class - suite-built}] >= 0}] |
||||
set result |
||||
}\ |
||||
-result [list 0 1 1 1 1 0 1 1 1 1 1 1] |
||||
|
||||
#whole-file teardown: stop the fixture server, restore shielded env state |
||||
if {$fixtureok} { |
||||
server_stop |
||||
unset -nocomplain ::env(PUNKBIN_URL) |
||||
dict for {v val} $saved_env { |
||||
set ::env($v) $val |
||||
} |
||||
} |
||||
} |
||||
tcltest::cleanupTests ;#needed to produce test summary line. |
||||
Loading…
Reference in new issue