diff --git a/ARCHITECTURE.md b/ARCHITECTURE.md index 3a40a74b..c231adf5 100644 --- a/ARCHITECTURE.md +++ b/ARCHITECTURE.md @@ -44,6 +44,7 @@ app package from src/lib/ (app-punkshell, app-punkscript, app-repl, app-shellsp - **Kit anatomy.** Each `src/vfs/*.vfs` folder is a runtime payload; `src/runtime/mapvfs.config` maps payload folders to platform runtimes under `bin/runtime//`; `src/vfs/_vfscommon.vfs/` is a generated merge of common libraries (never hand-edited); `src/vfs/_config/` holds the entry scripts. Sources: `src/vfs/AGENTS.md`, `src/runtime/AGENTS.md`. - **Entry point.** `src/vfs/_config/punk_main.tcl`. An optional first argument is a dash-delimited package mode composed of tokens from `dev`, `os`, `src`, `internal` (`internal` is always appended when absent). The next argument is the subcommand: `shell`, `script`, `punk`, `tclsh`, `shellspy`. Any other first argument is treated as a script invocation; no arguments at all means interactive shell. Subcommands map to app packages under `src/lib/` (`app-punkshell`, `app-punkscript`, `app-repl`, `app-shellspy`). - **Package modes pick module provenance.** `internal` uses module snapshots baked into the kit at build time; `dev` loads build outputs from repo-root `modules/` and `lib/`; `src` loads the unbuilt working tree (`src/modules`, `src/lib`, `src/bootsupport`, `src/vendormodules`) with `package prefer latest` so magic-version dev modules (`999999.0a1.0`) beat stamped snapshots. `src` mode is the standard way to verify working-tree changes without a rebuild. Source: `bin/AGENTS.md` "Launch package modes". +- **Payload mount derivation (G-129, achieved).** The boot keys zipfs presence on `tcl::zipfs::mount` and derives where the executable's attached archive actually mounted from the mount table itself (the entry whose archive file is the executable; fallback: the mount containing the boot script) instead of assuming `tcl::zipfs::root` + `//zipfs:/app`. Modern runtimes still answer `//zipfs:/app`; the androwish/undroidwish 8.6 backport has no `root` command, mounts at the executable's own path, and boots the same payload through its `app/main.tcl` in-archive hook (`src/vfs/punk8win.vfs` carries fauxlinks for both conventions). A mounted archive the boot cannot attribute is reported on stderr rather than silently yielding no internal paths. The derivation procs stay defined post-boot (`::punkboot::zipfs_kit_mountbase`). Sources: `src/vfs/AGENTS.md`, `bin/AGENTS.md` "Kit-wrappable runtime requirements", `src/tests/shell/testsuites/punkexe/kitmountpoint.test`. - **Static package capture (G-058, achieved).** Boot probe-loads the runtime's statically linked packages in a throwaway interp and records what each provides; every interp the shell fabricates (boot, codethread, shellthread workers) seeds `package ifneeded {load {} }` from that record, and `punk::packagepreference` resolves static-vs-bundled version-aware. Sources: `src/vfs/AGENTS.md`, `goals/archive/G-058-static-runtime-packages.md`. - **`script` subcommand (G-015, achieved).** The lean non-interactive path: default punk shell module/alias environment, no shellfilter stacks/transforms, honest exit codes, launch plumbing emits nothing on stdout/stderr (exec-style callers see only the script's own output). Supports `lib:` scriptlib resolution. App package: `src/lib/app-punkscript/`. - **`tclsh` subcommand (G-118, achieved).** Plain-tclsh emulation with NO punk modules loaded: stock argument-form parity (`-encoding name file`; any other leading `-` argument means no script, everything stays in `::argv`; no `-e` one-liner - deliberate stock parity, see G-077 for the punk-level one-liner direction), `lib:` refused with a pointer at `script`, missing script file is a clean exit 1. On piperepl-patched runtimes (the punk family runtimes - `src/buildsuites/suite_tcl90/patches/`) the C-level machinery publishes `::tclsh` launch state (`istty`, `dorepl`, `evalinput`, `inputbuffer`, `reopened`) allowing piped input to hand over to a live console repl at eof; runtimes without the machinery evaluate piped stdin whole-buffer with honest exit codes and fail fast on console stdin. The subcommand-family contract (tclsh/script/shell/punk/shellspy) is documented as punk::args definitions in `src/modules/punk/args/moduledoc/punkexe-999999.0a1.0.tm` (ids `(script)::punkexe` + per-subcommand; view via `punk::args::usage`), consumable by the future launcher help wiring (G-032). Pipe-testable behaviour pinned by `src/tests/shell/testsuites/punkexe/tclshcmd.test`. diff --git a/CHANGELOG.md b/CHANGELOG.md index 85b3d1c2..c656d792 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,24 @@ The latest `## [X.Y.Z]` header must match the `version` field in `punkproject.to Entries are newest-first; one bullet per notable change. See the root `AGENTS.md` "Project Versioning" section for the bump policy. +## [0.28.0] - 2026-07-27 + +- Kit boot finds its payload wherever the runtime mounted the attached archive (G-129): + zipfs presence now keys on `tcl::zipfs::mount` and the payload mount base derives from + the runtime's own mount table (the entry whose archive file is the executable) instead + of assuming `tcl::zipfs::root` + `//zipfs:/app`. The androwish/undroidwish Tcl 8.6 + zipfs backport - no `root` command, archive mounted at the executable's own path - now + carries a working punk kit. A mounted archive the boot cannot attribute to the + executable is reported on stderr instead of silently configuring no internal paths. +- New 32-bit windows verification kits in the bake matrix (target win32-ix86): + `punkluck86` (LUCK tclsh 8.6.10 zipfs-backport runtime) and `punk91ix86` + (tcl-sfe 9.1b0). Kit-wrappable runtime requirements documented in `bin/AGENTS.md`. +- `punk8win.vfs` payloads carry `app/main.tcl` beside root `main.tcl` (the undroidwish + family's in-archive startup hook; inert elsewhere). make.tcl fauxlink targets now + resolve link-location-relative (symlink semantics; identical for root-level links). +- make.tcl's runtime capability probe keys `has_zipfs` on `tcl::zipfs::mount` (was + `tcl::zipfs::root`, which blocked zip assembly for the backport family). + ## [0.27.4] - 2026-07-27 - `make.tcl bootsupport` no longer fails to replace a mounted modpod. A zip-based `.tm` diff --git a/bin/AGENTS.md b/bin/AGENTS.md index efbbbf73..7b7cab47 100644 --- a/bin/AGENTS.md +++ b/bin/AGENTS.md @@ -95,6 +95,44 @@ The first argument to a built punk shell may be a dash-delimited package mode co - Prepends `src/modules`, `src/modules_tcl`, `src/bootsupport/modules{,_tcl}` and `src/vendormodules{,_tcl}` to the module path, sets `package prefer latest` so dev-numbered `999999.0a1.0` source modules beat kit-stamped snapshots on unversioned `package require`, and registers `#modpod` modules from `src/modules` (startup notice: `src mode: registered N #modpod modules from .../src/modules`). - Consequence: `punksys src` / `punk902z src` exercises current working-tree source with no kit rebuild; a plain launch (`punksys`) exercises the module snapshots baked into the kit at build time. `package present ` reporting `999999.0a1.0` (vs a release version like `0.7.1`) tells you which set a session is running - runbooks with version expectations must state the intended launch mode. +### Kit-wrappable runtime requirements (G-129) + +What a runtime must provide for `make.tcl bake` to wrap it as a punk ZIP kit and for that +kit to boot. (Starkit/tclkit and cookfs runtimes are separate kit types with their own +conventions - this section is the zipfs family.) + +- The core zipfs command set including `tcl::zipfs::mount`, whose no-argument form + reports the mount table as {mountpoint archivefile} pairs. `tcl::zipfs::root` is NOT + required: both the kit boot and the bake's runtime capability probe key zipfs presence + on `tcl::zipfs::mount`. Verified generations: Tcl 8.7/9 core zipfs, and the + androwish/undroidwish Tcl 8.6 zipfs backport (no `root`; its `::zipfs` ensemble also + lacks a root subcommand). +- Any attached-archive mount convention, because the boot derives the payload base from + the mount table itself (the entry whose archive file is `[info nameofexecutable]`, + fallback the mount containing the boot script): modern runtimes mount at the + compiled-in `//zipfs:/app`; the 8.6 backport family mounts at the EXECUTABLE'S OWN + PATH and reports the archive file without its windows drive prefix (both handled). A + mounted archive the boot cannot attribute to the executable is reported on stderr + rather than silently configuring no internal paths. +- A startup hook that sources a script from the attached archive: modern zipfs runtimes + run `main.tcl` at the app-mount root; the undroidwish family looks for `app/main.tcl` + INSIDE the archive. `src/vfs/punk8win.vfs` carries root `main.tcl` AND `app/main.tcl` + fauxlinks so one payload boots either family. +- Either zip offset convention in the assembled kit: `zipfs mkimg` (file-relative + offsets) and raw concatenation (archive-relative) both mount on both verified + families (measured 2026-07-27 with the LUCK backport runtime). +- A payload the bake can lift: the runtime's own library must be readable from its + attached archive (the G-124 `punk::zip` reader handles either offset convention) and + the merged kit must pass the G-125 boot-precondition gate (`tcl_library/`, + `lib/tcl./` or root `tcl./` library conventions). + +The `runtime/win32-ix86/` tier holds the two third-party 32-bit verification runtimes +bracketing the mount conventions: `tclsh8.6.10-luck-zip.exe` (exe-path mount; +reproducible via `LUCK.url` + the base64 build request in `tclsh8.6.10-luck-zip.cfg`) +and `tclsh9.1b0-tclsfe.exe` (modern `//zipfs:/app`; apnadkarni/tcl-sfe releases), +wrapped as `punkluck86` / `punk91ix86` in `src/runtime/mapvfs.config`. Characterization: +`src/tests/shell/testsuites/punkexe/kitmountpoint.test`. + ### Runtime fetch/selection (`punk-runtime.cmd`) `bin/punk-runtime.cmd {fetch|list|use|run}` manages the plain runtimes under diff --git a/punkproject.toml b/punkproject.toml index 97642c56..5572c1d3 100644 --- a/punkproject.toml +++ b/punkproject.toml @@ -1,4 +1,4 @@ [project] name = "punkshell" -version = "0.27.4" +version = "0.28.0" license = "BSD-2-Clause" diff --git a/src/AGENTS.md b/src/AGENTS.md index f969fd21..001fdb47 100644 --- a/src/AGENTS.md +++ b/src/AGENTS.md @@ -77,6 +77,7 @@ Recovery after a wrong path guess: - **Host vs target platform (G-122).** Everything a bake EMITS is keyed by the artifact's TARGET platform, never by the driving tclsh's personality: the `bin/runtime/` store the runtime is read from, `.exe` suffixing of runtime files and kit outputs, the presence checks behind `runtime=missing`, and whether the pre-deploy process sweep uses `tasklist`/`taskkill` or `ps`/`kill`. Host semantics - copy commands, path handling, filesystem case rules, prompts - stay keyed to the host. The default target is the host's own platform canon, EXCEPT a cygwin-family host (an msys2/cygwin-runtime tclsh, which reports `tcl_platform(platform)` `unix` on windows and canonizes as `msys-x86_64`/`cygwin-x86_64`), which targets `win32-x86_64`: such a host now drives the identical kit set, names and store addressing as a native tclsh. `tclsh src/make.tcl check` prints the derivation on one `platform (G-122): host=... target=... store=... exe-suffix=... process-tooling=...` line. A mapvfs entry may declare its own target platform (4th element - see `src/runtime/AGENTS.md`), which is then read from that platform's tier, named with that platform's executable convention, and skipped by the process sweep (its processes are not visible to this host). Traps this closes, all field-verified 2026-07-26: msys `ps` cannot see a natively-launched kit (only `tasklist` can), and msys2 rewrites arguments that look like absolute posix paths when spawning a native windows program - so `taskkill /PID ` arrived as `taskkill C://PID `; native-windows command lines therefore go through `::punkboot::exec_nativeargs` (sets `MSYS2_ARG_CONV_EXCL=*`, inert elsewhere). Also note a cygwin-family tclsh is a POSIX Tcl: name the script the way that shell spells paths (`tclsh /c/repo/.../src/make.tcl`, not `C:/repo/...`, which it resolves relative to the cwd) - make.tcl diagnoses the windows-spelling case. Piped characterization: `src/tests/shell/testsuites/punkexe/maketclplatform.test` (the cygwin-host tests self-gate on finding and probing a real msys/cygwin tclsh; `PUNK_MSYS_TCLSH` names one explicitly). - Zip-type kit assembly does not require zipfs in the driving tcl (G-122): with `tcl::zipfs::mkimg` present it is used as before, otherwise the image is assembled by concatenation (raw-runtime split + `punk::zip::mkzip` + append, the same `::punkboot::assemble_zipcat_image` helper the `zipcat` kit type uses). Both mount identically - tcl zipfs reads the archive with archive-start-relative offsets. - Neither is EXTRACTING the runtime's own attached zip (needed to carry its `tcl_library` into the kit): `punk::zip` >= 0.2.0 reads a zip with stock Tcl only - no zipfs, no vfs::zip, no tcllib (G-124, the former tcllib `zipfile::decode` dependency is gone). The zipfs-less bake path splits off the executable prefix with `punk::zip::extract_preamble` and then reads the MEMBERS from the original runtime with `punk::zip::unzip`, never from the split-off intermediate: a runtime whose zip offsets are file-relative (the historical `zipfs mkimg` convention - `tclsh90b4_piperepl.exe` in the store is one) splits into a .zip whose offsets still count from the removed prefix, which plain zip readers reject. Reading the whole file at the derived base offset makes the two offset conventions indistinguishable to callers; `punk::zip::archive_info ` reports which one a given artifact uses. Verified 2026-07-26 by baking a zip kit from msys2's `/usr/bin/tclsh8.6` (no zipfs, no vfs::zip, no tcllib) and booting the result with its `tcl_library` present. +- What the RUNTIME must provide to be zip-kit-wrappable - which zipfs commands, mount conventions and startup hooks are supported - is documented in `bin/AGENTS.md` "Kit-wrappable runtime requirements (G-129)". Short form: `tcl::zipfs::mount` with pairwise no-arg output (`tcl::zipfs::root` NOT required), any attached-archive mount point (the boot derives it from the runtime's own mount table - the androwish/undroidwish 8.6 backport mounts at the executable's own path), a `main.tcl`/`app/main.tcl` startup hook, and a liftable library payload for the G-125 gate. The bake's runtime capability probe keys `has_zipfs` on `tcl::zipfs::mount` accordingly. - Use `punk make.tcl bakehouse` or `punk902z make.tcl bakehouse` inside Punk shell when building binaries through Punk (the deprecated `project` alias still maps). Driving make.tcl from a built punk executable is supported for informational/update subcommands and for kit builds of *other* kits — the kit whose deployed executable is running the build is skipped with a warning (it cannot be replaced while running, and the pre-deploy process sweep must not kill the build itself; the sweep also excludes the build's own pid in all cases). Rebuild that kit from tclsh or a different kit. - **Punk-exe-hosted make.tcl runs in a pre-loaded interp, not a virgin one** — the kit's script-mode boot has already loaded much of the punk stack (punk, punk::lib, punk::repl, punk::console, punk::du, flagfilter, struct::set ...) and set process state (app-punkscript forces `::tcl_interactive 0` for script semantics; libunknown/packagepreference are active). Consequences make.tcl must (and now does) handle explicitly: `package require` of an already-provided package is a no-op, so anything make.tcl breaks in the interp (the accelerator-reload block forgets+destroys sha1/md5/struct::* — it re-requires what was loaded), and anything computed at package-load time (punk::repl's `::tcl_interactive` probe — the shell branch recomputes it before `repl::start`), must be restored deliberately rather than relying on later loads to re-fire. Also note the copies that run in this mode are the *kit's* pre-loaded modules, not the bootsupport snapshots make.tcl's paths would otherwise prefer — silent provenance mixing when versions diverge. When adding interp-surgery or load-time-state assumptions to make.tcl, test under both `tclsh src/make.tcl ...` and ` src/make.tcl ...`. - Binary images are platform-specific; build on each target platform rather than expecting a cross-platform flag. diff --git a/src/make.tcl b/src/make.tcl index 894dcba5..67f7d37c 100644 --- a/src/make.tcl +++ b/src/make.tcl @@ -5324,14 +5324,15 @@ foreach runtime [dict keys $runtime_vfs_map] { dict set caps has_starkit 0 } } - if {![catch { - set cmd [info commands tcl::zipfs::root] - if {$cmd ne ""} { - dict set caps has_zipfs 1 - } else { - dict set caps has_zipfs 0 - } - } errM]} + #G-129: key zipfs capability on tcl::zipfs::mount - present in every zipfs + #generation including the androwish/undroidwish 8.6 backport, which has no + #tcl::zipfs::root. (This block previously rode a body-less 'if {![catch ..]}' + #that only worked because piped-stdin tclsh continues past command errors.) + if {[info commands tcl::zipfs::mount] ne ""} { + dict set caps has_zipfs 1 + } else { + dict set caps has_zipfs 0 + } if {![catch { package require cookfs } errM]} { @@ -5617,7 +5618,11 @@ proc merge_over {sourcedir targetdir {depth 0}} { flush stdout set linktarget [dict get $linkinfo targetpath] if {[file pathtype $linktarget] eq "relative"} { - set actualsource [file join $sourcedir $linktarget] + #fauxlink targets are link-location-relative (symlink semantics - + #the fauxlink module doc's 'file in parent dir' example). Same as + #the old sourcedir-relative resolution for the historical + #root-level links; differs for nested ones (G-129 app/main.tcl). + set actualsource [file join [file dirname $file_or_dir] $linktarget] } else { set actualsource $linktarget } diff --git a/src/modules/punk/mix/#modpod-templates-999999.0a1.0/templates/project_layouts/vendor/punk/project-0.1/src/make.tcl b/src/modules/punk/mix/#modpod-templates-999999.0a1.0/templates/project_layouts/vendor/punk/project-0.1/src/make.tcl index 894dcba5..67f7d37c 100644 --- a/src/modules/punk/mix/#modpod-templates-999999.0a1.0/templates/project_layouts/vendor/punk/project-0.1/src/make.tcl +++ b/src/modules/punk/mix/#modpod-templates-999999.0a1.0/templates/project_layouts/vendor/punk/project-0.1/src/make.tcl @@ -5324,14 +5324,15 @@ foreach runtime [dict keys $runtime_vfs_map] { dict set caps has_starkit 0 } } - if {![catch { - set cmd [info commands tcl::zipfs::root] - if {$cmd ne ""} { - dict set caps has_zipfs 1 - } else { - dict set caps has_zipfs 0 - } - } errM]} + #G-129: key zipfs capability on tcl::zipfs::mount - present in every zipfs + #generation including the androwish/undroidwish 8.6 backport, which has no + #tcl::zipfs::root. (This block previously rode a body-less 'if {![catch ..]}' + #that only worked because piped-stdin tclsh continues past command errors.) + if {[info commands tcl::zipfs::mount] ne ""} { + dict set caps has_zipfs 1 + } else { + dict set caps has_zipfs 0 + } if {![catch { package require cookfs } errM]} { @@ -5617,7 +5618,11 @@ proc merge_over {sourcedir targetdir {depth 0}} { flush stdout set linktarget [dict get $linkinfo targetpath] if {[file pathtype $linktarget] eq "relative"} { - set actualsource [file join $sourcedir $linktarget] + #fauxlink targets are link-location-relative (symlink semantics - + #the fauxlink module doc's 'file in parent dir' example). Same as + #the old sourcedir-relative resolution for the historical + #root-level links; differs for nested ones (G-129 app/main.tcl). + set actualsource [file join [file dirname $file_or_dir] $linktarget] } else { set actualsource $linktarget } diff --git a/src/modules/punk/mix/#modpod-templates-999999.0a1.0/templates/project_layouts/vendor/punk/project-0.1/src/vfs/_config/project_main.tcl b/src/modules/punk/mix/#modpod-templates-999999.0a1.0/templates/project_layouts/vendor/punk/project-0.1/src/vfs/_config/project_main.tcl index df81c784..c3eb9aab 100644 --- a/src/modules/punk/mix/#modpod-templates-999999.0a1.0/templates/project_layouts/vendor/punk/project-0.1/src/vfs/_config/project_main.tcl +++ b/src/modules/punk/mix/#modpod-templates-999999.0a1.0/templates/project_layouts/vendor/punk/project-0.1/src/vfs/_config/project_main.tcl @@ -124,16 +124,29 @@ apply { args { return "${plat}-${cpu}" } + proc platform_normalize_os {os} { + #INLINE COPY of punk::platform::normalize_os - see platform_punk below. + switch -glob -- [string tolower $os] { + macos {return macosx} + msys - msys_nt-* {return msys} + mingw32 - mingw64 - mingw_nt-* - mingw32_nt-* - mingw64_nt-* {return msys} + ucrt64 - ucrt64_nt-* {return msys} + clang32 - clang64 - clangarm64 - clang32_nt-* - clang64_nt-* - clangarm64_nt-* {return msys} + cygwin_nt-* {return cygwin} + } + return $os + } proc platform_punk {} { #canonical punkshell platform-dir name: platform_generic normalized. #INLINE COPY of punk::platform::normalize (src/modules/punk/platform-*.tm; #'help platforms' documents the canon) - the boot stage cannot package #require, so keep this mapping in sync with that module: - #amd64->x86_64, aarch64->arm64, macos->macosx, macosx arm->arm64. + #amd64->x86_64, aarch64->arm64, macos->macosx, macosx arm->arm64, + #msys2 family (mingw64/mingw32/ucrt64/clang*) -> msys, CYGWIN_NT -> cygwin. set parts [split [platform_generic] -] set cpu [lindex $parts end] set os [join [lrange $parts 0 end-1] -] - if {$os eq "macos"} {set os macosx} + set os [platform_normalize_os $os] switch -- $cpu { amd64 {set cpu x86_64} aarch64 {set cpu arm64} @@ -141,14 +154,109 @@ apply { args { } return "${os}-${cpu}" } + proc path_within {path base} { + #1 if $path equals $base or lies under it (path-segment aware; windows + #compares case-insensitively). Both args pre-normalized, forward slashes. + if {$base eq ""} {return 0} + set p $path + set b $base + if {"windows" eq $::tcl_platform(platform)} { + set p [string tolower $p] + set b [string tolower $b] + } + set b [string trimright $b /] + if {$p eq $b} {return 1} + return [string match "$b/*" $p] + } + proc zipfs_mount_pairs {} { + #the zipfs mount table as a flat list of mountpoint,archivefile pairs. + #'tcl::zipfs::mount' (no args) reports that pairing in every zipfs + #generation supported as a kit runtime: the 8.7/9 core zipfs and the + #androwish/undroidwish tcl 8.6 backport (G-129 measured both). + #empty list when zipfs is absent, nothing is mounted, or the table is + #not pairwise (unknown generation - callers treat that as 'cannot + #attribute any mount to this executable'). + if {[info commands ::tcl::zipfs::mount] eq ""} {return [list]} + if {[catch {::tcl::zipfs::mount} mtable]} {return [list]} + if {[llength $mtable] % 2 != 0} {return [list]} + return $mtable + } + proc zipfs_kit_mountbase {} { + #G-129: where is THIS executable's attached archive mounted? + #Returns the mountpoint, or "" when no mount can be attributed to the + #executable. The mount table pairs each mountpoint with the archive file + #mounted there; the entry whose archive file is [info nameofexecutable] + #is this kit's own payload wherever it landed - //zipfs:/app on modern + #runtimes (the compiled-in ZIPFS_APP_MOUNT default), the executable's own + #path on the 8.6 backport family. Measured backport quirk: its + #archive-file column drops the windows drive prefix (/path/to/kit.exe + #for C:/path/to/kit.exe), so that spelling is accepted too. + #Fallback: a mountpoint containing [info script] is the payload this very + #boot is running from, even when the archive-file column is unmatchable. + set mpairs [zipfs_mount_pairs] + if {![llength $mpairs]} {return ""} + set normexe [file dirname [file normalize [file join [info nameofexecutable] __dummy__]]] + set on_windows [expr {"windows" eq $::tcl_platform(platform)}] + if {$on_windows} { + set exe_forms [list [string tolower $normexe]] + if {[string match {[a-zA-Z]:/*} $normexe]} { + lappend exe_forms [string tolower [string range $normexe 2 end]] + } + } else { + set exe_forms [list $normexe] + } + set matched [list] + foreach {mountpoint archivefile} $mpairs { + set f [string map [list \\ /] $archivefile] + if {$on_windows} { + set f [string tolower $f] + } + if {$f in $exe_forms} { + lappend matched $mountpoint + } + } + if {[llength $matched] == 1} { + return [lindex $matched 0] + } + set normscript [file dirname [file normalize [file join [info script] __dummy__]]] + if {[llength $matched] > 1} { + #prefer the mount this very script is booting from + foreach mountpoint $matched { + if {[path_within $normscript $mountpoint]} { + return $mountpoint + } + } + return [lindex $matched 0] + } + foreach {mountpoint archivefile} $mpairs { + if {[path_within $normscript $mountpoint]} { + return $mountpoint + } + } + return "" + } } - set has_zipfs [expr {[info commands tcl::zipfs::root] ne ""}] + #G-129: key zipfs presence 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). + set has_zipfs [expr {[info commands tcl::zipfs::mount] ne ""}] if {$has_zipfs} { set has_zipfs_attached [expr {[llength [tcl::zipfs::mount]]}] } else { set has_zipfs_attached 0 } + #where this executable's attached archive actually mounted ("" when there is no + #attributable mount): //zipfs:/app on modern runtimes, the executable's own path + #on the 8.6 backport family. Factored as its own question about the running kit + #(G-131 grows a metakit arm beside it). + set zipkit_mountbase "" + if {$has_zipfs_attached} { + set zipkit_mountbase [::punkboot::zipfs_kit_mountbase] + if {$zipkit_mountbase eq ""} { + puts stderr "main.tcl: a zipfs archive is mounted but none of the mounts could be attributed to this executable ([info nameofexecutable]) - kit-internal module/lib paths will NOT be configured. zipfs mount table: [tcl::zipfs::mount]" + } + } #REVIEW - cookit/cookfs can be compiled with a different name for it's mount-point # - we could examine the -handle from 'file attr' for each //something:/ volume (excluding //zipfs:/) @@ -178,9 +286,12 @@ apply { args { set topdir [file dirname $normscript] set found_starkit_tcl 0 set possible_lib_vfs_folders [glob -nocomplain -dir [file join $topdir lib] -type d vfs*] - if {$has_zipfs_attached} { - if {[file exists [zipfs root]/app/tcl_library]} { - lappend possible_lib_vfs_folders {*}[glob -nocomplain -dir [zipfs root]/app/tcl_library -type d vfs*] + if {$zipkit_mountbase ne ""} { + #G-129: the payload's own tcl_library at the derived mount base (was [zipfs root]/app, + #which errors on the 8.6 backport - no root subcommand - and assumes the modern mount) + set zipkit_tcl_library [file join $zipkit_mountbase tcl_library] + if {[file exists $zipkit_tcl_library]} { + lappend possible_lib_vfs_folders {*}[glob -nocomplain -dir $zipkit_tcl_library -type d vfs*] } } foreach test_folder $possible_lib_vfs_folders { @@ -282,21 +393,17 @@ apply { args { lappend auto_path_additions_internal [file join $kp $p] } } - if {$has_zipfs_attached} { - #review build option may be different - tclZipFs.c ZIPFS_APP_MOUNT defaults to ZIPFS_VOLUME/app - but it could be something else. (why?) - #default 'zipfs root' has trailing slash (//zipfs:/) - but file join does the right thing - set zipbase [file join [tcl::zipfs::root] app] - if {"$zipbase" in [tcl::zipfs::mount]} { - #set existing_module_paths [string tolower [tcl::tm::list]] - foreach p [list modules modules_tcl$tclmajorv] { - #if {[string tolower [file join $zipbase $p]] ni $existing_module_paths} { - # tcl::tm::add [file join $zipbase $p] - #} - lappend tm_additions_internal [file join $zipbase $p] - } - foreach p [list lib lib_tcl$tclmajorv] { - lappend auto_path_additions_internal [file join $zipbase $p] - } + if {$zipkit_mountbase ne ""} { + #G-129: the derived mount base replaces the compiled-in assumption. tclZipFs.c + #ZIPFS_APP_MOUNT defaults to ZIPFS_VOLUME/app and modern runtimes mount the + #attached archive there; the 8.6 backport family mounts it at the executable's + #own path. The mount table is the ground truth either way. + set zipbase $zipkit_mountbase + foreach p [list modules modules_tcl$tclmajorv] { + lappend tm_additions_internal [file join $zipbase $p] + } + foreach p [list lib lib_tcl$tclmajorv] { + lappend auto_path_additions_internal [file join $zipbase $p] } } if {$has_cookfs_attached} { @@ -316,8 +423,25 @@ apply { args { set internal_paths [list] if {$has_zipfs} { - set ziproot [tcl::zipfs::root] ;#root is enough to determine internal zipkit path - lappend internal_paths $ziproot + if {[info commands tcl::zipfs::root] ne ""} { + set ziproot [tcl::zipfs::root] ;#the volume root covers every zipfs mount + lappend internal_paths $ziproot + } + #8.6 backport family: no root command, and the attached archive mounts outside + #any zipfs volume (at the executable's own path) - the derived mount base is the + #internal prefix. On modern runtimes it is already covered by the volume root. + if {$zipkit_mountbase ne ""} { + set mountbase_covered 0 + foreach okprefix $internal_paths { + if {[string match "[string tolower $okprefix]*" [string tolower $zipkit_mountbase]]} { + set mountbase_covered 1 + break + } + } + if {!$mountbase_covered} { + lappend internal_paths $zipkit_mountbase + } + } } if {[info exists ::tcl::kitpath] && $::tcl::kitpath ne ""} { lappend internal_paths $::tcl::kitpath @@ -781,7 +905,15 @@ apply { args { #set script_relative_lib [file normalize [file join [file dirname [info script]] lib]] #set scriptdir [file dirname [info script]] set scriptdir [file dirname $normscript] - if {![string match //zipfs:/* $scriptdir] && ![string match "${cookbase}*" $scriptdir] && ![info exists ::tcl::kitpath]} { + #G-129: a script under the derived zipfs mount base is kit-internal even though + #no //zipfs:/ prefix test can recognise it (8.6 backport mounts at the exe path) + set script_in_attached_vfs 0 + if {[string match //zipfs:/* $scriptdir] || [string match "${cookbase}*" $scriptdir] || [info exists ::tcl::kitpath]} { + set script_in_attached_vfs 1 + } elseif {$zipkit_mountbase ne "" && [::punkboot::path_within $scriptdir $zipkit_mountbase]} { + set script_in_attached_vfs 1 + } + if {!$script_in_attached_vfs} { #presumably running the vfs/xxx.vfs/main.tcl script using a non-kit tclsh that doesn't have starkit lib or mounted zipfs/cookfs available.. lets see if we can move forward anyway set vfscontainer [file normalize [file dirname $scriptdir]] #set vfscommon [file join $vfscontainer _vfscommon] diff --git a/src/modules/punk/mix/#modpod-templates-999999.0a1.0/templates/project_layouts/vendor/punk/project-0.1/src/vfs/_config/punk_main.tcl b/src/modules/punk/mix/#modpod-templates-999999.0a1.0/templates/project_layouts/vendor/punk/project-0.1/src/vfs/_config/punk_main.tcl index bb981307..816a4352 100644 --- a/src/modules/punk/mix/#modpod-templates-999999.0a1.0/templates/project_layouts/vendor/punk/project-0.1/src/vfs/_config/punk_main.tcl +++ b/src/modules/punk/mix/#modpod-templates-999999.0a1.0/templates/project_layouts/vendor/punk/project-0.1/src/vfs/_config/punk_main.tcl @@ -219,16 +219,29 @@ apply { args { return "${plat}-${cpu}" } + proc platform_normalize_os {os} { + #INLINE COPY of punk::platform::normalize_os - see platform_punk below. + switch -glob -- [string tolower $os] { + macos {return macosx} + msys - msys_nt-* {return msys} + mingw32 - mingw64 - mingw_nt-* - mingw32_nt-* - mingw64_nt-* {return msys} + ucrt64 - ucrt64_nt-* {return msys} + clang32 - clang64 - clangarm64 - clang32_nt-* - clang64_nt-* - clangarm64_nt-* {return msys} + cygwin_nt-* {return cygwin} + } + return $os + } proc platform_punk {} { #canonical punkshell platform-dir name: platform_generic normalized. #INLINE COPY of punk::platform::normalize (src/modules/punk/platform-*.tm; #'help platforms' documents the canon) - the boot stage cannot package #require, so keep this mapping in sync with that module: - #amd64->x86_64, aarch64->arm64, macos->macosx, macosx arm->arm64. + #amd64->x86_64, aarch64->arm64, macos->macosx, macosx arm->arm64, + #msys2 family (mingw64/mingw32/ucrt64/clang*) -> msys, CYGWIN_NT -> cygwin. set parts [split [platform_generic] -] set cpu [lindex $parts end] set os [join [lrange $parts 0 end-1] -] - if {$os eq "macos"} {set os macosx} + set os [platform_normalize_os $os] switch -- $cpu { amd64 {set cpu x86_64} aarch64 {set cpu arm64} @@ -272,14 +285,109 @@ apply { args { } return 0 } + proc path_within {path base} { + #1 if $path equals $base or lies under it (path-segment aware; windows + #compares case-insensitively). Both args pre-normalized, forward slashes. + if {$base eq ""} {return 0} + set p $path + set b $base + if {"windows" eq $::tcl_platform(platform)} { + set p [string tolower $p] + set b [string tolower $b] + } + set b [string trimright $b /] + if {$p eq $b} {return 1} + return [string match "$b/*" $p] + } + proc zipfs_mount_pairs {} { + #the zipfs mount table as a flat list of mountpoint,archivefile pairs. + #'tcl::zipfs::mount' (no args) reports that pairing in every zipfs + #generation supported as a kit runtime: the 8.7/9 core zipfs and the + #androwish/undroidwish tcl 8.6 backport (G-129 measured both). + #empty list when zipfs is absent, nothing is mounted, or the table is + #not pairwise (unknown generation - callers treat that as 'cannot + #attribute any mount to this executable'). + if {[info commands ::tcl::zipfs::mount] eq ""} {return [list]} + if {[catch {::tcl::zipfs::mount} mtable]} {return [list]} + if {[llength $mtable] % 2 != 0} {return [list]} + return $mtable + } + proc zipfs_kit_mountbase {} { + #G-129: where is THIS executable's attached archive mounted? + #Returns the mountpoint, or "" when no mount can be attributed to the + #executable. The mount table pairs each mountpoint with the archive file + #mounted there; the entry whose archive file is [info nameofexecutable] + #is this kit's own payload wherever it landed - //zipfs:/app on modern + #runtimes (the compiled-in ZIPFS_APP_MOUNT default), the executable's own + #path on the 8.6 backport family. Measured backport quirk: its + #archive-file column drops the windows drive prefix (/path/to/kit.exe + #for C:/path/to/kit.exe), so that spelling is accepted too. + #Fallback: a mountpoint containing [info script] is the payload this very + #boot is running from, even when the archive-file column is unmatchable. + set mpairs [zipfs_mount_pairs] + if {![llength $mpairs]} {return ""} + set normexe [file dirname [file normalize [file join [info nameofexecutable] __dummy__]]] + set on_windows [expr {"windows" eq $::tcl_platform(platform)}] + if {$on_windows} { + set exe_forms [list [string tolower $normexe]] + if {[string match {[a-zA-Z]:/*} $normexe]} { + lappend exe_forms [string tolower [string range $normexe 2 end]] + } + } else { + set exe_forms [list $normexe] + } + set matched [list] + foreach {mountpoint archivefile} $mpairs { + set f [string map [list \\ /] $archivefile] + if {$on_windows} { + set f [string tolower $f] + } + if {$f in $exe_forms} { + lappend matched $mountpoint + } + } + if {[llength $matched] == 1} { + return [lindex $matched 0] + } + set normscript [file dirname [file normalize [file join [info script] __dummy__]]] + if {[llength $matched] > 1} { + #prefer the mount this very script is booting from + foreach mountpoint $matched { + if {[path_within $normscript $mountpoint]} { + return $mountpoint + } + } + return [lindex $matched 0] + } + foreach {mountpoint archivefile} $mpairs { + if {[path_within $normscript $mountpoint]} { + return $mountpoint + } + } + return "" + } } - set has_zipfs [expr {[info commands tcl::zipfs::root] ne ""}] + #G-129: key zipfs presence 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). + set has_zipfs [expr {[info commands tcl::zipfs::mount] ne ""}] if {$has_zipfs} { set has_zipfs_attached [expr {[llength [tcl::zipfs::mount]]}] } else { set has_zipfs_attached 0 } + #where this executable's attached archive actually mounted ("" when there is no + #attributable mount): //zipfs:/app on modern runtimes, the executable's own path + #on the 8.6 backport family. Factored as its own question about the running kit + #(G-131 grows a metakit arm beside it). + set zipkit_mountbase "" + if {$has_zipfs_attached} { + set zipkit_mountbase [::punkboot::zipfs_kit_mountbase] + if {$zipkit_mountbase eq ""} { + puts stderr "main.tcl: a zipfs archive is mounted but none of the mounts could be attributed to this executable ([info nameofexecutable]) - kit-internal module/lib paths will NOT be configured. zipfs mount table: [tcl::zipfs::mount]" + } + } #REVIEW - cookit/cookfs can be compiled with a different name for it's mount-point # - we could examine the -handle from 'file attr' for each //something:/ volume (excluding //zipfs:/) @@ -309,9 +417,12 @@ apply { args { set topdir [file dirname $normscript] set found_starkit_tcl 0 set possible_lib_vfs_folders [glob -nocomplain -dir [file join $topdir lib] -type d vfs*] - if {$has_zipfs_attached} { - if {[file exists [zipfs root]/app/tcl_library]} { - lappend possible_lib_vfs_folders {*}[glob -nocomplain -dir [zipfs root]/app/tcl_library -type d vfs*] + if {$zipkit_mountbase ne ""} { + #G-129: the payload's own tcl_library at the derived mount base (was [zipfs root]/app, + #which errors on the 8.6 backport - no root subcommand - and assumes the modern mount) + set zipkit_tcl_library [file join $zipkit_mountbase tcl_library] + if {[file exists $zipkit_tcl_library]} { + lappend possible_lib_vfs_folders {*}[glob -nocomplain -dir $zipkit_tcl_library -type d vfs*] } } foreach test_folder $possible_lib_vfs_folders { @@ -415,21 +526,17 @@ apply { args { lappend auto_path_additions_internal [file join $kp $p] } } - if {$has_zipfs_attached} { - #review build option may be different - tclZipFs.c ZIPFS_APP_MOUNT defaults to ZIPFS_VOLUME/app - but it could be something else. (why?) - #default 'zipfs root' has trailing slash (//zipfs:/) - but file join does the right thing - set zipbase [file join [tcl::zipfs::root] app] - if {"$zipbase" in [tcl::zipfs::mount]} { - #set existing_module_paths [string tolower [tcl::tm::list]] - foreach p [list modules modules_tcl$tclmajorv] { - #if {[string tolower [file join $zipbase $p]] ni $existing_module_paths} { - # tcl::tm::add [file join $zipbase $p] - #} - lappend tm_additions_internal [file join $zipbase $p] - } - foreach p [list lib lib_tcl$tclmajorv] { - lappend auto_path_additions_internal [file join $zipbase $p] - } + if {$zipkit_mountbase ne ""} { + #G-129: the derived mount base replaces the compiled-in assumption. tclZipFs.c + #ZIPFS_APP_MOUNT defaults to ZIPFS_VOLUME/app and modern runtimes mount the + #attached archive there; the 8.6 backport family mounts it at the executable's + #own path. The mount table is the ground truth either way. + set zipbase $zipkit_mountbase + foreach p [list modules modules_tcl$tclmajorv] { + lappend tm_additions_internal [file join $zipbase $p] + } + foreach p [list lib lib_tcl$tclmajorv] { + lappend auto_path_additions_internal [file join $zipbase $p] } } if {$has_cookfs_attached} { @@ -449,8 +556,25 @@ apply { args { set internal_paths [list] if {$has_zipfs} { - set ziproot [tcl::zipfs::root] ;#root is enough to determine internal zipkit path - lappend internal_paths $ziproot + if {[info commands tcl::zipfs::root] ne ""} { + set ziproot [tcl::zipfs::root] ;#the volume root covers every zipfs mount + lappend internal_paths $ziproot + } + #8.6 backport family: no root command, and the attached archive mounts outside + #any zipfs volume (at the executable's own path) - the derived mount base is the + #internal prefix. On modern runtimes it is already covered by the volume root. + if {$zipkit_mountbase ne ""} { + set mountbase_covered 0 + foreach okprefix $internal_paths { + if {[string match "[string tolower $okprefix]*" [string tolower $zipkit_mountbase]]} { + set mountbase_covered 1 + break + } + } + if {!$mountbase_covered} { + lappend internal_paths $zipkit_mountbase + } + } } if {[info exists ::tcl::kitpath] && $::tcl::kitpath ne ""} { lappend internal_paths $::tcl::kitpath @@ -1016,7 +1140,15 @@ apply { args { #set script_relative_lib [file normalize [file join [file dirname [info script]] lib]] #set scriptdir [file dirname [info script]] set scriptdir [file dirname $normscript] - if {![string match //zipfs:/* $scriptdir] && ![string match "${cookbase}*" $scriptdir] && ![info exists ::tcl::kitpath]} { + #G-129: a script under the derived zipfs mount base is kit-internal even though + #no //zipfs:/ prefix test can recognise it (8.6 backport mounts at the exe path) + set script_in_attached_vfs 0 + if {[string match //zipfs:/* $scriptdir] || [string match "${cookbase}*" $scriptdir] || [info exists ::tcl::kitpath]} { + set script_in_attached_vfs 1 + } elseif {$zipkit_mountbase ne "" && [::punkboot::path_within $scriptdir $zipkit_mountbase]} { + set script_in_attached_vfs 1 + } + if {!$script_in_attached_vfs} { #presumably running the vfs/xxx.vfs/main.tcl script using a non-kit tclsh that doesn't have starkit lib or mounted zipfs/cookfs available.. lets see if we can move forward anyway set vfscontainer [file normalize [file dirname $scriptdir]] #set vfscommon [file join $vfscontainer _vfscommon] diff --git a/src/project_layouts/vendor/punk/basic/src/make.tcl b/src/project_layouts/vendor/punk/basic/src/make.tcl index 894dcba5..67f7d37c 100644 --- a/src/project_layouts/vendor/punk/basic/src/make.tcl +++ b/src/project_layouts/vendor/punk/basic/src/make.tcl @@ -5324,14 +5324,15 @@ foreach runtime [dict keys $runtime_vfs_map] { dict set caps has_starkit 0 } } - if {![catch { - set cmd [info commands tcl::zipfs::root] - if {$cmd ne ""} { - dict set caps has_zipfs 1 - } else { - dict set caps has_zipfs 0 - } - } errM]} + #G-129: key zipfs capability on tcl::zipfs::mount - present in every zipfs + #generation including the androwish/undroidwish 8.6 backport, which has no + #tcl::zipfs::root. (This block previously rode a body-less 'if {![catch ..]}' + #that only worked because piped-stdin tclsh continues past command errors.) + if {[info commands tcl::zipfs::mount] ne ""} { + dict set caps has_zipfs 1 + } else { + dict set caps has_zipfs 0 + } if {![catch { package require cookfs } errM]} { @@ -5617,7 +5618,11 @@ proc merge_over {sourcedir targetdir {depth 0}} { flush stdout set linktarget [dict get $linkinfo targetpath] if {[file pathtype $linktarget] eq "relative"} { - set actualsource [file join $sourcedir $linktarget] + #fauxlink targets are link-location-relative (symlink semantics - + #the fauxlink module doc's 'file in parent dir' example). Same as + #the old sourcedir-relative resolution for the historical + #root-level links; differs for nested ones (G-129 app/main.tcl). + set actualsource [file join [file dirname $file_or_dir] $linktarget] } else { set actualsource $linktarget } diff --git a/src/project_layouts/vendor/punk/project-0.1/src/make.tcl b/src/project_layouts/vendor/punk/project-0.1/src/make.tcl index 894dcba5..67f7d37c 100644 --- a/src/project_layouts/vendor/punk/project-0.1/src/make.tcl +++ b/src/project_layouts/vendor/punk/project-0.1/src/make.tcl @@ -5324,14 +5324,15 @@ foreach runtime [dict keys $runtime_vfs_map] { dict set caps has_starkit 0 } } - if {![catch { - set cmd [info commands tcl::zipfs::root] - if {$cmd ne ""} { - dict set caps has_zipfs 1 - } else { - dict set caps has_zipfs 0 - } - } errM]} + #G-129: key zipfs capability on tcl::zipfs::mount - present in every zipfs + #generation including the androwish/undroidwish 8.6 backport, which has no + #tcl::zipfs::root. (This block previously rode a body-less 'if {![catch ..]}' + #that only worked because piped-stdin tclsh continues past command errors.) + if {[info commands tcl::zipfs::mount] ne ""} { + dict set caps has_zipfs 1 + } else { + dict set caps has_zipfs 0 + } if {![catch { package require cookfs } errM]} { @@ -5617,7 +5618,11 @@ proc merge_over {sourcedir targetdir {depth 0}} { flush stdout set linktarget [dict get $linkinfo targetpath] if {[file pathtype $linktarget] eq "relative"} { - set actualsource [file join $sourcedir $linktarget] + #fauxlink targets are link-location-relative (symlink semantics - + #the fauxlink module doc's 'file in parent dir' example). Same as + #the old sourcedir-relative resolution for the historical + #root-level links; differs for nested ones (G-129 app/main.tcl). + set actualsource [file join [file dirname $file_or_dir] $linktarget] } else { set actualsource $linktarget } diff --git a/src/project_layouts/vendor/punk/project-0.1/src/vfs/_config/project_main.tcl b/src/project_layouts/vendor/punk/project-0.1/src/vfs/_config/project_main.tcl index df81c784..c3eb9aab 100644 --- a/src/project_layouts/vendor/punk/project-0.1/src/vfs/_config/project_main.tcl +++ b/src/project_layouts/vendor/punk/project-0.1/src/vfs/_config/project_main.tcl @@ -124,16 +124,29 @@ apply { args { return "${plat}-${cpu}" } + proc platform_normalize_os {os} { + #INLINE COPY of punk::platform::normalize_os - see platform_punk below. + switch -glob -- [string tolower $os] { + macos {return macosx} + msys - msys_nt-* {return msys} + mingw32 - mingw64 - mingw_nt-* - mingw32_nt-* - mingw64_nt-* {return msys} + ucrt64 - ucrt64_nt-* {return msys} + clang32 - clang64 - clangarm64 - clang32_nt-* - clang64_nt-* - clangarm64_nt-* {return msys} + cygwin_nt-* {return cygwin} + } + return $os + } proc platform_punk {} { #canonical punkshell platform-dir name: platform_generic normalized. #INLINE COPY of punk::platform::normalize (src/modules/punk/platform-*.tm; #'help platforms' documents the canon) - the boot stage cannot package #require, so keep this mapping in sync with that module: - #amd64->x86_64, aarch64->arm64, macos->macosx, macosx arm->arm64. + #amd64->x86_64, aarch64->arm64, macos->macosx, macosx arm->arm64, + #msys2 family (mingw64/mingw32/ucrt64/clang*) -> msys, CYGWIN_NT -> cygwin. set parts [split [platform_generic] -] set cpu [lindex $parts end] set os [join [lrange $parts 0 end-1] -] - if {$os eq "macos"} {set os macosx} + set os [platform_normalize_os $os] switch -- $cpu { amd64 {set cpu x86_64} aarch64 {set cpu arm64} @@ -141,14 +154,109 @@ apply { args { } return "${os}-${cpu}" } + proc path_within {path base} { + #1 if $path equals $base or lies under it (path-segment aware; windows + #compares case-insensitively). Both args pre-normalized, forward slashes. + if {$base eq ""} {return 0} + set p $path + set b $base + if {"windows" eq $::tcl_platform(platform)} { + set p [string tolower $p] + set b [string tolower $b] + } + set b [string trimright $b /] + if {$p eq $b} {return 1} + return [string match "$b/*" $p] + } + proc zipfs_mount_pairs {} { + #the zipfs mount table as a flat list of mountpoint,archivefile pairs. + #'tcl::zipfs::mount' (no args) reports that pairing in every zipfs + #generation supported as a kit runtime: the 8.7/9 core zipfs and the + #androwish/undroidwish tcl 8.6 backport (G-129 measured both). + #empty list when zipfs is absent, nothing is mounted, or the table is + #not pairwise (unknown generation - callers treat that as 'cannot + #attribute any mount to this executable'). + if {[info commands ::tcl::zipfs::mount] eq ""} {return [list]} + if {[catch {::tcl::zipfs::mount} mtable]} {return [list]} + if {[llength $mtable] % 2 != 0} {return [list]} + return $mtable + } + proc zipfs_kit_mountbase {} { + #G-129: where is THIS executable's attached archive mounted? + #Returns the mountpoint, or "" when no mount can be attributed to the + #executable. The mount table pairs each mountpoint with the archive file + #mounted there; the entry whose archive file is [info nameofexecutable] + #is this kit's own payload wherever it landed - //zipfs:/app on modern + #runtimes (the compiled-in ZIPFS_APP_MOUNT default), the executable's own + #path on the 8.6 backport family. Measured backport quirk: its + #archive-file column drops the windows drive prefix (/path/to/kit.exe + #for C:/path/to/kit.exe), so that spelling is accepted too. + #Fallback: a mountpoint containing [info script] is the payload this very + #boot is running from, even when the archive-file column is unmatchable. + set mpairs [zipfs_mount_pairs] + if {![llength $mpairs]} {return ""} + set normexe [file dirname [file normalize [file join [info nameofexecutable] __dummy__]]] + set on_windows [expr {"windows" eq $::tcl_platform(platform)}] + if {$on_windows} { + set exe_forms [list [string tolower $normexe]] + if {[string match {[a-zA-Z]:/*} $normexe]} { + lappend exe_forms [string tolower [string range $normexe 2 end]] + } + } else { + set exe_forms [list $normexe] + } + set matched [list] + foreach {mountpoint archivefile} $mpairs { + set f [string map [list \\ /] $archivefile] + if {$on_windows} { + set f [string tolower $f] + } + if {$f in $exe_forms} { + lappend matched $mountpoint + } + } + if {[llength $matched] == 1} { + return [lindex $matched 0] + } + set normscript [file dirname [file normalize [file join [info script] __dummy__]]] + if {[llength $matched] > 1} { + #prefer the mount this very script is booting from + foreach mountpoint $matched { + if {[path_within $normscript $mountpoint]} { + return $mountpoint + } + } + return [lindex $matched 0] + } + foreach {mountpoint archivefile} $mpairs { + if {[path_within $normscript $mountpoint]} { + return $mountpoint + } + } + return "" + } } - set has_zipfs [expr {[info commands tcl::zipfs::root] ne ""}] + #G-129: key zipfs presence 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). + set has_zipfs [expr {[info commands tcl::zipfs::mount] ne ""}] if {$has_zipfs} { set has_zipfs_attached [expr {[llength [tcl::zipfs::mount]]}] } else { set has_zipfs_attached 0 } + #where this executable's attached archive actually mounted ("" when there is no + #attributable mount): //zipfs:/app on modern runtimes, the executable's own path + #on the 8.6 backport family. Factored as its own question about the running kit + #(G-131 grows a metakit arm beside it). + set zipkit_mountbase "" + if {$has_zipfs_attached} { + set zipkit_mountbase [::punkboot::zipfs_kit_mountbase] + if {$zipkit_mountbase eq ""} { + puts stderr "main.tcl: a zipfs archive is mounted but none of the mounts could be attributed to this executable ([info nameofexecutable]) - kit-internal module/lib paths will NOT be configured. zipfs mount table: [tcl::zipfs::mount]" + } + } #REVIEW - cookit/cookfs can be compiled with a different name for it's mount-point # - we could examine the -handle from 'file attr' for each //something:/ volume (excluding //zipfs:/) @@ -178,9 +286,12 @@ apply { args { set topdir [file dirname $normscript] set found_starkit_tcl 0 set possible_lib_vfs_folders [glob -nocomplain -dir [file join $topdir lib] -type d vfs*] - if {$has_zipfs_attached} { - if {[file exists [zipfs root]/app/tcl_library]} { - lappend possible_lib_vfs_folders {*}[glob -nocomplain -dir [zipfs root]/app/tcl_library -type d vfs*] + if {$zipkit_mountbase ne ""} { + #G-129: the payload's own tcl_library at the derived mount base (was [zipfs root]/app, + #which errors on the 8.6 backport - no root subcommand - and assumes the modern mount) + set zipkit_tcl_library [file join $zipkit_mountbase tcl_library] + if {[file exists $zipkit_tcl_library]} { + lappend possible_lib_vfs_folders {*}[glob -nocomplain -dir $zipkit_tcl_library -type d vfs*] } } foreach test_folder $possible_lib_vfs_folders { @@ -282,21 +393,17 @@ apply { args { lappend auto_path_additions_internal [file join $kp $p] } } - if {$has_zipfs_attached} { - #review build option may be different - tclZipFs.c ZIPFS_APP_MOUNT defaults to ZIPFS_VOLUME/app - but it could be something else. (why?) - #default 'zipfs root' has trailing slash (//zipfs:/) - but file join does the right thing - set zipbase [file join [tcl::zipfs::root] app] - if {"$zipbase" in [tcl::zipfs::mount]} { - #set existing_module_paths [string tolower [tcl::tm::list]] - foreach p [list modules modules_tcl$tclmajorv] { - #if {[string tolower [file join $zipbase $p]] ni $existing_module_paths} { - # tcl::tm::add [file join $zipbase $p] - #} - lappend tm_additions_internal [file join $zipbase $p] - } - foreach p [list lib lib_tcl$tclmajorv] { - lappend auto_path_additions_internal [file join $zipbase $p] - } + if {$zipkit_mountbase ne ""} { + #G-129: the derived mount base replaces the compiled-in assumption. tclZipFs.c + #ZIPFS_APP_MOUNT defaults to ZIPFS_VOLUME/app and modern runtimes mount the + #attached archive there; the 8.6 backport family mounts it at the executable's + #own path. The mount table is the ground truth either way. + set zipbase $zipkit_mountbase + foreach p [list modules modules_tcl$tclmajorv] { + lappend tm_additions_internal [file join $zipbase $p] + } + foreach p [list lib lib_tcl$tclmajorv] { + lappend auto_path_additions_internal [file join $zipbase $p] } } if {$has_cookfs_attached} { @@ -316,8 +423,25 @@ apply { args { set internal_paths [list] if {$has_zipfs} { - set ziproot [tcl::zipfs::root] ;#root is enough to determine internal zipkit path - lappend internal_paths $ziproot + if {[info commands tcl::zipfs::root] ne ""} { + set ziproot [tcl::zipfs::root] ;#the volume root covers every zipfs mount + lappend internal_paths $ziproot + } + #8.6 backport family: no root command, and the attached archive mounts outside + #any zipfs volume (at the executable's own path) - the derived mount base is the + #internal prefix. On modern runtimes it is already covered by the volume root. + if {$zipkit_mountbase ne ""} { + set mountbase_covered 0 + foreach okprefix $internal_paths { + if {[string match "[string tolower $okprefix]*" [string tolower $zipkit_mountbase]]} { + set mountbase_covered 1 + break + } + } + if {!$mountbase_covered} { + lappend internal_paths $zipkit_mountbase + } + } } if {[info exists ::tcl::kitpath] && $::tcl::kitpath ne ""} { lappend internal_paths $::tcl::kitpath @@ -781,7 +905,15 @@ apply { args { #set script_relative_lib [file normalize [file join [file dirname [info script]] lib]] #set scriptdir [file dirname [info script]] set scriptdir [file dirname $normscript] - if {![string match //zipfs:/* $scriptdir] && ![string match "${cookbase}*" $scriptdir] && ![info exists ::tcl::kitpath]} { + #G-129: a script under the derived zipfs mount base is kit-internal even though + #no //zipfs:/ prefix test can recognise it (8.6 backport mounts at the exe path) + set script_in_attached_vfs 0 + if {[string match //zipfs:/* $scriptdir] || [string match "${cookbase}*" $scriptdir] || [info exists ::tcl::kitpath]} { + set script_in_attached_vfs 1 + } elseif {$zipkit_mountbase ne "" && [::punkboot::path_within $scriptdir $zipkit_mountbase]} { + set script_in_attached_vfs 1 + } + if {!$script_in_attached_vfs} { #presumably running the vfs/xxx.vfs/main.tcl script using a non-kit tclsh that doesn't have starkit lib or mounted zipfs/cookfs available.. lets see if we can move forward anyway set vfscontainer [file normalize [file dirname $scriptdir]] #set vfscommon [file join $vfscontainer _vfscommon] diff --git a/src/project_layouts/vendor/punk/project-0.1/src/vfs/_config/punk_main.tcl b/src/project_layouts/vendor/punk/project-0.1/src/vfs/_config/punk_main.tcl index bb981307..816a4352 100644 --- a/src/project_layouts/vendor/punk/project-0.1/src/vfs/_config/punk_main.tcl +++ b/src/project_layouts/vendor/punk/project-0.1/src/vfs/_config/punk_main.tcl @@ -219,16 +219,29 @@ apply { args { return "${plat}-${cpu}" } + proc platform_normalize_os {os} { + #INLINE COPY of punk::platform::normalize_os - see platform_punk below. + switch -glob -- [string tolower $os] { + macos {return macosx} + msys - msys_nt-* {return msys} + mingw32 - mingw64 - mingw_nt-* - mingw32_nt-* - mingw64_nt-* {return msys} + ucrt64 - ucrt64_nt-* {return msys} + clang32 - clang64 - clangarm64 - clang32_nt-* - clang64_nt-* - clangarm64_nt-* {return msys} + cygwin_nt-* {return cygwin} + } + return $os + } proc platform_punk {} { #canonical punkshell platform-dir name: platform_generic normalized. #INLINE COPY of punk::platform::normalize (src/modules/punk/platform-*.tm; #'help platforms' documents the canon) - the boot stage cannot package #require, so keep this mapping in sync with that module: - #amd64->x86_64, aarch64->arm64, macos->macosx, macosx arm->arm64. + #amd64->x86_64, aarch64->arm64, macos->macosx, macosx arm->arm64, + #msys2 family (mingw64/mingw32/ucrt64/clang*) -> msys, CYGWIN_NT -> cygwin. set parts [split [platform_generic] -] set cpu [lindex $parts end] set os [join [lrange $parts 0 end-1] -] - if {$os eq "macos"} {set os macosx} + set os [platform_normalize_os $os] switch -- $cpu { amd64 {set cpu x86_64} aarch64 {set cpu arm64} @@ -272,14 +285,109 @@ apply { args { } return 0 } + proc path_within {path base} { + #1 if $path equals $base or lies under it (path-segment aware; windows + #compares case-insensitively). Both args pre-normalized, forward slashes. + if {$base eq ""} {return 0} + set p $path + set b $base + if {"windows" eq $::tcl_platform(platform)} { + set p [string tolower $p] + set b [string tolower $b] + } + set b [string trimright $b /] + if {$p eq $b} {return 1} + return [string match "$b/*" $p] + } + proc zipfs_mount_pairs {} { + #the zipfs mount table as a flat list of mountpoint,archivefile pairs. + #'tcl::zipfs::mount' (no args) reports that pairing in every zipfs + #generation supported as a kit runtime: the 8.7/9 core zipfs and the + #androwish/undroidwish tcl 8.6 backport (G-129 measured both). + #empty list when zipfs is absent, nothing is mounted, or the table is + #not pairwise (unknown generation - callers treat that as 'cannot + #attribute any mount to this executable'). + if {[info commands ::tcl::zipfs::mount] eq ""} {return [list]} + if {[catch {::tcl::zipfs::mount} mtable]} {return [list]} + if {[llength $mtable] % 2 != 0} {return [list]} + return $mtable + } + proc zipfs_kit_mountbase {} { + #G-129: where is THIS executable's attached archive mounted? + #Returns the mountpoint, or "" when no mount can be attributed to the + #executable. The mount table pairs each mountpoint with the archive file + #mounted there; the entry whose archive file is [info nameofexecutable] + #is this kit's own payload wherever it landed - //zipfs:/app on modern + #runtimes (the compiled-in ZIPFS_APP_MOUNT default), the executable's own + #path on the 8.6 backport family. Measured backport quirk: its + #archive-file column drops the windows drive prefix (/path/to/kit.exe + #for C:/path/to/kit.exe), so that spelling is accepted too. + #Fallback: a mountpoint containing [info script] is the payload this very + #boot is running from, even when the archive-file column is unmatchable. + set mpairs [zipfs_mount_pairs] + if {![llength $mpairs]} {return ""} + set normexe [file dirname [file normalize [file join [info nameofexecutable] __dummy__]]] + set on_windows [expr {"windows" eq $::tcl_platform(platform)}] + if {$on_windows} { + set exe_forms [list [string tolower $normexe]] + if {[string match {[a-zA-Z]:/*} $normexe]} { + lappend exe_forms [string tolower [string range $normexe 2 end]] + } + } else { + set exe_forms [list $normexe] + } + set matched [list] + foreach {mountpoint archivefile} $mpairs { + set f [string map [list \\ /] $archivefile] + if {$on_windows} { + set f [string tolower $f] + } + if {$f in $exe_forms} { + lappend matched $mountpoint + } + } + if {[llength $matched] == 1} { + return [lindex $matched 0] + } + set normscript [file dirname [file normalize [file join [info script] __dummy__]]] + if {[llength $matched] > 1} { + #prefer the mount this very script is booting from + foreach mountpoint $matched { + if {[path_within $normscript $mountpoint]} { + return $mountpoint + } + } + return [lindex $matched 0] + } + foreach {mountpoint archivefile} $mpairs { + if {[path_within $normscript $mountpoint]} { + return $mountpoint + } + } + return "" + } } - set has_zipfs [expr {[info commands tcl::zipfs::root] ne ""}] + #G-129: key zipfs presence 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). + set has_zipfs [expr {[info commands tcl::zipfs::mount] ne ""}] if {$has_zipfs} { set has_zipfs_attached [expr {[llength [tcl::zipfs::mount]]}] } else { set has_zipfs_attached 0 } + #where this executable's attached archive actually mounted ("" when there is no + #attributable mount): //zipfs:/app on modern runtimes, the executable's own path + #on the 8.6 backport family. Factored as its own question about the running kit + #(G-131 grows a metakit arm beside it). + set zipkit_mountbase "" + if {$has_zipfs_attached} { + set zipkit_mountbase [::punkboot::zipfs_kit_mountbase] + if {$zipkit_mountbase eq ""} { + puts stderr "main.tcl: a zipfs archive is mounted but none of the mounts could be attributed to this executable ([info nameofexecutable]) - kit-internal module/lib paths will NOT be configured. zipfs mount table: [tcl::zipfs::mount]" + } + } #REVIEW - cookit/cookfs can be compiled with a different name for it's mount-point # - we could examine the -handle from 'file attr' for each //something:/ volume (excluding //zipfs:/) @@ -309,9 +417,12 @@ apply { args { set topdir [file dirname $normscript] set found_starkit_tcl 0 set possible_lib_vfs_folders [glob -nocomplain -dir [file join $topdir lib] -type d vfs*] - if {$has_zipfs_attached} { - if {[file exists [zipfs root]/app/tcl_library]} { - lappend possible_lib_vfs_folders {*}[glob -nocomplain -dir [zipfs root]/app/tcl_library -type d vfs*] + if {$zipkit_mountbase ne ""} { + #G-129: the payload's own tcl_library at the derived mount base (was [zipfs root]/app, + #which errors on the 8.6 backport - no root subcommand - and assumes the modern mount) + set zipkit_tcl_library [file join $zipkit_mountbase tcl_library] + if {[file exists $zipkit_tcl_library]} { + lappend possible_lib_vfs_folders {*}[glob -nocomplain -dir $zipkit_tcl_library -type d vfs*] } } foreach test_folder $possible_lib_vfs_folders { @@ -415,21 +526,17 @@ apply { args { lappend auto_path_additions_internal [file join $kp $p] } } - if {$has_zipfs_attached} { - #review build option may be different - tclZipFs.c ZIPFS_APP_MOUNT defaults to ZIPFS_VOLUME/app - but it could be something else. (why?) - #default 'zipfs root' has trailing slash (//zipfs:/) - but file join does the right thing - set zipbase [file join [tcl::zipfs::root] app] - if {"$zipbase" in [tcl::zipfs::mount]} { - #set existing_module_paths [string tolower [tcl::tm::list]] - foreach p [list modules modules_tcl$tclmajorv] { - #if {[string tolower [file join $zipbase $p]] ni $existing_module_paths} { - # tcl::tm::add [file join $zipbase $p] - #} - lappend tm_additions_internal [file join $zipbase $p] - } - foreach p [list lib lib_tcl$tclmajorv] { - lappend auto_path_additions_internal [file join $zipbase $p] - } + if {$zipkit_mountbase ne ""} { + #G-129: the derived mount base replaces the compiled-in assumption. tclZipFs.c + #ZIPFS_APP_MOUNT defaults to ZIPFS_VOLUME/app and modern runtimes mount the + #attached archive there; the 8.6 backport family mounts it at the executable's + #own path. The mount table is the ground truth either way. + set zipbase $zipkit_mountbase + foreach p [list modules modules_tcl$tclmajorv] { + lappend tm_additions_internal [file join $zipbase $p] + } + foreach p [list lib lib_tcl$tclmajorv] { + lappend auto_path_additions_internal [file join $zipbase $p] } } if {$has_cookfs_attached} { @@ -449,8 +556,25 @@ apply { args { set internal_paths [list] if {$has_zipfs} { - set ziproot [tcl::zipfs::root] ;#root is enough to determine internal zipkit path - lappend internal_paths $ziproot + if {[info commands tcl::zipfs::root] ne ""} { + set ziproot [tcl::zipfs::root] ;#the volume root covers every zipfs mount + lappend internal_paths $ziproot + } + #8.6 backport family: no root command, and the attached archive mounts outside + #any zipfs volume (at the executable's own path) - the derived mount base is the + #internal prefix. On modern runtimes it is already covered by the volume root. + if {$zipkit_mountbase ne ""} { + set mountbase_covered 0 + foreach okprefix $internal_paths { + if {[string match "[string tolower $okprefix]*" [string tolower $zipkit_mountbase]]} { + set mountbase_covered 1 + break + } + } + if {!$mountbase_covered} { + lappend internal_paths $zipkit_mountbase + } + } } if {[info exists ::tcl::kitpath] && $::tcl::kitpath ne ""} { lappend internal_paths $::tcl::kitpath @@ -1016,7 +1140,15 @@ apply { args { #set script_relative_lib [file normalize [file join [file dirname [info script]] lib]] #set scriptdir [file dirname [info script]] set scriptdir [file dirname $normscript] - if {![string match //zipfs:/* $scriptdir] && ![string match "${cookbase}*" $scriptdir] && ![info exists ::tcl::kitpath]} { + #G-129: a script under the derived zipfs mount base is kit-internal even though + #no //zipfs:/ prefix test can recognise it (8.6 backport mounts at the exe path) + set script_in_attached_vfs 0 + if {[string match //zipfs:/* $scriptdir] || [string match "${cookbase}*" $scriptdir] || [info exists ::tcl::kitpath]} { + set script_in_attached_vfs 1 + } elseif {$zipkit_mountbase ne "" && [::punkboot::path_within $scriptdir $zipkit_mountbase]} { + set script_in_attached_vfs 1 + } + if {!$script_in_attached_vfs} { #presumably running the vfs/xxx.vfs/main.tcl script using a non-kit tclsh that doesn't have starkit lib or mounted zipfs/cookfs available.. lets see if we can move forward anyway set vfscontainer [file normalize [file dirname $scriptdir]] #set vfscommon [file join $vfscontainer _vfscommon] diff --git a/src/runtime/mapvfs.config b/src/runtime/mapvfs.config index 68418a5e..d0c357e4 100644 --- a/src/runtime/mapvfs.config +++ b/src/runtime/mapvfs.config @@ -112,3 +112,15 @@ tclsh9.0.5-punk-bi.exe {punk9win_for_tkruntime.vfs punk9bi_beta zip} #Before the target declaration this row read runtime=missing from a windows host, #because the runtime was looked for as tclkit-902-Linux64-intel-dyn.exe in the windows store. tclkit-902-Linux64-intel-dyn {punk9linux.vfs punkshell902 kit linux-x86_64} + +#G-129 verification runtimes: third-party 32-bit windows, bin/runtime/win32-ix86/ tier +# (see goals/G-129-kitboot-mountpoint-derivation.md). Kept active so both zipfs mount +# conventions stay covered by real kits. +#androwish/undroidwish 8.6 zipfs backport (LUCK build): mounts its attached archive at the +# EXECUTABLE'S OWN PATH and has no tcl::zipfs::root - the boot derives the mount point +# from the runtime's own mount table. 8.6 payload. +tclsh8.6.10-luck-zip.exe {punk8win.vfs punkluck86 zip win32-ix86} +#apn tcl-sfe 9.1b0 32-bit: modern //zipfs:/app convention - proves the 32-bit target +# itself needs nothing special. Runtime carries no Tk, so pair the no-tk-payload vfs +# (its tk-carrying siblings ship x64 dlls a 32-bit runtime cannot load). +tclsh9.1b0-tclsfe.exe {punk9win_for_tkruntime.vfs punk91ix86 zip win32-ix86} diff --git a/src/tests/shell/AGENTS.md b/src/tests/shell/AGENTS.md index e7bb9ac4..cc69a291 100644 --- a/src/tests/shell/AGENTS.md +++ b/src/tests/shell/AGENTS.md @@ -26,6 +26,7 @@ Tests for shell-level behavior, command-line execution, and stdin/stdout interac - `testsuites/binscripts/runtimebash_wsl.test` (G-059) exercises the punk-runtime.cmd unix payload (`src/scriptapps/bin/punk-runtime.bash`) through WSL: active/use/run resolution, env override, stale-active guidance, single-candidate fallback, and `list -remote` local-vs-server comparison (offline via a crafted cached sha1sums.txt + `PUNKBIN_URL` pointed at an unreachable address). Gated by the `wsllinux` capability constraint from `src/tests/testsupport/wslprobe.tcl`; all execution happens in a WSL-native staging dir, and a final test asserts the Windows checkout's git status is unchanged by the run. - `testsuites/binscripts/runtimecmd_freshness.test` (G-119) exercises the punk-runtime freshness verdict (active-vs-server-default: current/ahead/behind/incomparable) in BOTH payloads against a fixture punkbin server: a child-process http file server (`testsupport/httpfixture.tcl`) serves a crafted layout (defaults.txt, sha1sums, artifacts + metadata tomls) via the `PUNKBIN_URL` override, with all execution in a tempdir staging area on a fixture platform folder (`testplat-x86_64` - the real `bin/runtime` store is untouched). The powershell payload runs as the staged committed `bin/punk-runtime.cmd` via cmd.exe (the wrap-pinned path); the bash payload is driven DIRECTLY under a probed msys/git bash (uname MINGW*/MSYS*; WSL bash is rejected - under WSL2 it cannot reach the 127.0.0.1 fixture server, and on windows the polyglot routes unix shells to the powershell payload anyway). Asserts the G-119 acceptance scenarios (ahead/behind+guidance/current-annotation/pre-family no-basis and hash-identity/no-name-fetch note) with ps1-vs-bash verdict-line parity, plus the identity middle column row shapes (2026-07-25 follow-on): `from=` working-copy rows with content-verified Remote statuses (Same version / CONTENT DIFFERS / artifact-not-listed), `sha1=` byte-copy strays, and the identity-following `(server default)` row annotation. Gated by capability constraints (windows, committed cmd, bash source, certutil, msys bash, fixture server started); skips cleanly elsewhere. - `testsuites/punkexe/staticruntime.test` (G-058) targets a kit built on a runtime with statically-linked packages: resolved from `env(PUNK_STATICKIT_TEST_EXE)`, else `/bin/punk91.exe`, gated by the capability-probed `statickitavailable` constraint (a probe run must show a captured `::punkboot::static_packages` baseline including Thread - not mere file existence). It asserts repl boot without the codethread Thread failure, Thread resolution in the code interp / fabricated interps / snapshot-seeded threads, and twapi resolution per the static-vs-bundled policy. The verification runtime (tclsfe-x64.exe) is pinned in the punkbin artifact repo so the constraint is satisfiable off the original dev machine. Kit script-exec paths must be passed with forward slashes. +- `testsuites/punkexe/kitmountpoint.test` (G-129) characterizes the boot's payload-mount derivation. Runtime-driven tests run the WORKING TREE's `src/vfs/_config/punk_main.tcl` as the runtime's script argument (no bake needed, no stale-kit caveat) and assert `::punkboot::zipfs_kit_mountbase`, which punk_main leaves defined post-boot: the 8.6 androwish/undroidwish backport attributes the attached archive at the EXECUTABLE'S OWN PATH, and 32-bit tcl-sfe answers the modern `//zipfs:/app`. A punkexe-kit test pins the baked modern case (gated on the derivation proc existing in the kit, so a pre-G-129 kit skips cleanly - rebuild per this file's staleness notes). The unattributable case (an empty-mount-table runtime - default `bin/runtime/win32-x86_64/tclkit902.exe` - mounting a freshly mkzip'd foreign archive, then sourcing the working tree's punk_main) asserts the stderr report, that boot continues, and that the foreign mount contributes no kit paths. Self-gates on the untracked `bin/runtime/win32-ix86/` verification runtimes (LUCK 8.6.10 + tclsh9.1b0-tclsfe) per the G-129 goal notes. - GOAL tests (constraint `punkgoals`, enabled by env `PUNK_TEST_GOALS=1`) cover the piped-stdin-then-interactive-shell drop-in (`shellpipe_eof_then_interactive_shell`, `shellpipe_script_and_eof_then_interactive_shell`); they are excluded from normal runs because they require an openable console in the test environment and briefly attach a live shell to it - they pass in console-attached environments against a current build. - The eof-policy discriminator is `env(PUNK_PIPE_EOF)` (`exit`|`interactive`|unset=console heuristic) implemented in app-punkshell; termination-guard tests spawn children with `exit`, goal tests spawn with it unset. diff --git a/src/tests/shell/testsuites/punkexe/kitmountpoint.test b/src/tests/shell/testsuites/punkexe/kitmountpoint.test new file mode 100644 index 00000000..01cd9596 --- /dev/null +++ b/src/tests/shell/testsuites/punkexe/kitmountpoint.test @@ -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 ' 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]]] + #/src/tests/shell/testsuites/punkexe -> 5 levels up to + 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 , output + 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 ' punk_main.tcl tclsh ' 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. diff --git a/src/vfs/AGENTS.md b/src/vfs/AGENTS.md index 2a314a70..c399755a 100644 --- a/src/vfs/AGENTS.md +++ b/src/vfs/AGENTS.md @@ -19,6 +19,8 @@ VFS (Virtual File System) folders define the runtime payloads that get wrapped i - `_config/punk_main.tcl` accepts an optional package_mode argument before the subcommand. Valid modes are `dev`, `os`, `internal`, and `src`, dash-delimited in priority order (e.g `src-internal`). `internal` is always appended if omitted. - `_config/punk_main.tcl` captures the runtime's static/builtin packages at boot (G-058): empty-filename `info loaded` prefixes are probe-loaded in a throwaway interp (denylist `::punkboot::static_probe_denylist`, default `tk* vfs mk4tcl vlerq tdbc*` - side-effecting or composite inits) and each package a probe-load actually PROVIDES is recorded in `::punkboot::static_packages` {pkgname {version prefix

}} with `::punkboot::static_prefixes` alongside. The boot interp and every punkshell-fabricated interp/thread (punk::lib::interp_sync_package_paths / snapshot_package_paths, repl codethread, shellthread workers) seed `package ifneeded {load {} }` from it, and punk::packagepreference resolves static-vs-bundled version-aware. Composite statics whose script layer lived in the runtime's own (replaced) zipfs provide nothing under the probe and are correctly left to bundled copies. - `src` mode loads unbuilt modules and libraries from the project's `src/` tree (`src/modules`, `src/lib`, `src/bootsupport`, `src/vendormodules`) instead of built output. It also runs an inline `#modpod` package-ifneeded scanner (using Tcl builtins only, since no punk modules are loaded at boot time) and sets `package prefer latest` so `999999.0a1.0` dev modules are preferred over stable bootsupport/vendored copies. +- `_config/punk_main.tcl` and `_config/project_main.tcl` derive the kit's payload location from the runtime's own zipfs mount table (G-129): zipfs presence keys on `tcl::zipfs::mount` (not `tcl::zipfs::root`, which the androwish/undroidwish 8.6 backport lacks), the mount base is the table entry whose archive file is `[info nameofexecutable]` (fallback: the mount containing the boot script), `//zipfs:/app` stays the expected modern answer rather than a compiled-in assumption, and a mounted archive that cannot be attributed to the executable is reported on stderr. The derivation lives in `::punkboot` procs (`zipfs_kit_mountbase`, `zipfs_mount_pairs`, `path_within`) that remain defined after boot for probing and tests. Both files carry identical copies of this logic (G-031 is the planned consolidation). Characterization: `src/tests/shell/testsuites/punkexe/kitmountpoint.test`. +- `punk8win.vfs` carries TWO startup-script fauxlinks resolving to `_config/punk_main.tcl`: root `main.tcl` (modern zipfs and metakit convention) and `app/main.tcl` (the undroidwish family sources `app/main.tcl` INSIDE the attached archive; the file is inert in kits whose runtime does not look for it). Fauxlink targets are link-location-relative (symlink semantics): `make.tcl`'s `merge_over` resolves them against the link file's own directory, which is indistinguishable from the old vfs-root-relative resolution for root-level links. - `dev` mode loads built output from `/modules` and `/lib`; `src` mode loads unbuilt source from `/src/modules` etc. Use `src-dev-internal` to combine both with src priority. ## Work Guidance diff --git a/src/vfs/_config/project_main.tcl b/src/vfs/_config/project_main.tcl index 9c84a78f..c3eb9aab 100644 --- a/src/vfs/_config/project_main.tcl +++ b/src/vfs/_config/project_main.tcl @@ -154,14 +154,109 @@ apply { args { } return "${os}-${cpu}" } + proc path_within {path base} { + #1 if $path equals $base or lies under it (path-segment aware; windows + #compares case-insensitively). Both args pre-normalized, forward slashes. + if {$base eq ""} {return 0} + set p $path + set b $base + if {"windows" eq $::tcl_platform(platform)} { + set p [string tolower $p] + set b [string tolower $b] + } + set b [string trimright $b /] + if {$p eq $b} {return 1} + return [string match "$b/*" $p] + } + proc zipfs_mount_pairs {} { + #the zipfs mount table as a flat list of mountpoint,archivefile pairs. + #'tcl::zipfs::mount' (no args) reports that pairing in every zipfs + #generation supported as a kit runtime: the 8.7/9 core zipfs and the + #androwish/undroidwish tcl 8.6 backport (G-129 measured both). + #empty list when zipfs is absent, nothing is mounted, or the table is + #not pairwise (unknown generation - callers treat that as 'cannot + #attribute any mount to this executable'). + if {[info commands ::tcl::zipfs::mount] eq ""} {return [list]} + if {[catch {::tcl::zipfs::mount} mtable]} {return [list]} + if {[llength $mtable] % 2 != 0} {return [list]} + return $mtable + } + proc zipfs_kit_mountbase {} { + #G-129: where is THIS executable's attached archive mounted? + #Returns the mountpoint, or "" when no mount can be attributed to the + #executable. The mount table pairs each mountpoint with the archive file + #mounted there; the entry whose archive file is [info nameofexecutable] + #is this kit's own payload wherever it landed - //zipfs:/app on modern + #runtimes (the compiled-in ZIPFS_APP_MOUNT default), the executable's own + #path on the 8.6 backport family. Measured backport quirk: its + #archive-file column drops the windows drive prefix (/path/to/kit.exe + #for C:/path/to/kit.exe), so that spelling is accepted too. + #Fallback: a mountpoint containing [info script] is the payload this very + #boot is running from, even when the archive-file column is unmatchable. + set mpairs [zipfs_mount_pairs] + if {![llength $mpairs]} {return ""} + set normexe [file dirname [file normalize [file join [info nameofexecutable] __dummy__]]] + set on_windows [expr {"windows" eq $::tcl_platform(platform)}] + if {$on_windows} { + set exe_forms [list [string tolower $normexe]] + if {[string match {[a-zA-Z]:/*} $normexe]} { + lappend exe_forms [string tolower [string range $normexe 2 end]] + } + } else { + set exe_forms [list $normexe] + } + set matched [list] + foreach {mountpoint archivefile} $mpairs { + set f [string map [list \\ /] $archivefile] + if {$on_windows} { + set f [string tolower $f] + } + if {$f in $exe_forms} { + lappend matched $mountpoint + } + } + if {[llength $matched] == 1} { + return [lindex $matched 0] + } + set normscript [file dirname [file normalize [file join [info script] __dummy__]]] + if {[llength $matched] > 1} { + #prefer the mount this very script is booting from + foreach mountpoint $matched { + if {[path_within $normscript $mountpoint]} { + return $mountpoint + } + } + return [lindex $matched 0] + } + foreach {mountpoint archivefile} $mpairs { + if {[path_within $normscript $mountpoint]} { + return $mountpoint + } + } + return "" + } } - set has_zipfs [expr {[info commands tcl::zipfs::root] ne ""}] + #G-129: key zipfs presence 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). + set has_zipfs [expr {[info commands tcl::zipfs::mount] ne ""}] if {$has_zipfs} { set has_zipfs_attached [expr {[llength [tcl::zipfs::mount]]}] } else { set has_zipfs_attached 0 } + #where this executable's attached archive actually mounted ("" when there is no + #attributable mount): //zipfs:/app on modern runtimes, the executable's own path + #on the 8.6 backport family. Factored as its own question about the running kit + #(G-131 grows a metakit arm beside it). + set zipkit_mountbase "" + if {$has_zipfs_attached} { + set zipkit_mountbase [::punkboot::zipfs_kit_mountbase] + if {$zipkit_mountbase eq ""} { + puts stderr "main.tcl: a zipfs archive is mounted but none of the mounts could be attributed to this executable ([info nameofexecutable]) - kit-internal module/lib paths will NOT be configured. zipfs mount table: [tcl::zipfs::mount]" + } + } #REVIEW - cookit/cookfs can be compiled with a different name for it's mount-point # - we could examine the -handle from 'file attr' for each //something:/ volume (excluding //zipfs:/) @@ -191,9 +286,12 @@ apply { args { set topdir [file dirname $normscript] set found_starkit_tcl 0 set possible_lib_vfs_folders [glob -nocomplain -dir [file join $topdir lib] -type d vfs*] - if {$has_zipfs_attached} { - if {[file exists [zipfs root]/app/tcl_library]} { - lappend possible_lib_vfs_folders {*}[glob -nocomplain -dir [zipfs root]/app/tcl_library -type d vfs*] + if {$zipkit_mountbase ne ""} { + #G-129: the payload's own tcl_library at the derived mount base (was [zipfs root]/app, + #which errors on the 8.6 backport - no root subcommand - and assumes the modern mount) + set zipkit_tcl_library [file join $zipkit_mountbase tcl_library] + if {[file exists $zipkit_tcl_library]} { + lappend possible_lib_vfs_folders {*}[glob -nocomplain -dir $zipkit_tcl_library -type d vfs*] } } foreach test_folder $possible_lib_vfs_folders { @@ -295,21 +393,17 @@ apply { args { lappend auto_path_additions_internal [file join $kp $p] } } - if {$has_zipfs_attached} { - #review build option may be different - tclZipFs.c ZIPFS_APP_MOUNT defaults to ZIPFS_VOLUME/app - but it could be something else. (why?) - #default 'zipfs root' has trailing slash (//zipfs:/) - but file join does the right thing - set zipbase [file join [tcl::zipfs::root] app] - if {"$zipbase" in [tcl::zipfs::mount]} { - #set existing_module_paths [string tolower [tcl::tm::list]] - foreach p [list modules modules_tcl$tclmajorv] { - #if {[string tolower [file join $zipbase $p]] ni $existing_module_paths} { - # tcl::tm::add [file join $zipbase $p] - #} - lappend tm_additions_internal [file join $zipbase $p] - } - foreach p [list lib lib_tcl$tclmajorv] { - lappend auto_path_additions_internal [file join $zipbase $p] - } + if {$zipkit_mountbase ne ""} { + #G-129: the derived mount base replaces the compiled-in assumption. tclZipFs.c + #ZIPFS_APP_MOUNT defaults to ZIPFS_VOLUME/app and modern runtimes mount the + #attached archive there; the 8.6 backport family mounts it at the executable's + #own path. The mount table is the ground truth either way. + set zipbase $zipkit_mountbase + foreach p [list modules modules_tcl$tclmajorv] { + lappend tm_additions_internal [file join $zipbase $p] + } + foreach p [list lib lib_tcl$tclmajorv] { + lappend auto_path_additions_internal [file join $zipbase $p] } } if {$has_cookfs_attached} { @@ -329,8 +423,25 @@ apply { args { set internal_paths [list] if {$has_zipfs} { - set ziproot [tcl::zipfs::root] ;#root is enough to determine internal zipkit path - lappend internal_paths $ziproot + if {[info commands tcl::zipfs::root] ne ""} { + set ziproot [tcl::zipfs::root] ;#the volume root covers every zipfs mount + lappend internal_paths $ziproot + } + #8.6 backport family: no root command, and the attached archive mounts outside + #any zipfs volume (at the executable's own path) - the derived mount base is the + #internal prefix. On modern runtimes it is already covered by the volume root. + if {$zipkit_mountbase ne ""} { + set mountbase_covered 0 + foreach okprefix $internal_paths { + if {[string match "[string tolower $okprefix]*" [string tolower $zipkit_mountbase]]} { + set mountbase_covered 1 + break + } + } + if {!$mountbase_covered} { + lappend internal_paths $zipkit_mountbase + } + } } if {[info exists ::tcl::kitpath] && $::tcl::kitpath ne ""} { lappend internal_paths $::tcl::kitpath @@ -794,7 +905,15 @@ apply { args { #set script_relative_lib [file normalize [file join [file dirname [info script]] lib]] #set scriptdir [file dirname [info script]] set scriptdir [file dirname $normscript] - if {![string match //zipfs:/* $scriptdir] && ![string match "${cookbase}*" $scriptdir] && ![info exists ::tcl::kitpath]} { + #G-129: a script under the derived zipfs mount base is kit-internal even though + #no //zipfs:/ prefix test can recognise it (8.6 backport mounts at the exe path) + set script_in_attached_vfs 0 + if {[string match //zipfs:/* $scriptdir] || [string match "${cookbase}*" $scriptdir] || [info exists ::tcl::kitpath]} { + set script_in_attached_vfs 1 + } elseif {$zipkit_mountbase ne "" && [::punkboot::path_within $scriptdir $zipkit_mountbase]} { + set script_in_attached_vfs 1 + } + if {!$script_in_attached_vfs} { #presumably running the vfs/xxx.vfs/main.tcl script using a non-kit tclsh that doesn't have starkit lib or mounted zipfs/cookfs available.. lets see if we can move forward anyway set vfscontainer [file normalize [file dirname $scriptdir]] #set vfscommon [file join $vfscontainer _vfscommon] diff --git a/src/vfs/_config/punk_main.tcl b/src/vfs/_config/punk_main.tcl index f33cba16..816a4352 100644 --- a/src/vfs/_config/punk_main.tcl +++ b/src/vfs/_config/punk_main.tcl @@ -285,14 +285,109 @@ apply { args { } return 0 } + proc path_within {path base} { + #1 if $path equals $base or lies under it (path-segment aware; windows + #compares case-insensitively). Both args pre-normalized, forward slashes. + if {$base eq ""} {return 0} + set p $path + set b $base + if {"windows" eq $::tcl_platform(platform)} { + set p [string tolower $p] + set b [string tolower $b] + } + set b [string trimright $b /] + if {$p eq $b} {return 1} + return [string match "$b/*" $p] + } + proc zipfs_mount_pairs {} { + #the zipfs mount table as a flat list of mountpoint,archivefile pairs. + #'tcl::zipfs::mount' (no args) reports that pairing in every zipfs + #generation supported as a kit runtime: the 8.7/9 core zipfs and the + #androwish/undroidwish tcl 8.6 backport (G-129 measured both). + #empty list when zipfs is absent, nothing is mounted, or the table is + #not pairwise (unknown generation - callers treat that as 'cannot + #attribute any mount to this executable'). + if {[info commands ::tcl::zipfs::mount] eq ""} {return [list]} + if {[catch {::tcl::zipfs::mount} mtable]} {return [list]} + if {[llength $mtable] % 2 != 0} {return [list]} + return $mtable + } + proc zipfs_kit_mountbase {} { + #G-129: where is THIS executable's attached archive mounted? + #Returns the mountpoint, or "" when no mount can be attributed to the + #executable. The mount table pairs each mountpoint with the archive file + #mounted there; the entry whose archive file is [info nameofexecutable] + #is this kit's own payload wherever it landed - //zipfs:/app on modern + #runtimes (the compiled-in ZIPFS_APP_MOUNT default), the executable's own + #path on the 8.6 backport family. Measured backport quirk: its + #archive-file column drops the windows drive prefix (/path/to/kit.exe + #for C:/path/to/kit.exe), so that spelling is accepted too. + #Fallback: a mountpoint containing [info script] is the payload this very + #boot is running from, even when the archive-file column is unmatchable. + set mpairs [zipfs_mount_pairs] + if {![llength $mpairs]} {return ""} + set normexe [file dirname [file normalize [file join [info nameofexecutable] __dummy__]]] + set on_windows [expr {"windows" eq $::tcl_platform(platform)}] + if {$on_windows} { + set exe_forms [list [string tolower $normexe]] + if {[string match {[a-zA-Z]:/*} $normexe]} { + lappend exe_forms [string tolower [string range $normexe 2 end]] + } + } else { + set exe_forms [list $normexe] + } + set matched [list] + foreach {mountpoint archivefile} $mpairs { + set f [string map [list \\ /] $archivefile] + if {$on_windows} { + set f [string tolower $f] + } + if {$f in $exe_forms} { + lappend matched $mountpoint + } + } + if {[llength $matched] == 1} { + return [lindex $matched 0] + } + set normscript [file dirname [file normalize [file join [info script] __dummy__]]] + if {[llength $matched] > 1} { + #prefer the mount this very script is booting from + foreach mountpoint $matched { + if {[path_within $normscript $mountpoint]} { + return $mountpoint + } + } + return [lindex $matched 0] + } + foreach {mountpoint archivefile} $mpairs { + if {[path_within $normscript $mountpoint]} { + return $mountpoint + } + } + return "" + } } - set has_zipfs [expr {[info commands tcl::zipfs::root] ne ""}] + #G-129: key zipfs presence 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). + set has_zipfs [expr {[info commands tcl::zipfs::mount] ne ""}] if {$has_zipfs} { set has_zipfs_attached [expr {[llength [tcl::zipfs::mount]]}] } else { set has_zipfs_attached 0 } + #where this executable's attached archive actually mounted ("" when there is no + #attributable mount): //zipfs:/app on modern runtimes, the executable's own path + #on the 8.6 backport family. Factored as its own question about the running kit + #(G-131 grows a metakit arm beside it). + set zipkit_mountbase "" + if {$has_zipfs_attached} { + set zipkit_mountbase [::punkboot::zipfs_kit_mountbase] + if {$zipkit_mountbase eq ""} { + puts stderr "main.tcl: a zipfs archive is mounted but none of the mounts could be attributed to this executable ([info nameofexecutable]) - kit-internal module/lib paths will NOT be configured. zipfs mount table: [tcl::zipfs::mount]" + } + } #REVIEW - cookit/cookfs can be compiled with a different name for it's mount-point # - we could examine the -handle from 'file attr' for each //something:/ volume (excluding //zipfs:/) @@ -322,9 +417,12 @@ apply { args { set topdir [file dirname $normscript] set found_starkit_tcl 0 set possible_lib_vfs_folders [glob -nocomplain -dir [file join $topdir lib] -type d vfs*] - if {$has_zipfs_attached} { - if {[file exists [zipfs root]/app/tcl_library]} { - lappend possible_lib_vfs_folders {*}[glob -nocomplain -dir [zipfs root]/app/tcl_library -type d vfs*] + if {$zipkit_mountbase ne ""} { + #G-129: the payload's own tcl_library at the derived mount base (was [zipfs root]/app, + #which errors on the 8.6 backport - no root subcommand - and assumes the modern mount) + set zipkit_tcl_library [file join $zipkit_mountbase tcl_library] + if {[file exists $zipkit_tcl_library]} { + lappend possible_lib_vfs_folders {*}[glob -nocomplain -dir $zipkit_tcl_library -type d vfs*] } } foreach test_folder $possible_lib_vfs_folders { @@ -428,21 +526,17 @@ apply { args { lappend auto_path_additions_internal [file join $kp $p] } } - if {$has_zipfs_attached} { - #review build option may be different - tclZipFs.c ZIPFS_APP_MOUNT defaults to ZIPFS_VOLUME/app - but it could be something else. (why?) - #default 'zipfs root' has trailing slash (//zipfs:/) - but file join does the right thing - set zipbase [file join [tcl::zipfs::root] app] - if {"$zipbase" in [tcl::zipfs::mount]} { - #set existing_module_paths [string tolower [tcl::tm::list]] - foreach p [list modules modules_tcl$tclmajorv] { - #if {[string tolower [file join $zipbase $p]] ni $existing_module_paths} { - # tcl::tm::add [file join $zipbase $p] - #} - lappend tm_additions_internal [file join $zipbase $p] - } - foreach p [list lib lib_tcl$tclmajorv] { - lappend auto_path_additions_internal [file join $zipbase $p] - } + if {$zipkit_mountbase ne ""} { + #G-129: the derived mount base replaces the compiled-in assumption. tclZipFs.c + #ZIPFS_APP_MOUNT defaults to ZIPFS_VOLUME/app and modern runtimes mount the + #attached archive there; the 8.6 backport family mounts it at the executable's + #own path. The mount table is the ground truth either way. + set zipbase $zipkit_mountbase + foreach p [list modules modules_tcl$tclmajorv] { + lappend tm_additions_internal [file join $zipbase $p] + } + foreach p [list lib lib_tcl$tclmajorv] { + lappend auto_path_additions_internal [file join $zipbase $p] } } if {$has_cookfs_attached} { @@ -462,8 +556,25 @@ apply { args { set internal_paths [list] if {$has_zipfs} { - set ziproot [tcl::zipfs::root] ;#root is enough to determine internal zipkit path - lappend internal_paths $ziproot + if {[info commands tcl::zipfs::root] ne ""} { + set ziproot [tcl::zipfs::root] ;#the volume root covers every zipfs mount + lappend internal_paths $ziproot + } + #8.6 backport family: no root command, and the attached archive mounts outside + #any zipfs volume (at the executable's own path) - the derived mount base is the + #internal prefix. On modern runtimes it is already covered by the volume root. + if {$zipkit_mountbase ne ""} { + set mountbase_covered 0 + foreach okprefix $internal_paths { + if {[string match "[string tolower $okprefix]*" [string tolower $zipkit_mountbase]]} { + set mountbase_covered 1 + break + } + } + if {!$mountbase_covered} { + lappend internal_paths $zipkit_mountbase + } + } } if {[info exists ::tcl::kitpath] && $::tcl::kitpath ne ""} { lappend internal_paths $::tcl::kitpath @@ -1029,7 +1140,15 @@ apply { args { #set script_relative_lib [file normalize [file join [file dirname [info script]] lib]] #set scriptdir [file dirname [info script]] set scriptdir [file dirname $normscript] - if {![string match //zipfs:/* $scriptdir] && ![string match "${cookbase}*" $scriptdir] && ![info exists ::tcl::kitpath]} { + #G-129: a script under the derived zipfs mount base is kit-internal even though + #no //zipfs:/ prefix test can recognise it (8.6 backport mounts at the exe path) + set script_in_attached_vfs 0 + if {[string match //zipfs:/* $scriptdir] || [string match "${cookbase}*" $scriptdir] || [info exists ::tcl::kitpath]} { + set script_in_attached_vfs 1 + } elseif {$zipkit_mountbase ne "" && [::punkboot::path_within $scriptdir $zipkit_mountbase]} { + set script_in_attached_vfs 1 + } + if {!$script_in_attached_vfs} { #presumably running the vfs/xxx.vfs/main.tcl script using a non-kit tclsh that doesn't have starkit lib or mounted zipfs/cookfs available.. lets see if we can move forward anyway set vfscontainer [file normalize [file dirname $scriptdir]] #set vfscommon [file join $vfscontainer _vfscommon] diff --git a/src/vfs/punk8win.vfs/app/main.tcl#..+..+_config+punk_main.tcl#@punk%3a%3aboot,merge_over#.fxlnk b/src/vfs/punk8win.vfs/app/main.tcl#..+..+_config+punk_main.tcl#@punk%3a%3aboot,merge_over#.fxlnk new file mode 100644 index 00000000..e69de29b