diff --git a/src/bootsupport/modules/punk/mix/templates-0.2.0.tm b/src/bootsupport/modules/punk/mix/templates-0.2.0.tm index 5b144e73..cce8edf2 100644 Binary files a/src/bootsupport/modules/punk/mix/templates-0.2.0.tm and b/src/bootsupport/modules/punk/mix/templates-0.2.0.tm differ diff --git a/src/bootsupport/modules/punkboot/utils-0.2.0.tm b/src/bootsupport/modules/punkboot/utils-0.3.0.tm similarity index 66% rename from src/bootsupport/modules/punkboot/utils-0.2.0.tm rename to src/bootsupport/modules/punkboot/utils-0.3.0.tm index 736f28f8..133378da 100644 --- a/src/bootsupport/modules/punkboot/utils-0.2.0.tm +++ b/src/bootsupport/modules/punkboot/utils-0.3.0.tm @@ -7,7 +7,7 @@ # (C) 2023 # # @@ Meta Begin -# Application punkboot::utils 0.2.0 +# Application punkboot::utils 0.3.0 # Meta platform tcl # Meta license BSD # @@ Meta End @@ -23,7 +23,7 @@ package require Tcl 8.6- # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ namespace eval punkboot::utils { variable version 0.1.0 - namespace export parse_punkproject_version read_punkproject_version read_changelog_latest_version vcs_dirty_warnings + namespace export parse_punkproject_version read_punkproject_version read_changelog_latest_version vcs_dirty_warnings vfs_boot_library_report namespace eval argdoc { @@ -227,6 +227,103 @@ namespace eval punkboot::utils { } return $warnings } + + + #Companion files of a real Tcl library directory. init.tcl sources these, so a + #directory holding init.tcl with none of them beside it is a package's own init + #script (lib/BWidget1.10.1/init.tcl and friends), not a tcl library. + variable boot_library_companions {tm.tcl package.tcl auto.tcl clock.tcl history.tcl word.tcl} + + namespace eval argdoc { + lappend PUNKARGS [list { + @id -id ::punkboot::utils::vfs_boot_library_report + @cmd -name "::punkboot::utils::vfs_boot_library_report"\ + -summary\ + "Report whether an assembled vfs tree can supply a bootable tcl library"\ + -help\ + "Structural check of a merged .vfs tree for the precondition a kit + needs to initialise at all: a Tcl library the runtime can find. Reads + the directory only - nothing is executed, decompressed or launched, so + a caller such as make.tcl can run it for every kit on every bake and + for a cross-target kit it could never run itself. + + Two conventions are recognised, both observed in this project's kits: + tcl_library/ zipfs-attached kits (tclZipfs looks for + /tcl_library/init.tcl) + lib/tcl./ starkit/tclkit-style kits (lib/tcl8.6, + lib/tcl9.0) + + A candidate directory qualifies only when it holds init.tcl AND at + least one companion file a real Tcl library carries beside it + (tm.tcl, package.tcl, auto.tcl, clock.tcl, history.tcl, word.tcl) or + an encoding/ subdirectory. Without that second test a package's own + init script - lib/BWidget1.10.1/init.tcl, present in every punkshell + kit - would answer for a tcl library it cannot provide. + + Returned dict keys: + ok 1 when at least one qualifying library was found + locations qualifying directories, relative to vfsfolder + rejected candidate directories that held init.tcl but no + companion, relative to vfsfolder - the near-misses + worth naming when a gate fires unexpectedly + checked the location patterns examined, relative to vfsfolder + reason why ok is 0; empty string when ok is 1" + @leaders + vfsfolder -type string -optional 0 -help\ + "Path of the assembled vfs tree to inspect" + }] + } + proc vfs_boot_library_report {vfsfolder} { + variable boot_library_companions + set checked [list tcl_library lib/tcl.] + set report [dict create ok 0 locations {} rejected {} checked $checked reason ""] + if {![file isdirectory $vfsfolder]} { + dict set report reason "no such directory: $vfsfolder" + return $report + } + #candidates are the two conventions only - a full tree walk would find every + #package's init.tcl and cost more than the check is worth + set candidates [list [file join $vfsfolder tcl_library]] + foreach dir [lsort [glob -nocomplain -type d -directory [file join $vfsfolder lib] -- {tcl[0-9]*}]] { + lappend candidates $dir + } + set locations [list] + set rejected [list] + foreach dir $candidates { + if {![file isfile [file join $dir init.tcl]]} { + continue + } + set qualifies 0 + foreach companion $boot_library_companions { + if {[file isfile [file join $dir $companion]]} { + set qualifies 1 + break + } + } + if {!$qualifies && [file isdirectory [file join $dir encoding]]} { + set qualifies 1 + } + set rel [string range $dir [expr {[string length $vfsfolder] + 1}] end] + if {$qualifies} { + lappend locations $rel + } else { + lappend rejected $rel + } + } + if {[llength $locations]} { + dict set report ok 1 + dict set report locations $locations + dict set report rejected $rejected + return $report + } + dict set report rejected $rejected + if {[llength $rejected]} { + dict set report reason "no tcl library in [file tail $vfsfolder]: [join $rejected {, }] hold init.tcl but none of the companion files a tcl library carries beside it ([join $boot_library_companions {, }]) nor an encoding/ directory" + } else { + dict set report reason "no tcl library in [file tail $vfsfolder]: neither tcl_library/init.tcl nor lib/tcl./init.tcl is present" + } + return $report + } } namespace eval ::punk::args::register { @@ -237,8 +334,8 @@ namespace eval ::punk::args::register { ## Ready package provide punkboot::utils [tcl::namespace::eval punkboot::utils { variable version - #- this version number, exactly 0.2.0, is a literal used in src module folders + #- this version number, exactly 0.3.0, is a literal used in src module folders #- we refer to this sometimes as the magic version number - set version 0.2.0 + set version 0.3.0 }] return 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 68653cf4..4c119425 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 @@ -2281,6 +2281,12 @@ DIAGRAM 2 - KIT ASSEMBLY DETAIL (the 'make.tcl bake' stage; incl. vfslibs phase) | copy common, then merge overlay over it v src/_build/.exe.vfs + | + | boot-precondition gate: merged vfs must supply a tcl + | library (tcl_library/ or lib/tcl./) [K10] + v + (gate) --> refused: kit listed under FAILED KITS, nothing + | built, nothing deployed, bin/ untouched | | zip image appended to the runtime exe: tcl::zipfs::mkimg, | or (driving tcl without zipfs, e.g 8.6) raw-runtime split @@ -2354,6 +2360,21 @@ KEY / NOTES 'make.tcl check' prints the derivation; 'make.tcl bakelist' shows per-kit targets, with a target= note on rows that are not on the default target. +[K10] BOOT-PRECONDITION gate (G-125). A kit whose merged vfs has no tcl library + cannot initialise at all ('Cannot find a usable init.tcl'), so the bake + refuses it: the kit is listed under FAILED KITS and NOTHING is written - + no src/_build/, no deploy, and the previously deployed bin/ is + left exactly as it was. This is deliberately not a warning: the deploy step + deletes the old kit before copying the new one, so warning-and-proceeding + replaced a working shell with one that could not start. The check is + structural (tcl_library/init.tcl or lib/tcl./init.tcl, plus a + companion file so a package's own init.tcl cannot answer for a tcl library) + and runs on the MERGED tree, not on whether extraction ran - a .vfs that + supplies its own tcl library builds and deploys as normal. Nothing is + executed, so cross-target kits are covered too. Usual cause: the runtime's + own payload could not be extracted - see the BUILD-WARNING naming what was + tried. 'make.tcl check' reports whether the gate is ACTIVE. + MAINTENANCE (agents take note) ---------------------------------------------------------------------------- This text is embedded in make.tcl (::punkboot::workflow_text). When the build @@ -3264,6 +3285,21 @@ proc ::punkboot::get_src_provenance_warnings {projectroot label} { set checked_vcs_roots [dict create] return [list 1 [::punkboot::utils::vcs_dirty_warnings $projectroot checked_vcs_roots $label src]] } +#Availability probe + boot-precondition check of an assembled kit vfs (G-125), shared by the +#kit gate in the bake loop and the 'check' command report. Same guarded-require treatment as +#the provenance check above: a stale or missing punkboot::utils snapshot must not brick the +#commands used to repair it, so an unavailable check degrades to a notice rather than failing +#every kit. Returns {available report}. +proc ::punkboot::get_vfs_boot_library_report {vfsfolder} { + set available [expr {\ + ![catch {package require punkboot::utils}]\ + && [llength [info commands ::punkboot::utils::vfs_boot_library_report]]\ + }] + if {!$available} { + return [list 0 [dict create]] + } + return [list 1 [::punkboot::utils::vfs_boot_library_report $vfsfolder]] +} #Wrap ::exit so accumulated provenance warnings are recapped at the very end of output no matter #which of make.tcl's many exit points a command takes. if {![llength [info commands ::punkboot::exit_original]]} { @@ -3506,6 +3542,19 @@ if {$::punkboot::command eq "check"} { puts stdout " build/promotion commands (project packages modules libs vfs vfslibs bin bootsupport vfscommonupdate) will WARN as above and proceed." puts stdout " With -dirty-abort they would abort. To evaluate uncommitted source without building, use ' src' or ' src shell'." } + # Kit boot-precondition gate status - whether a bake can refuse an unbootable kit + puts stdout $sep + #availability probe only - the path deliberately does not exist + lassign [::punkboot::get_vfs_boot_library_report [file join $projectroot __punkboot_bootgate_probe__]] _boot_available _boot_report + if {$_boot_available} { + puts stdout "boot-precondition gate (G-125): ACTIVE" + puts stdout " bake checks each kit's merged vfs for a tcl library (tcl_library/ or lib/tcl./) before" + puts stdout " building it. A kit with none is reported under FAILED KITS and is neither built nor deployed, so a" + puts stdout " previously deployed kit is never replaced by an artifact that cannot initialise." + } else { + puts stdout "boot-precondition gate (G-125): UNAVAILABLE (punkboot::utils vfs_boot_library_report not loadable from bootsupport)" + puts stdout " bake will proceed with a NOTE and cannot refuse an unbootable kit - run 'make.tcl modules' then 'make.tcl bootsupport'." + } puts stdout $sep exit 0 } @@ -6047,13 +6096,15 @@ foreach vfstail $vfs_tails { } } ;#end while !$extraction_done && [llength $extraction_trylist] + set extraction_tried "$target_kit_type[expr {[llength $source_kit_caps] ? " + runtime caps $source_kit_caps" : ""}]" if {!$extraction_done} { #TODO: if not extracted - use a default tcl_library for patchlevel and platform? - #Recapped BUILD-WARNING (not just an inline note): the build continues - #and produces an artifact, but unless the .vfs itself supplies a - #tcl_library that artifact cannot boot - and this line would otherwise - #scroll away behind thousands of merge lines. - ::punkboot::print_build_warnings [list "No extraction done from runtime $runtime_fullname (tried: $target_kit_type[expr {[llength $source_kit_caps] ? " + runtime caps $source_kit_caps" : ""}]) - kit $targetkit gets no tcl_library from the runtime and will not initialise unless src/vfs/$vfstail supplies one"] + #Recapped BUILD-WARNING (not just an inline note): this line would + #otherwise scroll away behind thousands of merge lines. It is a warning + #rather than the failure itself because a .vfs that supplies its own tcl + #library needs no extraction - the G-125 gate below decides, on the + #merged tree, whether this kit can initialise. + ::punkboot::print_build_warnings [list "No extraction done from runtime $runtime_fullname (tried: $extraction_tried) - kit $targetkit gets no tcl library from the runtime, so it will FAIL the boot-precondition gate unless src/vfs/$vfstail supplies one"] file mkdir $targetvfs } @@ -6111,6 +6162,36 @@ foreach vfstail $vfs_tails { set sourcevfs [file join $sourcefolder vfs $vfstail] merge_over $sourcevfs $targetvfs + #G-125 boot-precondition gate. A kit with no tcl library cannot initialise + #at all - 'Cannot find a usable init.tcl' - so refuse it HERE: before any + #build product is written, and long before the deploy step deletes the + #previously working bin/ and copies the new one over it. The check is + #on the MERGED tree rather than on whether extraction ran, because a .vfs + #that supplies its own tcl library is legitimate and must keep building + #(src/vfs/punk8_statictwapi.vfs and punk9test.vfs are such folders today). + #Structural and non-executing, so it also covers cross-target kits, which + #this host could never run. + lassign [::punkboot::get_vfs_boot_library_report $targetvfs] bootcheck_available bootcheck + if {!$bootcheck_available} { + puts stderr "NOTE: kit boot-precondition check unavailable (punkboot::utils vfs_boot_library_report not loadable from bootsupport) - continuing without it" + } elseif {![dict get $bootcheck ok]} { + if {$extraction_done} { + #extract_kit_type is only recorded by some of the extraction branches + set extractedas [expr {$extract_kit_type ne "" ? " (as $extract_kit_type)" : ""}] + set gatecause "extraction from runtime $runtime_fullname$extractedas ran but supplied no tcl library, and src/vfs/$vfstail does not supply one either" + } else { + set gatecause "nothing was extracted from runtime $runtime_fullname (tried: $extraction_tried) and src/vfs/$vfstail does not supply a tcl library" + } + set failmsg "kit cannot initialise - $gatecause. Checked [join [dict get $bootcheck checked] { and }] in the merged vfs; [dict get $bootcheck reason]. NOT BUILT and NOT DEPLOYED: any previously deployed $targetkit is untouched" + puts stderr "boot-precondition gate FAILED for kit $targetkit - refusing to build an artifact that cannot initialise" + puts stderr " $gatecause" + lappend failed_kits [list kit $targetkit reason $failmsg] + $vfs_event targetset_end FAILED + $vfs_event destroy + $vfs_installer destroy + continue + } + set wrapvfs $targetvfs switch -- $target_kit_type { zip { diff --git a/src/project_layouts/vendor/punk/basic/src/make.tcl b/src/project_layouts/vendor/punk/basic/src/make.tcl index 68653cf4..4c119425 100644 --- a/src/project_layouts/vendor/punk/basic/src/make.tcl +++ b/src/project_layouts/vendor/punk/basic/src/make.tcl @@ -2281,6 +2281,12 @@ DIAGRAM 2 - KIT ASSEMBLY DETAIL (the 'make.tcl bake' stage; incl. vfslibs phase) | copy common, then merge overlay over it v src/_build/.exe.vfs + | + | boot-precondition gate: merged vfs must supply a tcl + | library (tcl_library/ or lib/tcl./) [K10] + v + (gate) --> refused: kit listed under FAILED KITS, nothing + | built, nothing deployed, bin/ untouched | | zip image appended to the runtime exe: tcl::zipfs::mkimg, | or (driving tcl without zipfs, e.g 8.6) raw-runtime split @@ -2354,6 +2360,21 @@ KEY / NOTES 'make.tcl check' prints the derivation; 'make.tcl bakelist' shows per-kit targets, with a target= note on rows that are not on the default target. +[K10] BOOT-PRECONDITION gate (G-125). A kit whose merged vfs has no tcl library + cannot initialise at all ('Cannot find a usable init.tcl'), so the bake + refuses it: the kit is listed under FAILED KITS and NOTHING is written - + no src/_build/, no deploy, and the previously deployed bin/ is + left exactly as it was. This is deliberately not a warning: the deploy step + deletes the old kit before copying the new one, so warning-and-proceeding + replaced a working shell with one that could not start. The check is + structural (tcl_library/init.tcl or lib/tcl./init.tcl, plus a + companion file so a package's own init.tcl cannot answer for a tcl library) + and runs on the MERGED tree, not on whether extraction ran - a .vfs that + supplies its own tcl library builds and deploys as normal. Nothing is + executed, so cross-target kits are covered too. Usual cause: the runtime's + own payload could not be extracted - see the BUILD-WARNING naming what was + tried. 'make.tcl check' reports whether the gate is ACTIVE. + MAINTENANCE (agents take note) ---------------------------------------------------------------------------- This text is embedded in make.tcl (::punkboot::workflow_text). When the build @@ -3264,6 +3285,21 @@ proc ::punkboot::get_src_provenance_warnings {projectroot label} { set checked_vcs_roots [dict create] return [list 1 [::punkboot::utils::vcs_dirty_warnings $projectroot checked_vcs_roots $label src]] } +#Availability probe + boot-precondition check of an assembled kit vfs (G-125), shared by the +#kit gate in the bake loop and the 'check' command report. Same guarded-require treatment as +#the provenance check above: a stale or missing punkboot::utils snapshot must not brick the +#commands used to repair it, so an unavailable check degrades to a notice rather than failing +#every kit. Returns {available report}. +proc ::punkboot::get_vfs_boot_library_report {vfsfolder} { + set available [expr {\ + ![catch {package require punkboot::utils}]\ + && [llength [info commands ::punkboot::utils::vfs_boot_library_report]]\ + }] + if {!$available} { + return [list 0 [dict create]] + } + return [list 1 [::punkboot::utils::vfs_boot_library_report $vfsfolder]] +} #Wrap ::exit so accumulated provenance warnings are recapped at the very end of output no matter #which of make.tcl's many exit points a command takes. if {![llength [info commands ::punkboot::exit_original]]} { @@ -3506,6 +3542,19 @@ if {$::punkboot::command eq "check"} { puts stdout " build/promotion commands (project packages modules libs vfs vfslibs bin bootsupport vfscommonupdate) will WARN as above and proceed." puts stdout " With -dirty-abort they would abort. To evaluate uncommitted source without building, use ' src' or ' src shell'." } + # Kit boot-precondition gate status - whether a bake can refuse an unbootable kit + puts stdout $sep + #availability probe only - the path deliberately does not exist + lassign [::punkboot::get_vfs_boot_library_report [file join $projectroot __punkboot_bootgate_probe__]] _boot_available _boot_report + if {$_boot_available} { + puts stdout "boot-precondition gate (G-125): ACTIVE" + puts stdout " bake checks each kit's merged vfs for a tcl library (tcl_library/ or lib/tcl./) before" + puts stdout " building it. A kit with none is reported under FAILED KITS and is neither built nor deployed, so a" + puts stdout " previously deployed kit is never replaced by an artifact that cannot initialise." + } else { + puts stdout "boot-precondition gate (G-125): UNAVAILABLE (punkboot::utils vfs_boot_library_report not loadable from bootsupport)" + puts stdout " bake will proceed with a NOTE and cannot refuse an unbootable kit - run 'make.tcl modules' then 'make.tcl bootsupport'." + } puts stdout $sep exit 0 } @@ -6047,13 +6096,15 @@ foreach vfstail $vfs_tails { } } ;#end while !$extraction_done && [llength $extraction_trylist] + set extraction_tried "$target_kit_type[expr {[llength $source_kit_caps] ? " + runtime caps $source_kit_caps" : ""}]" if {!$extraction_done} { #TODO: if not extracted - use a default tcl_library for patchlevel and platform? - #Recapped BUILD-WARNING (not just an inline note): the build continues - #and produces an artifact, but unless the .vfs itself supplies a - #tcl_library that artifact cannot boot - and this line would otherwise - #scroll away behind thousands of merge lines. - ::punkboot::print_build_warnings [list "No extraction done from runtime $runtime_fullname (tried: $target_kit_type[expr {[llength $source_kit_caps] ? " + runtime caps $source_kit_caps" : ""}]) - kit $targetkit gets no tcl_library from the runtime and will not initialise unless src/vfs/$vfstail supplies one"] + #Recapped BUILD-WARNING (not just an inline note): this line would + #otherwise scroll away behind thousands of merge lines. It is a warning + #rather than the failure itself because a .vfs that supplies its own tcl + #library needs no extraction - the G-125 gate below decides, on the + #merged tree, whether this kit can initialise. + ::punkboot::print_build_warnings [list "No extraction done from runtime $runtime_fullname (tried: $extraction_tried) - kit $targetkit gets no tcl library from the runtime, so it will FAIL the boot-precondition gate unless src/vfs/$vfstail supplies one"] file mkdir $targetvfs } @@ -6111,6 +6162,36 @@ foreach vfstail $vfs_tails { set sourcevfs [file join $sourcefolder vfs $vfstail] merge_over $sourcevfs $targetvfs + #G-125 boot-precondition gate. A kit with no tcl library cannot initialise + #at all - 'Cannot find a usable init.tcl' - so refuse it HERE: before any + #build product is written, and long before the deploy step deletes the + #previously working bin/ and copies the new one over it. The check is + #on the MERGED tree rather than on whether extraction ran, because a .vfs + #that supplies its own tcl library is legitimate and must keep building + #(src/vfs/punk8_statictwapi.vfs and punk9test.vfs are such folders today). + #Structural and non-executing, so it also covers cross-target kits, which + #this host could never run. + lassign [::punkboot::get_vfs_boot_library_report $targetvfs] bootcheck_available bootcheck + if {!$bootcheck_available} { + puts stderr "NOTE: kit boot-precondition check unavailable (punkboot::utils vfs_boot_library_report not loadable from bootsupport) - continuing without it" + } elseif {![dict get $bootcheck ok]} { + if {$extraction_done} { + #extract_kit_type is only recorded by some of the extraction branches + set extractedas [expr {$extract_kit_type ne "" ? " (as $extract_kit_type)" : ""}] + set gatecause "extraction from runtime $runtime_fullname$extractedas ran but supplied no tcl library, and src/vfs/$vfstail does not supply one either" + } else { + set gatecause "nothing was extracted from runtime $runtime_fullname (tried: $extraction_tried) and src/vfs/$vfstail does not supply a tcl library" + } + set failmsg "kit cannot initialise - $gatecause. Checked [join [dict get $bootcheck checked] { and }] in the merged vfs; [dict get $bootcheck reason]. NOT BUILT and NOT DEPLOYED: any previously deployed $targetkit is untouched" + puts stderr "boot-precondition gate FAILED for kit $targetkit - refusing to build an artifact that cannot initialise" + puts stderr " $gatecause" + lappend failed_kits [list kit $targetkit reason $failmsg] + $vfs_event targetset_end FAILED + $vfs_event destroy + $vfs_installer destroy + continue + } + set wrapvfs $targetvfs switch -- $target_kit_type { zip { 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 68653cf4..4c119425 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 @@ -2281,6 +2281,12 @@ DIAGRAM 2 - KIT ASSEMBLY DETAIL (the 'make.tcl bake' stage; incl. vfslibs phase) | copy common, then merge overlay over it v src/_build/.exe.vfs + | + | boot-precondition gate: merged vfs must supply a tcl + | library (tcl_library/ or lib/tcl./) [K10] + v + (gate) --> refused: kit listed under FAILED KITS, nothing + | built, nothing deployed, bin/ untouched | | zip image appended to the runtime exe: tcl::zipfs::mkimg, | or (driving tcl without zipfs, e.g 8.6) raw-runtime split @@ -2354,6 +2360,21 @@ KEY / NOTES 'make.tcl check' prints the derivation; 'make.tcl bakelist' shows per-kit targets, with a target= note on rows that are not on the default target. +[K10] BOOT-PRECONDITION gate (G-125). A kit whose merged vfs has no tcl library + cannot initialise at all ('Cannot find a usable init.tcl'), so the bake + refuses it: the kit is listed under FAILED KITS and NOTHING is written - + no src/_build/, no deploy, and the previously deployed bin/ is + left exactly as it was. This is deliberately not a warning: the deploy step + deletes the old kit before copying the new one, so warning-and-proceeding + replaced a working shell with one that could not start. The check is + structural (tcl_library/init.tcl or lib/tcl./init.tcl, plus a + companion file so a package's own init.tcl cannot answer for a tcl library) + and runs on the MERGED tree, not on whether extraction ran - a .vfs that + supplies its own tcl library builds and deploys as normal. Nothing is + executed, so cross-target kits are covered too. Usual cause: the runtime's + own payload could not be extracted - see the BUILD-WARNING naming what was + tried. 'make.tcl check' reports whether the gate is ACTIVE. + MAINTENANCE (agents take note) ---------------------------------------------------------------------------- This text is embedded in make.tcl (::punkboot::workflow_text). When the build @@ -3264,6 +3285,21 @@ proc ::punkboot::get_src_provenance_warnings {projectroot label} { set checked_vcs_roots [dict create] return [list 1 [::punkboot::utils::vcs_dirty_warnings $projectroot checked_vcs_roots $label src]] } +#Availability probe + boot-precondition check of an assembled kit vfs (G-125), shared by the +#kit gate in the bake loop and the 'check' command report. Same guarded-require treatment as +#the provenance check above: a stale or missing punkboot::utils snapshot must not brick the +#commands used to repair it, so an unavailable check degrades to a notice rather than failing +#every kit. Returns {available report}. +proc ::punkboot::get_vfs_boot_library_report {vfsfolder} { + set available [expr {\ + ![catch {package require punkboot::utils}]\ + && [llength [info commands ::punkboot::utils::vfs_boot_library_report]]\ + }] + if {!$available} { + return [list 0 [dict create]] + } + return [list 1 [::punkboot::utils::vfs_boot_library_report $vfsfolder]] +} #Wrap ::exit so accumulated provenance warnings are recapped at the very end of output no matter #which of make.tcl's many exit points a command takes. if {![llength [info commands ::punkboot::exit_original]]} { @@ -3506,6 +3542,19 @@ if {$::punkboot::command eq "check"} { puts stdout " build/promotion commands (project packages modules libs vfs vfslibs bin bootsupport vfscommonupdate) will WARN as above and proceed." puts stdout " With -dirty-abort they would abort. To evaluate uncommitted source without building, use ' src' or ' src shell'." } + # Kit boot-precondition gate status - whether a bake can refuse an unbootable kit + puts stdout $sep + #availability probe only - the path deliberately does not exist + lassign [::punkboot::get_vfs_boot_library_report [file join $projectroot __punkboot_bootgate_probe__]] _boot_available _boot_report + if {$_boot_available} { + puts stdout "boot-precondition gate (G-125): ACTIVE" + puts stdout " bake checks each kit's merged vfs for a tcl library (tcl_library/ or lib/tcl./) before" + puts stdout " building it. A kit with none is reported under FAILED KITS and is neither built nor deployed, so a" + puts stdout " previously deployed kit is never replaced by an artifact that cannot initialise." + } else { + puts stdout "boot-precondition gate (G-125): UNAVAILABLE (punkboot::utils vfs_boot_library_report not loadable from bootsupport)" + puts stdout " bake will proceed with a NOTE and cannot refuse an unbootable kit - run 'make.tcl modules' then 'make.tcl bootsupport'." + } puts stdout $sep exit 0 } @@ -6047,13 +6096,15 @@ foreach vfstail $vfs_tails { } } ;#end while !$extraction_done && [llength $extraction_trylist] + set extraction_tried "$target_kit_type[expr {[llength $source_kit_caps] ? " + runtime caps $source_kit_caps" : ""}]" if {!$extraction_done} { #TODO: if not extracted - use a default tcl_library for patchlevel and platform? - #Recapped BUILD-WARNING (not just an inline note): the build continues - #and produces an artifact, but unless the .vfs itself supplies a - #tcl_library that artifact cannot boot - and this line would otherwise - #scroll away behind thousands of merge lines. - ::punkboot::print_build_warnings [list "No extraction done from runtime $runtime_fullname (tried: $target_kit_type[expr {[llength $source_kit_caps] ? " + runtime caps $source_kit_caps" : ""}]) - kit $targetkit gets no tcl_library from the runtime and will not initialise unless src/vfs/$vfstail supplies one"] + #Recapped BUILD-WARNING (not just an inline note): this line would + #otherwise scroll away behind thousands of merge lines. It is a warning + #rather than the failure itself because a .vfs that supplies its own tcl + #library needs no extraction - the G-125 gate below decides, on the + #merged tree, whether this kit can initialise. + ::punkboot::print_build_warnings [list "No extraction done from runtime $runtime_fullname (tried: $extraction_tried) - kit $targetkit gets no tcl library from the runtime, so it will FAIL the boot-precondition gate unless src/vfs/$vfstail supplies one"] file mkdir $targetvfs } @@ -6111,6 +6162,36 @@ foreach vfstail $vfs_tails { set sourcevfs [file join $sourcefolder vfs $vfstail] merge_over $sourcevfs $targetvfs + #G-125 boot-precondition gate. A kit with no tcl library cannot initialise + #at all - 'Cannot find a usable init.tcl' - so refuse it HERE: before any + #build product is written, and long before the deploy step deletes the + #previously working bin/ and copies the new one over it. The check is + #on the MERGED tree rather than on whether extraction ran, because a .vfs + #that supplies its own tcl library is legitimate and must keep building + #(src/vfs/punk8_statictwapi.vfs and punk9test.vfs are such folders today). + #Structural and non-executing, so it also covers cross-target kits, which + #this host could never run. + lassign [::punkboot::get_vfs_boot_library_report $targetvfs] bootcheck_available bootcheck + if {!$bootcheck_available} { + puts stderr "NOTE: kit boot-precondition check unavailable (punkboot::utils vfs_boot_library_report not loadable from bootsupport) - continuing without it" + } elseif {![dict get $bootcheck ok]} { + if {$extraction_done} { + #extract_kit_type is only recorded by some of the extraction branches + set extractedas [expr {$extract_kit_type ne "" ? " (as $extract_kit_type)" : ""}] + set gatecause "extraction from runtime $runtime_fullname$extractedas ran but supplied no tcl library, and src/vfs/$vfstail does not supply one either" + } else { + set gatecause "nothing was extracted from runtime $runtime_fullname (tried: $extraction_tried) and src/vfs/$vfstail does not supply a tcl library" + } + set failmsg "kit cannot initialise - $gatecause. Checked [join [dict get $bootcheck checked] { and }] in the merged vfs; [dict get $bootcheck reason]. NOT BUILT and NOT DEPLOYED: any previously deployed $targetkit is untouched" + puts stderr "boot-precondition gate FAILED for kit $targetkit - refusing to build an artifact that cannot initialise" + puts stderr " $gatecause" + lappend failed_kits [list kit $targetkit reason $failmsg] + $vfs_event targetset_end FAILED + $vfs_event destroy + $vfs_installer destroy + continue + } + set wrapvfs $targetvfs switch -- $target_kit_type { zip { diff --git a/src/vfs/_vfscommon.vfs/modules/punk/mix/templates-0.2.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/mix/templates-0.2.0.tm index 5b144e73..c855a8b2 100644 Binary files a/src/vfs/_vfscommon.vfs/modules/punk/mix/templates-0.2.0.tm and b/src/vfs/_vfscommon.vfs/modules/punk/mix/templates-0.2.0.tm differ diff --git a/src/vfs/_vfscommon.vfs/modules/punkboot/utils-0.2.0.tm b/src/vfs/_vfscommon.vfs/modules/punkboot/utils-0.3.0.tm similarity index 66% rename from src/vfs/_vfscommon.vfs/modules/punkboot/utils-0.2.0.tm rename to src/vfs/_vfscommon.vfs/modules/punkboot/utils-0.3.0.tm index 736f28f8..133378da 100644 --- a/src/vfs/_vfscommon.vfs/modules/punkboot/utils-0.2.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punkboot/utils-0.3.0.tm @@ -7,7 +7,7 @@ # (C) 2023 # # @@ Meta Begin -# Application punkboot::utils 0.2.0 +# Application punkboot::utils 0.3.0 # Meta platform tcl # Meta license BSD # @@ Meta End @@ -23,7 +23,7 @@ package require Tcl 8.6- # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ namespace eval punkboot::utils { variable version 0.1.0 - namespace export parse_punkproject_version read_punkproject_version read_changelog_latest_version vcs_dirty_warnings + namespace export parse_punkproject_version read_punkproject_version read_changelog_latest_version vcs_dirty_warnings vfs_boot_library_report namespace eval argdoc { @@ -227,6 +227,103 @@ namespace eval punkboot::utils { } return $warnings } + + + #Companion files of a real Tcl library directory. init.tcl sources these, so a + #directory holding init.tcl with none of them beside it is a package's own init + #script (lib/BWidget1.10.1/init.tcl and friends), not a tcl library. + variable boot_library_companions {tm.tcl package.tcl auto.tcl clock.tcl history.tcl word.tcl} + + namespace eval argdoc { + lappend PUNKARGS [list { + @id -id ::punkboot::utils::vfs_boot_library_report + @cmd -name "::punkboot::utils::vfs_boot_library_report"\ + -summary\ + "Report whether an assembled vfs tree can supply a bootable tcl library"\ + -help\ + "Structural check of a merged .vfs tree for the precondition a kit + needs to initialise at all: a Tcl library the runtime can find. Reads + the directory only - nothing is executed, decompressed or launched, so + a caller such as make.tcl can run it for every kit on every bake and + for a cross-target kit it could never run itself. + + Two conventions are recognised, both observed in this project's kits: + tcl_library/ zipfs-attached kits (tclZipfs looks for + /tcl_library/init.tcl) + lib/tcl./ starkit/tclkit-style kits (lib/tcl8.6, + lib/tcl9.0) + + A candidate directory qualifies only when it holds init.tcl AND at + least one companion file a real Tcl library carries beside it + (tm.tcl, package.tcl, auto.tcl, clock.tcl, history.tcl, word.tcl) or + an encoding/ subdirectory. Without that second test a package's own + init script - lib/BWidget1.10.1/init.tcl, present in every punkshell + kit - would answer for a tcl library it cannot provide. + + Returned dict keys: + ok 1 when at least one qualifying library was found + locations qualifying directories, relative to vfsfolder + rejected candidate directories that held init.tcl but no + companion, relative to vfsfolder - the near-misses + worth naming when a gate fires unexpectedly + checked the location patterns examined, relative to vfsfolder + reason why ok is 0; empty string when ok is 1" + @leaders + vfsfolder -type string -optional 0 -help\ + "Path of the assembled vfs tree to inspect" + }] + } + proc vfs_boot_library_report {vfsfolder} { + variable boot_library_companions + set checked [list tcl_library lib/tcl.] + set report [dict create ok 0 locations {} rejected {} checked $checked reason ""] + if {![file isdirectory $vfsfolder]} { + dict set report reason "no such directory: $vfsfolder" + return $report + } + #candidates are the two conventions only - a full tree walk would find every + #package's init.tcl and cost more than the check is worth + set candidates [list [file join $vfsfolder tcl_library]] + foreach dir [lsort [glob -nocomplain -type d -directory [file join $vfsfolder lib] -- {tcl[0-9]*}]] { + lappend candidates $dir + } + set locations [list] + set rejected [list] + foreach dir $candidates { + if {![file isfile [file join $dir init.tcl]]} { + continue + } + set qualifies 0 + foreach companion $boot_library_companions { + if {[file isfile [file join $dir $companion]]} { + set qualifies 1 + break + } + } + if {!$qualifies && [file isdirectory [file join $dir encoding]]} { + set qualifies 1 + } + set rel [string range $dir [expr {[string length $vfsfolder] + 1}] end] + if {$qualifies} { + lappend locations $rel + } else { + lappend rejected $rel + } + } + if {[llength $locations]} { + dict set report ok 1 + dict set report locations $locations + dict set report rejected $rejected + return $report + } + dict set report rejected $rejected + if {[llength $rejected]} { + dict set report reason "no tcl library in [file tail $vfsfolder]: [join $rejected {, }] hold init.tcl but none of the companion files a tcl library carries beside it ([join $boot_library_companions {, }]) nor an encoding/ directory" + } else { + dict set report reason "no tcl library in [file tail $vfsfolder]: neither tcl_library/init.tcl nor lib/tcl./init.tcl is present" + } + return $report + } } namespace eval ::punk::args::register { @@ -237,8 +334,8 @@ namespace eval ::punk::args::register { ## Ready package provide punkboot::utils [tcl::namespace::eval punkboot::utils { variable version - #- this version number, exactly 0.2.0, is a literal used in src module folders + #- this version number, exactly 0.3.0, is a literal used in src module folders #- we refer to this sometimes as the magic version number - set version 0.2.0 + set version 0.3.0 }] return