Browse Source
Boot (punk_main.tcl + project_main.tcl, identical copies):
- zipfs presence keys on tcl::zipfs::mount - present in every supported zipfs
generation - not tcl::zipfs::root (8.7/9-era; absent from the androwish/
undroidwish 8.6 backport, whose ::zipfs ensemble also lacks a root subcommand).
- New factored ::punkboot procs (zipfs_mount_pairs, zipfs_kit_mountbase,
path_within) derive where this executable's attached archive actually mounted:
the mount-table entry whose archive file is [info nameofexecutable] (the
backport reports it without the windows drive prefix - handled), fallback the
mount containing the boot script. //zipfs:/app stays the expected modern
answer, not an assumption. Procs remain defined post-boot for tests.
- A mounted archive that cannot be attributed to the executable is reported on
stderr instead of silently configuring no internal paths (the old failure shape).
- The starkit quick-search line [zipfs root]/app/tcl_library (an error on the
backport) uses the derived base; internal_paths gains the derived base when no
zipfs volume root covers it; the internal-only simulate-kit branch recognises a
script under the derived mount as kit-internal.
make.tcl (necessary companion fixes - Scope extension flagged in the goal file):
- Runtime capability probe keys has_zipfs on tcl::zipfs::mount (was root, which
refused zip assembly for the backport; the block also rode a body-less
'if {![catch ..]}' that only worked because piped-stdin tclsh continues past
command errors).
- merge_over resolves relative fauxlink targets against the link file's own
directory (the fauxlink module's symlink semantics) - identical for the
pre-existing root-level links, required for the new nested one.
Payload + matrix:
- punk8win.vfs gains an app/main.tcl fauxlink beside root main.tcl: the
undroidwish family auto-runs app/main.tcl INSIDE the attached archive
(embedded /app/main.tcl string in the exe) and ignores a root main.tcl.
Inert in the metakit kits sharing the payload (punksys/punk86/punkbi verified).
- mapvfs.config: punkluck86 (tclsh8.6.10-luck-zip) + punk91ix86
(tclsh9.1b0-tclsfe), both zip kits targeting win32-ix86.
Tests + docs:
- New shell/testsuites/punkexe/kitmountpoint.test (4 tests): backport exe-path
attribution, modern-32 //zipfs:/app, baked punkexe regression pin,
unattributed-mount stderr report + no foreign paths. Self-gates on the
untracked verification runtimes.
- bin/AGENTS.md "Kit-wrappable runtime requirements (G-129)" + src/AGENTS.md
pointer, src/vfs/AGENTS.md boot contract, src/tests/shell/AGENTS.md suite doc,
ARCHITECTURE.md boot-chain bullet.
- Thin-layout + templates-modpod copies synced (make.tcl modules; _config boot
mains refreshed into the project-0.1 store layout per the 17250a8c precedent).
Verified: punkluck86 + punk91ix86 boot and resolve punk::args from inside their
mounts with externals stripped; punk905/punk902z (zipfs) + punksys/punk86
(starkit) probe byte-identical before/after; both zip offset conventions (mkimg
+ concat) mount on the backport; full suite 1171 tests with only the documented
exec-14.3 baseline failure.
Claude-Session: https://claude.ai/code/session_01UEgomWq6kA6c4A8GswqqGW
Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com
master
20 changed files with 1300 additions and 177 deletions
@ -1,4 +1,4 @@ |
|||||||
[project] |
[project] |
||||||
name = "punkshell" |
name = "punkshell" |
||||||
version = "0.27.4" |
version = "0.28.0" |
||||||
license = "BSD-2-Clause" |
license = "BSD-2-Clause" |
||||||
|
|||||||
@ -0,0 +1,264 @@ |
|||||||
|
package require tcltest |
||||||
|
|
||||||
|
#added 2026-07-27 (agent, G-129) |
||||||
|
#G-129 characterization: the kit boot derives its payload mount point from the runtime's |
||||||
|
#own zipfs mount table (the entry whose archive file is [info nameofexecutable]) instead |
||||||
|
#of assuming tcl::zipfs::root + //zipfs:/app - so a runtime that mounts its attached |
||||||
|
#archive at the EXECUTABLE'S OWN PATH (the androwish/undroidwish 8.6 backport family, |
||||||
|
#which also has no tcl::zipfs::root) boots a kit that finds its own modules and libs. |
||||||
|
# |
||||||
|
#The runtime-driven tests exercise the WORKING TREE's src/vfs/_config/punk_main.tcl |
||||||
|
#directly (runtime + punk_main.tcl as its script argument + 'tclsh <probe>' args), so no |
||||||
|
#bake is needed and no stale-kit caveat applies. The derivation is asserted through |
||||||
|
#::punkboot::zipfs_kit_mountbase, which punk_main.tcl leaves defined after boot. |
||||||
|
# |
||||||
|
#Self-gating (the pattern zipreader_piperepl_runtime uses): the two third-party 32-bit |
||||||
|
#verification runtimes live in the untracked bin/runtime/win32-ix86/ store tier - tests |
||||||
|
#skip cleanly when they are absent. The LUCK build is reproducible from the service named |
||||||
|
#in bin/runtime/win32-ix86/LUCK.url via the base64 build request in |
||||||
|
#tclsh8.6.10-luck-zip.cfg; tclsh9.1b0-tclsfe.exe comes from apnadkarni/tcl-sfe releases. |
||||||
|
#The punkexe-kit test asserts the BAKED main.tcl and gates on the derivation proc being |
||||||
|
#present in the kit (a pre-G-129 kit skips; rebuild per this suite's AGENTS.md notes). |
||||||
|
#The unattributed-mount test uses any zipfs-capable runtime with an EMPTY mount table |
||||||
|
#(default bin/runtime/win32-x86_64/tclkit902.exe - metakit payload, tcl9 core zipfs). |
||||||
|
|
||||||
|
namespace eval ::testspace { |
||||||
|
namespace import ::tcltest::* |
||||||
|
|
||||||
|
variable testdir [file dirname [file normalize [info script]]] |
||||||
|
#<projectroot>/src/tests/shell/testsuites/punkexe -> 5 levels up to <projectroot> |
||||||
|
variable projectroot [file normalize [file join $testdir .. .. .. .. ..]] |
||||||
|
variable punkmain $projectroot/src/vfs/_config/punk_main.tcl |
||||||
|
|
||||||
|
variable luckexe $projectroot/bin/runtime/win32-ix86/tclsh8.6.10-luck-zip.exe |
||||||
|
variable sfe32exe $projectroot/bin/runtime/win32-ix86/tclsh9.1b0-tclsfe.exe |
||||||
|
variable emptymountexe $projectroot/bin/runtime/win32-x86_64/tclkit902.exe |
||||||
|
|
||||||
|
variable punkexe "" |
||||||
|
if {[info exists ::env(PUNK_SHELL_TEST_EXE)] && $::env(PUNK_SHELL_TEST_EXE) ne ""} { |
||||||
|
set punkexe [file normalize $::env(PUNK_SHELL_TEST_EXE)] |
||||||
|
} else { |
||||||
|
foreach candidate [list [file join $projectroot bin punk902z.exe] [file join $projectroot bin punkshell902]] { |
||||||
|
if {[file exists $candidate]} { |
||||||
|
set punkexe $candidate |
||||||
|
break |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
variable punk_run_timeout_ms 30000 |
||||||
|
variable runstate |
||||||
|
array set runstate {} |
||||||
|
|
||||||
|
proc punk_run_read {chan} { |
||||||
|
variable runstate |
||||||
|
append runstate(output) [read $chan] |
||||||
|
if {[chan eof $chan]} { |
||||||
|
chan event $chan readable {} |
||||||
|
set runstate(done) eof |
||||||
|
} |
||||||
|
} |
||||||
|
#Run an executable with args, feed stdin_data via pipe then half-close. |
||||||
|
#Returns dict: timedout 0|1, exitcode <int|kill-info|"">, output <combined stdout+stderr> |
||||||
|
proc punk_run {exe cmdargs stdin_data} { |
||||||
|
variable runstate |
||||||
|
variable punk_run_timeout_ms |
||||||
|
array unset runstate |
||||||
|
set runstate(output) "" |
||||||
|
set runstate(done) "" |
||||||
|
set env_had [info exists ::env(PUNK_PIPE_EOF)] |
||||||
|
if {$env_had} { |
||||||
|
set env_save $::env(PUNK_PIPE_EOF) |
||||||
|
} |
||||||
|
set ::env(PUNK_PIPE_EOF) exit |
||||||
|
set chan [open |[list $exe {*}$cmdargs 2>@1] r+] |
||||||
|
if {$env_had} { |
||||||
|
set ::env(PUNK_PIPE_EOF) $env_save |
||||||
|
} else { |
||||||
|
unset ::env(PUNK_PIPE_EOF) |
||||||
|
} |
||||||
|
set pids [pid $chan] |
||||||
|
chan configure $chan -blocking 0 -translation binary |
||||||
|
catch { |
||||||
|
puts -nonewline $chan $stdin_data |
||||||
|
flush $chan |
||||||
|
chan close $chan write |
||||||
|
} |
||||||
|
set timerid [after $punk_run_timeout_ms [list set [namespace current]::runstate(done) timeout]] |
||||||
|
chan event $chan readable [list [namespace current]::punk_run_read $chan] |
||||||
|
vwait [namespace current]::runstate(done) |
||||||
|
after cancel $timerid |
||||||
|
set timedout [expr {$runstate(done) eq "timeout"}] |
||||||
|
set exitcode "" |
||||||
|
if {$timedout} { |
||||||
|
foreach p $pids { |
||||||
|
catch {exec {*}[auto_execok taskkill] /F /T /PID $p} killres |
||||||
|
lappend exitcode [list killed $p] |
||||||
|
} |
||||||
|
catch {chan close $chan} |
||||||
|
} else { |
||||||
|
chan configure $chan -blocking 1 |
||||||
|
if {[catch {chan close $chan} errM errOpts]} { |
||||||
|
set details [dict get $errOpts -errorcode] |
||||||
|
if {[lindex $details 0] eq "CHILDSTATUS"} { |
||||||
|
set exitcode [lindex $details 2] |
||||||
|
} else { |
||||||
|
set exitcode [list error $errM] |
||||||
|
} |
||||||
|
} else { |
||||||
|
set exitcode 0 |
||||||
|
} |
||||||
|
} |
||||||
|
return [dict create timedout $timedout exitcode $exitcode output $runstate(output)] |
||||||
|
} |
||||||
|
|
||||||
|
#shared probe: runs under '<runtime> punk_main.tcl tclsh <probe>' AFTER the boot path |
||||||
|
#assembly - reports the derivation's answer and whether it equals this executable's path |
||||||
|
variable mountprobe [makeFile { |
||||||
|
set mb [::punkboot::zipfs_kit_mountbase] |
||||||
|
set normexe [file dirname [file normalize [file join [info nameofexecutable] __dummy__]]] |
||||||
|
puts "MOUNTBASE=>$mb<" |
||||||
|
puts "MOUNTBASE_IS_EXEPATH=[string equal -nocase $mb $normexe]" |
||||||
|
exit 0 |
||||||
|
} kitmountpoint_probe.tcl] |
||||||
|
variable mountprobe_fwd [string map {\\ /} $mountprobe] |
||||||
|
|
||||||
|
testConstraint windowshost [expr {$::tcl_platform(platform) eq "windows"}] |
||||||
|
testConstraint luckruntime [expr {$::tcl_platform(platform) eq "windows" && [file exists $luckexe]}] |
||||||
|
testConstraint sfe32runtime [expr {$::tcl_platform(platform) eq "windows" && [file exists $sfe32exe]}] |
||||||
|
|
||||||
|
#punkexe kit gate: kit exists AND its baked main.tcl defines the derivation proc |
||||||
|
#(a kit baked before G-129 skips rather than fails) |
||||||
|
variable punkexe_has_derivation 0 |
||||||
|
if {$punkexe ne "" && [file exists $punkexe]} { |
||||||
|
variable gateprobe [makeFile { |
||||||
|
puts "HASDERIVATION=[expr {[info commands ::punkboot::zipfs_kit_mountbase] ne ""}]" |
||||||
|
exit 0 |
||||||
|
} kitmountpoint_gate.tcl] |
||||||
|
set r [punk_run $punkexe [list tclsh [string map {\\ /} $gateprobe]] ""] |
||||||
|
if {![dict get $r timedout] && [string match "*HASDERIVATION=1*" [dict get $r output]]} { |
||||||
|
set punkexe_has_derivation 1 |
||||||
|
} |
||||||
|
} |
||||||
|
testConstraint punkexederivation $punkexe_has_derivation |
||||||
|
|
||||||
|
#empty-mount-table runtime gate for the unattributed-mount test: zipfs commands |
||||||
|
#present (incl mkzip) but nothing mounted (library carried outside zipfs) |
||||||
|
variable emptymount_ok 0 |
||||||
|
if {[file exists $emptymountexe]} { |
||||||
|
variable emptyprobe [makeFile { |
||||||
|
set ok [expr {[info commands ::tcl::zipfs::mount] ne "" && [info commands ::tcl::zipfs::mkzip] ne "" && ![llength [::tcl::zipfs::mount]]}] |
||||||
|
puts "EMPTYMOUNTOK=$ok" |
||||||
|
exit 0 |
||||||
|
} kitmountpoint_emptygate.tcl] |
||||||
|
set r [punk_run $emptymountexe [list [string map {\\ /} $emptyprobe]] ""] |
||||||
|
if {![dict get $r timedout] && [string match "*EMPTYMOUNTOK=1*" [dict get $r output]]} { |
||||||
|
set emptymount_ok 1 |
||||||
|
} |
||||||
|
} |
||||||
|
testConstraint emptymountruntime $emptymount_ok |
||||||
|
|
||||||
|
test kitmountpoint_backport_exe_mount {8.6 backport family (no tcl::zipfs::root, archive mounted at the executable's own path): the boot attributes the mount to the executable and reports it as the mount base}\ |
||||||
|
-constraints luckruntime\ |
||||||
|
-setup { |
||||||
|
set result "" |
||||||
|
}\ |
||||||
|
-body { |
||||||
|
variable luckexe |
||||||
|
variable punkmain |
||||||
|
variable mountprobe_fwd |
||||||
|
set r [punk_run $luckexe [list [string map {\\ /} $punkmain] tclsh $mountprobe_fwd] ""] |
||||||
|
lappend result [dict get $r timedout] |
||||||
|
lappend result [regexp {MOUNTBASE_IS_EXEPATH=1} [dict get $r output]] |
||||||
|
lappend result [string match "*none of the mounts could be attributed*" [dict get $r output]] |
||||||
|
set result |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
}\ |
||||||
|
-result [list 0 1 0] |
||||||
|
|
||||||
|
test kitmountpoint_modern32_app_mount {modern //zipfs:/app convention (32-bit tcl-sfe): the derivation returns the conventional mount - the 32-bit target itself needs nothing special}\ |
||||||
|
-constraints sfe32runtime\ |
||||||
|
-setup { |
||||||
|
set result "" |
||||||
|
}\ |
||||||
|
-body { |
||||||
|
variable sfe32exe |
||||||
|
variable punkmain |
||||||
|
variable mountprobe_fwd |
||||||
|
set r [punk_run $sfe32exe [list [string map {\\ /} $punkmain] tclsh $mountprobe_fwd] ""] |
||||||
|
lappend result [dict get $r timedout] |
||||||
|
lappend result [regexp {MOUNTBASE=>//zipfs:/app<} [dict get $r output]] |
||||||
|
lappend result [string match "*none of the mounts could be attributed*" [dict get $r output]] |
||||||
|
set result |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
}\ |
||||||
|
-result [list 0 1 0] |
||||||
|
|
||||||
|
test kitmountpoint_punkexe_app_mount {the ordinary 64-bit zipfs kit still derives //zipfs:/app (baked main.tcl - regression pin for the modern case)}\ |
||||||
|
-constraints punkexederivation\ |
||||||
|
-setup { |
||||||
|
set result "" |
||||||
|
}\ |
||||||
|
-body { |
||||||
|
variable punkexe |
||||||
|
variable mountprobe_fwd |
||||||
|
set r [punk_run $punkexe [list tclsh $mountprobe_fwd] ""] |
||||||
|
lappend result [dict get $r timedout] |
||||||
|
lappend result [regexp {MOUNTBASE=>//zipfs:/app<} [dict get $r output]] |
||||||
|
set result |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
}\ |
||||||
|
-result [list 0 1] |
||||||
|
|
||||||
|
test kitmountpoint_unattributed_reports_stderr {a mounted zipfs archive that cannot be attributed to the executable is reported on stderr (not silent), boot continues, and the foreign mount contributes no kit paths}\ |
||||||
|
-constraints emptymountruntime\ |
||||||
|
-setup { |
||||||
|
set result "" |
||||||
|
#wrapper: mount a freshly built unrelated zip (no exe-attributable entry in the |
||||||
|
#table), then source the working tree's punk_main.tcl dispatching a post-boot probe |
||||||
|
variable postprobe [makeFile { |
||||||
|
puts "POSTTM=>[tcl::tm::list]<" |
||||||
|
puts "POSTAP=>$::auto_path<" |
||||||
|
puts "POSTBOOT_OK" |
||||||
|
exit 0 |
||||||
|
} kitmountpoint_post.tcl] |
||||||
|
variable wrapper [makeFile [string map [list %PUNKMAIN% [string map {\\ /} $punkmain] %POSTPROBE% [string map {\\ /} $postprobe]] { |
||||||
|
set tmpbase [file dirname [info script]] |
||||||
|
file mkdir $tmpbase/g129dummydir |
||||||
|
set fd [open $tmpbase/g129dummydir/marker.txt w] |
||||||
|
puts $fd g129 |
||||||
|
close $fd |
||||||
|
tcl::zipfs::mkzip $tmpbase/g129dummy.zip $tmpbase/g129dummydir $tmpbase/g129dummydir |
||||||
|
#tcl 9 core order is 'zipfs mount zipfile mountpoint'; accept the reversed |
||||||
|
#order used by some generations |
||||||
|
if {[catch {tcl::zipfs::mount $tmpbase/g129dummy.zip //zipfs:/g129test}]} { |
||||||
|
tcl::zipfs::mount //zipfs:/g129test $tmpbase/g129dummy.zip |
||||||
|
} |
||||||
|
set ::argv [list tclsh %POSTPROBE%] |
||||||
|
source %PUNKMAIN% |
||||||
|
}] kitmountpoint_wrapper.tcl] |
||||||
|
}\ |
||||||
|
-body { |
||||||
|
variable emptymountexe |
||||||
|
variable wrapper |
||||||
|
set r [punk_run $emptymountexe [list [string map {\\ /} $wrapper]] ""] |
||||||
|
set out [dict get $r output] |
||||||
|
lappend result [dict get $r timedout] |
||||||
|
lappend result [string match "*none of the mounts could be attributed*" $out] |
||||||
|
lappend result [string match "*POSTBOOT_OK*" $out] |
||||||
|
set tm_and_ap "" |
||||||
|
regexp {POSTTM=>([^<]*)<} $out -> tm_part |
||||||
|
regexp {POSTAP=>([^<]*)<} $out -> ap_part |
||||||
|
if {[info exists tm_part]} {append tm_and_ap $tm_part} |
||||||
|
if {[info exists ap_part]} {append tm_and_ap " " $ap_part} |
||||||
|
lappend result [string match "*g129test*" $tm_and_ap] |
||||||
|
set result |
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
}\ |
||||||
|
-result [list 0 1 1 0] |
||||||
|
} |
||||||
|
tcltest::cleanupTests ;#needed to produce test summary line. |
||||||
Loading…
Reference in new issue