From db08369654da64aba46a62f98da9327d8f23fe43 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Tue, 21 Jul 2026 04:38:48 +1000 Subject: [PATCH] make.tcl vfscommonupdate outputs: punkcheck 0.6.0, punk::lib 0.5.1, cli 0.5.1 into _vfscommon; project 0.17.5 Batched punkcheck-managed build outputs. All mapped kits rebuilt and redeployed against the refreshed _vfscommon (punkbi punksys punk86 punk91 punk905 punk902z) - shipped kits now preload punkcheck 0.6.0 (G-095 lock protocol) and punk::lib 0.5.1. Verification: rebuilt punk86 (8.6.17) runs the punkcheck subtree + compat suites 136 pass / 2 gated skips / 0 fail via runtests - including the child-process concurrency tests that need the kit's preloaded punkcheck to carry the lock API. Native Tcl 9.0.3 and 8.6.17 punkcheck subtrees re-verified 84/84. punk905/punksys sanity-probed (punkcheck 0.6.0 + lock API present). punkproject.toml 0.17.5 + CHANGELOG entry. Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com --- CHANGELOG.md | 5 + punkproject.toml | 2 +- .../punk/{lib-0.5.0.tm => lib-0.5.1.tm} | 25 +- .../punk/mix/{cli-0.5.0.tm => cli-0.5.1.tm} | 39 +- ...{punkcheck-0.4.0.tm => punkcheck-0.6.0.tm} | 1256 ++++++++++------- 5 files changed, 779 insertions(+), 548 deletions(-) rename src/vfs/_vfscommon.vfs/modules/punk/{lib-0.5.0.tm => lib-0.5.1.tm} (99%) rename src/vfs/_vfscommon.vfs/modules/punk/mix/{cli-0.5.0.tm => cli-0.5.1.tm} (96%) rename src/vfs/_vfscommon.vfs/modules/{punkcheck-0.4.0.tm => punkcheck-0.6.0.tm} (69%) diff --git a/CHANGELOG.md b/CHANGELOG.md index 9f46a805..c3d12009 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,11 @@ 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.17.5] - 2026-07-21 + +- punk86 kit restored to the build: mapped in `src/runtime/mapvfs.config` as tclkit-win64-dyn-8617 (Tcl 8.6.17) + punk8win.vfs, replacing the unmapped tclkit8613-era build whose fossilized kit-stamped `punk::args` 0.1.0 broke runtests under the kit ("invalid command name punk::args::define" - a stale registration satisfies an unversioned require, so `package unknown` never scans the modern paths). All kits rebuilt after a `vfscommonupdate`, so shipped kits now carry punkcheck 0.6.0 (G-095 lock protocol) and punk::lib 0.5.1. +- runtests hardening (test tooling, rides this release): the runner's own requires are version-floored (`punk::args 0.12-`, `punk::lib 0.5.1-`, punk::path already floored) - the floors alone resurrect even the old fossilized kit; punkcheck's concurrency suite floors its child-side require so a stale kit host fails loud instead of mysteriously. + ## [0.17.4] - 2026-07-21 - punk::lib 0.5.1: `punk::lib::compat::lpop` now matches the 8.7/9 builtin exactly on error paths too - out-of-range errors use the builtin's message and `{TCL VALUE INDEX OUTOFRANGE}` errorcode (previously a nonstandard `tcl_lpop ...` message), and variable-access failures (unset variable, whole-array name, missing array element) reproduce the builtin's message and errorcode naming the caller's variable. Validated by a differential parity matrix against the real builtin, pinned in the punk::lib compat testsuite; no known divergence remains (8.6's index parser already accepts TIP-176 `M+N` arithmetic). diff --git a/punkproject.toml b/punkproject.toml index 388d41f3..e0155b4b 100644 --- a/punkproject.toml +++ b/punkproject.toml @@ -1,4 +1,4 @@ [project] name = "punkshell" -version = "0.17.4" +version = "0.17.5" license = "BSD-2-Clause" diff --git a/src/vfs/_vfscommon.vfs/modules/punk/lib-0.5.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/lib-0.5.1.tm similarity index 99% rename from src/vfs/_vfscommon.vfs/modules/punk/lib-0.5.0.tm rename to src/vfs/_vfscommon.vfs/modules/punk/lib-0.5.1.tm index 24576228..7013a8e5 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/lib-0.5.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/lib-0.5.1.tm @@ -8,7 +8,7 @@ # (C) 2024 # # @@ Meta Begin -# Application punk::lib 0.5.0 +# Application punk::lib 0.5.1 # Meta platform tcl # Meta license BSD # @@ Meta End @@ -18,7 +18,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_punk::lib 0 0.5.0] +#[manpage_begin punkshell_module_punk::lib 0 0.5.1] #[copyright "2024"] #[titledesc {punk general utility functions}] [comment {-- Name section and table of contents description --}] #[moddesc {punk library}] [comment {-- Description at end of page heading --}] @@ -295,7 +295,7 @@ tcl::namespace::eval punk::lib::check { if {$replversion eq ""} { #not loaded - determine what version would be provided, without loading it: #an unsatisfiable require triggers the package unknown scan (registering ifneeded - #scripts) then fails before any load (0.5.0 dev modules are alpha - below 999999). + #scripts) then fails before any load (0.5.1 dev modules are alpha - below 999999). catch {package require punk::repl 999999} set available [package versions punk::repl] if {[llength $available]} { @@ -613,9 +613,20 @@ tcl::namespace::eval punk::lib::compat { } proc lpop {lvar args} { #*** !doctools - #[call [fun lpop] [arg listvar] [opt {index}]] + #[call [fun lpop] [arg listvar] [opt {index ...}]] #[para] Forwards compatible lpop for versions 8.6 or less to support equivalent 8.7 lpop - #upvar $lvar l + #[para] Index forms come from the running Tcl's core index parser (lindex/lrange/lreplace), + #[para] which accepts the same integer?\[+-]integer? / end?\[+-]integer? grammar on 8.6 + #[para] (TIP 176) as 8.7/9. Behaviour - results, final list state, error messages and + #[para] errorcodes - matches the builtin; pinned by the compat testsuite (compat.test). + if {[catch {uplevel 1 [list ::set $lvar]} lreaderr lreadopts]} { + #variable access failed (unset variable, whole-array name, or missing array element). + #Probing with a plain read in the caller's frame - BEFORE creating the upvar link - + #reproduces the builtin's message and errorcode exactly (through a link, or once a link + #exists, the detail flattens: e.g 'no such variable' loses its TCL LOOKUP errorcode and + #a missing array element misreports as 'no such variable'). + return -code error -errorcode [dict get $lreadopts -errorcode] $lreaderr + } upvar 1 $lvar l if {![llength $args]} { set args [list end] @@ -628,7 +639,7 @@ tcl::namespace::eval punk::lib::compat { for {set i 0} {$i < [llength $args]} {incr i} { set idx [lindex $args $i] if {![llength [lrange $subl $idx $idx]]} { - error "tcl_lpop index \"$idx\" out of range" + return -code error -errorcode [list TCL VALUE INDEX OUTOFRANGE] "index \"$idx\" out of range" } lappend path [lindex $args $i] set subl [lindex $l {*}$path] @@ -9379,7 +9390,7 @@ namespace eval ::punk::args::register { package provide punk::lib [tcl::namespace::eval punk::lib { variable pkg punk::lib variable version - set version 0.5.0 + set version 0.5.1 }] return diff --git a/src/vfs/_vfscommon.vfs/modules/punk/mix/cli-0.5.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/mix/cli-0.5.1.tm similarity index 96% rename from src/vfs/_vfscommon.vfs/modules/punk/mix/cli-0.5.0.tm rename to src/vfs/_vfscommon.vfs/modules/punk/mix/cli-0.5.1.tm index 33627082..325f4f07 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/mix/cli-0.5.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/mix/cli-0.5.1.tm @@ -7,7 +7,7 @@ # (C) 2023 # # @@ Meta Begin -# Application punk::mix::cli 0.5.0 +# Application punk::mix::cli 0.5.1 # Meta platform tcl # Meta license # @@ Meta End @@ -772,7 +772,6 @@ namespace eval punk::mix::cli { -glob $fileglob -max-depth 0 }] - #lassign [punkcheck::start_installer_event $punkcheck_file $installername $srcdir $basedir $config] _eventid punkcheck_eventid _recordset record_list # -- --- set installer [punkcheck::installtrack new $installername $punkcheck_file] #set installer [punkcheck::installtrack new $installername $punkcheck_file stderr] ;#with debugchannel @@ -990,7 +989,6 @@ namespace eval punk::mix::cli { } else { puts -nonewline stderr "Z" set did_skip 1 - #set file_record [punkcheck::installfile_skipped_install $basedir $file_record] $build_event targetset_end SKIPPED } $build_event destroy @@ -1180,7 +1178,6 @@ namespace eval punk::mix::cli { } else { puts -nonewline stderr "T" set did_skip 1 - #set file_record [punkcheck::installfile_skipped_install $basedir $file_record] $build_event targetset_end SKIPPED } $build_event destroy @@ -1293,9 +1290,6 @@ namespace eval punk::mix::cli { } #------------------------------ - # - #set target_relpath [punkcheck::lib::path_relative $basedir $target_module_dir/$basename-$module_build_version.tm] - #set file_record [punkcheck::installfile_begin $basedir $target_relpath $installername -eventid $punkcheck_eventid] $event targetset_init INSTALL $target_module_dir/$basename-$module_build_version.tm $event targetset_addsource $versionfile $event targetset_addsource $current_source_dir/$m @@ -1306,24 +1300,11 @@ namespace eval punk::mix::cli { $event targetset_addsource_virtual module_version $module_build_version } - #set changed_list [list] - ## -- --- --- --- --- --- - #set source_relpath [punkcheck::lib::path_relative $basedir $versionfile] - #set file_record [punkcheck::installfile_add_source_and_fetch_metadata $basedir $source_relpath $file_record] - ## -- --- --- --- --- --- - #set source_relpath [punkcheck::lib::path_relative $basedir $current_source_dir/$m] - #set file_record [punkcheck::installfile_add_source_and_fetch_metadata $basedir $source_relpath $file_record] - ## -- --- --- --- --- --- - #set changed_unchanged [punkcheck::recordlist::file_install_record_source_changes [lindex [dict get $file_record body] end]] - #set changed_list [dict get $changed_unchanged changed] - - if {\ [llength [dict get [$event targetset_source_changes] changed]]\ || [llength [$event get_targets_exist]] < [llength [$event get_targets]]\ } { - #set file_record [punkcheck::installfile_started_install $basedir $file_record] $event targetset_started # -- --- --- --- --- --- set target $target_module_dir/$basename-$module_build_version.tm @@ -1338,7 +1319,6 @@ namespace eval punk::mix::cli { #file copy -force $srcdir/$m $target lappend module_list $target # -- --- --- --- --- --- - #set file_record [punkcheck::installfile_finished_install $basedir $file_record] $event targetset_end OK } else { if {$is_interesting} { @@ -1346,7 +1326,6 @@ namespace eval punk::mix::cli { } puts -nonewline stderr "m" set did_skip 1 - #set file_record [punkcheck::installfile_skipped_install $basedir $file_record] $event targetset_end SKIPPED } prune_superseded_target_modules $event $basedir $target_module_dir $basename $module_build_version @@ -1358,17 +1337,6 @@ namespace eval punk::mix::cli { continue } ##------------------------------ - ## - #set target_relpath [punkcheck::lib::path_relative $basedir $target_module_dir/$m] - #set file_record [punkcheck::installfile_begin $basedir $target_relpath $installername -eventid $punkcheck_eventid] - #set changed_list [list] - ## -- --- --- --- --- --- - #set source_relpath [punkcheck::lib::path_relative $basedir $current_source_dir/$m] - #set file_record [punkcheck::installfile_add_source_and_fetch_metadata $basedir $source_relpath $file_record] - ## -- --- --- --- --- --- - #set changed_unchanged [punkcheck::recordlist::file_install_record_source_changes [lindex [dict get $file_record body] end]] - #set changed_list [dict get $changed_unchanged changed] - #---------- $event targetset_init INSTALL $target_module_dir/$m $event targetset_addsource $current_source_dir/$m catch { @@ -1382,7 +1350,6 @@ namespace eval punk::mix::cli { || [llength [$event get_targets_exist]] < [llength [$event get_targets]]\ } { - #set file_record [punkcheck::installfile_started_install $basedir $file_record] $event targetset_started # -- --- --- --- --- --- if {$did_skip} {set did_skip 0; puts -nonewline stdout \n} @@ -1390,7 +1357,6 @@ namespace eval punk::mix::cli { file copy -force $current_source_dir/$m $target_module_dir puts stderr "Copied already versioned module $current_source_dir/$m to $target_module_dir" # -- --- --- --- --- --- - #set file_record [punkcheck::installfile_finished_install $basedir $file_record] $event targetset_end OK -note "already versioned module" } else { puts -nonewline stderr "f" @@ -1398,7 +1364,6 @@ namespace eval punk::mix::cli { if {$is_interesting} { puts stderr "$current_source_dir/$m [$event targetset_source_changes]" } - #set file_record [punkcheck::installfile_skipped_install $basedir $file_record] $event targetset_end SKIPPED } prune_superseded_target_modules $event $basedir $target_module_dir $basename $tmfile_versionsegment @@ -1687,6 +1652,6 @@ namespace eval punk::mix::cli { ## Ready package provide punk::mix::cli [namespace eval punk::mix::cli { variable version - set version 0.5.0 + set version 0.5.1 }] return diff --git a/src/vfs/_vfscommon.vfs/modules/punkcheck-0.4.0.tm b/src/vfs/_vfscommon.vfs/modules/punkcheck-0.6.0.tm similarity index 69% rename from src/vfs/_vfscommon.vfs/modules/punkcheck-0.4.0.tm rename to src/vfs/_vfscommon.vfs/modules/punkcheck-0.6.0.tm index b080aebe..e1839e8b 100644 --- a/src/vfs/_vfscommon.vfs/modules/punkcheck-0.4.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punkcheck-0.6.0.tm @@ -73,7 +73,8 @@ namespace eval punkcheck { proc default_excludefiletail_core {} { variable default_excludefiletail_core if {$default_excludefiletail_core eq ""} { - set default_excludefiletail_core [list "*.swp" "*[punk::mix::util::tm_version_magic]*" "*-buildversion.txt" ".punkcheck"] + #.punkcheck.* covers the G-095 protocol siblings (.punkcheck.lock, .punkcheck.tmp.) + set default_excludefiletail_core [list "*.swp" "*[punk::mix::util::tm_version_magic]*" "*-buildversion.txt" ".punkcheck" ".punkcheck.*"] } return $default_excludefiletail_core } @@ -82,7 +83,25 @@ namespace eval punkcheck { proc load_records_from_file {punkcheck_file} { set record_list [list] if {[file exists $punkcheck_file]} { - set tdlscript [punk::mix::util::fcat $punkcheck_file] + #G-095: the atomic-rename save keeps content untorn, but on Windows a reader's open can + #transiently be denied while a writer's MoveFileEx replace is in flight - retry the read + #with backoff. Parse errors stay strict (they indicate real corruption, never a race). + set backoff 10 + set deadline [expr {[clock milliseconds] + 2000}] + while {1} { + if {![catch {punk::mix::util::fcat $punkcheck_file} tdlscript]} { + break + } + if {![file exists $punkcheck_file]} { + #genuinely deleted between our checks - same as never present + return $record_list + } + if {[clock milliseconds] >= $deadline} { + error "punkcheck::load_records_from_file failed to read '$punkcheck_file'\n error:$tdlscript" + } + after $backoff + set backoff [expr {min($backoff * 2,100)}] + } if {[catch { set record_list [punk::tdl::prettyparse $tdlscript] } errparse]} { @@ -98,65 +117,269 @@ namespace eval punkcheck { if {$debugchannel ne "" && $trigger ne ""} { puts $debugchannel "\x1b\[36mSaving [llength $recordlist] records as $linecount lines to file '$punkcheck_file' trigger: \x1b\[32m$trigger\x1b\[m" } - #puts stdout $newtdl - set fd [open $punkcheck_file w] + #G-095: write-temp-then-atomic-rename so readers never observe torn content. + #The temp file lives in the same directory (same volume) as the target; the rename is retried + #with backoff for Windows sharing violations (a concurrent reader holding the target open). + set tmpfile "${punkcheck_file}.tmp.[pid]" + set fd [open $tmpfile w] chan configure $fd -translation binary puts -nonewline $fd $newtdl flush $fd close $fd + set renamed 0 + set backoff 20 + set deadline [expr {[clock milliseconds] + 2000}] + while {1} { + if {![catch {file rename -force -- $tmpfile $punkcheck_file} errRename]} { + set renamed 1 + break + } + if {[clock milliseconds] >= $deadline} { + break + } + after $backoff + set backoff [expr {min($backoff * 2,250)}] + } + if {!$renamed} { + catch {file delete -- $tmpfile} + error "punkcheck::save_records_to_file failed to atomically replace '$punkcheck_file' (trigger: $trigger) - last rename error: $errRename" + } + #hygiene: clear abandoned temp files from crashed/killed writers (age-gated; own pattern only) + foreach leftover [glob -nocomplain -types f -- "${punkcheck_file}.tmp.*"] { + if {![catch {file mtime $leftover} lmt] && ([clock seconds] - $lmt) > 600} { + catch {file delete -- $leftover} + } + } return [list recordcount [llength $recordlist] linecount $linecount] } + #----------------------------------------------- + #G-095 advisory lockfile protocol: serializes whole installer events per punkcheck root. + #Cross-platform primitive: open {WRONLY CREAT EXCL} is an atomic create-new on Windows and + #POSIX under Tcl 8.6 and 9 with no extra packages. The holder keeps the channel open for the + #lock's duration (on Windows an open handle also resists deletion by other processes). + #In-process re-acquisition is reference-counted: sequential installtrack instances over one + #.punkcheck file in one process are an established make.tcl pattern and must not self-deadlock. + #The lock is advisory - readers (punkcheck::cli status, load_records_from_file) never take it; + #their torn-read immunity comes from the atomic rename in save_records_to_file. + namespace eval lock { + namespace path ::punkcheck + variable held + if {![info exists held]} { + set held [dict create] ;#normalized lockfile path -> dict {channel refcount } + } + + namespace eval argdoc { + lappend PUNKARGS [list { + @id -id ::punkcheck::lock::acquire + @cmd -name "punkcheck::lock::acquire"\ + -summary\ + "Acquire the advisory event lock for a punkcheck file."\ + -help\ + "Acquires the advisory sibling lockfile .lock via an atomic + create-new open, serializing whole installer events per punkcheck root + across processes. The holder identity (pid/host/installer/timestamp) is + written into the lockfile and the channel is held open for the lock's + duration. In-process re-acquisition is reference-counted. + On contention the acquisition retries with backoff until -timeout, breaking + stale locks early (provably-dead holder pid on this host when a liveness + capability is present, or lockfile age beyond -staleage), then errors with + errorcode {PUNKCHECK LOCK TIMEOUT } naming the holder. + Returns a token for punkcheck::lock::release. + The lock is advisory: readers never take it (torn-read immunity comes from + the atomic-rename save)." + @leaders -min 1 -max 1 + punkcheck_file -type file -help\ + "Path of the .punkcheck file whose sibling lockfile governs the root." + @opts + -timeout -type integer -help\ + "Milliseconds to keep retrying on contention before erroring. + Default 15000, or env(PUNKCHECK_LOCK_TIMEOUT) when set." + -staleage -type integer -help\ + "Seconds beyond which a contended lockfile is broken on age alone. + Default 300, or env(PUNKCHECK_LOCK_STALEAGE) when set." + -installer -type string -default "" -help\ + "Holder identity recorded in the lockfile contents." + -warnchannel -type string -default stderr -help\ + "Channel receiving stale-break warnings." + }] + lappend PUNKARGS [list { + @id -id ::punkcheck::lock::release + @cmd -name "punkcheck::lock::release"\ + -summary\ + "Release a token from punkcheck::lock::acquire."\ + -help\ + "Reference-counted: the lockfile channel is closed and the file deleted when + the in-process count reaches zero. Unknown tokens return 0 (idempotent for + cleanup paths); handled tokens return 1." + @values -min 1 -max 1 + token -type string -help\ + "Token returned by punkcheck::lock::acquire." + }] + } + + #acquire the advisory event lock for a punkcheck file. Returns a token for release. + # -timeout ms to keep retrying on contention before erroring (names the holder) + # -staleage seconds after which a contended lockfile is broken on age alone + # -installer holder identity recorded in the lockfile contents + #env overrides PUNKCHECK_LOCK_TIMEOUT / PUNKCHECK_LOCK_STALEAGE apply when options are not passed. + proc acquire {punkcheck_file args} { + variable held + set default_timeout 15000 + set default_staleage 300 + if {[info exists ::env(PUNKCHECK_LOCK_TIMEOUT)] && [string is integer -strict $::env(PUNKCHECK_LOCK_TIMEOUT)]} { + set default_timeout $::env(PUNKCHECK_LOCK_TIMEOUT) + } + if {[info exists ::env(PUNKCHECK_LOCK_STALEAGE)] && [string is integer -strict $::env(PUNKCHECK_LOCK_STALEAGE)]} { + set default_staleage $::env(PUNKCHECK_LOCK_STALEAGE) + } + set defaults [dict create -timeout $default_timeout -staleage $default_staleage -installer "" -warnchannel stderr] + if {[llength $args] % 2} { + error "punkcheck::lock::acquire arguments after punkcheck_file must be -flag value pairs. known flags: [dict keys $defaults]" + } + foreach {k v} $args { + if {$k ni [dict keys $defaults]} { + error "punkcheck::lock::acquire unrecognised flag '$k'. known flags: [dict keys $defaults]" + } + } + set opts [dict merge $defaults $args] + set timeout [dict get $opts -timeout] + set staleage [dict get $opts -staleage] + set installer [dict get $opts -installer] + set warnchannel [dict get $opts -warnchannel] + + set lockfile [file normalize "${punkcheck_file}.lock"] + if {[dict exists $held $lockfile]} { + #in-process re-acquisition (sequential or nested installers on one punkcheck root) + dict set held $lockfile refcount [expr {[dict get $held $lockfile refcount] + 1}] + return $lockfile + } + set deadline [expr {[clock milliseconds] + $timeout}] + set backoff 50 + while {1} { + if {![catch {open $lockfile {WRONLY CREAT EXCL}} fd]} { + chan configure $fd -translation lf + set holderinfo [dict create pid [pid] host [info hostname] installer $installer tsiso [clock format [clock seconds] -format "%Y-%m-%dT%H:%M:%S"] ts [clock microseconds]] + puts $fd $holderinfo + flush $fd + dict set held $lockfile [dict create channel $fd refcount 1] + return $lockfile + } + #contended - identify the holder (best effort: the file can vanish between the + #failed EXCL open and this read) + set holderinfo "" + catch { + set rfd [open $lockfile r] + set holderinfo [string trim [read $rfd]] + close $rfd + } + set holder_pid "" + set holder_host "" + if {[llength $holderinfo] % 2 == 0} { + set holder_pid [dict_getwithdefault $holderinfo pid ""] + set holder_host [dict_getwithdefault $holderinfo host ""] + } + set broke 0 + #liveness stale-break: holder recorded on this host and provably dead (capability-gated) + if {[string is integer -strict $holder_pid] && $holder_host eq [info hostname] && $holder_pid != [pid]} { + if {[pid_liveness $holder_pid] eq "dead"} { + catch {puts $warnchannel "punkcheck::lock warning: breaking stale lock '$lockfile' - holder pid $holder_pid on this host is no longer running (holder: $holderinfo)"} + catch {file delete -- $lockfile} + set broke 1 + } + } + if {!$broke} { + #age-based stale-break: the portable baseline + if {[catch {file mtime $lockfile} lockmtime]} { + #lockfile vanished since the failed open - retry immediately + set broke 1 + } elseif {([clock seconds] - $lockmtime) > $staleage} { + catch {puts $warnchannel "punkcheck::lock warning: breaking stale lock '$lockfile' - older than ${staleage}s (holder: $holderinfo)"} + catch {file delete -- $lockfile} + set broke 1 + } + } + if {!$broke} { + if {[clock milliseconds] >= $deadline} { + if {$holderinfo eq ""} { + set holderdesc "(holder unknown - lockfile unreadable)" + } else { + set holderdesc $holderinfo + } + return -code error -errorcode [list PUNKCHECK LOCK TIMEOUT $lockfile] "punkcheck::lock::acquire timeout after ${timeout}ms waiting for '$lockfile' held by: $holderdesc" + } + after $backoff + set backoff [expr {min($backoff * 2,500)}] + } + } + } + #release a token from acquire. Reference-counted; the lockfile is closed and deleted when + #the count reaches zero. Unknown tokens return 0 (idempotent for cleanup paths). + proc release {token} { + variable held + if {![dict exists $held $token]} { + return 0 + } + set refcount [expr {[dict get $held $token refcount] - 1}] + if {$refcount > 0} { + dict set held $token refcount $refcount + return 1 + } + catch {close [dict get $held $token channel]} + catch {file delete -- $token} + dict unset held $token + return 1 + } + #alive | dead | unknown for a pid on this host (capability-gated liveness) + proc pid_liveness {pid} { + if {"windows" eq $::tcl_platform(platform)} { + if {![catch {package require twapi}]} { + if {[catch {twapi::process_exists $pid} exists]} { + return unknown + } + return [expr {$exists ? "alive" : "dead"}] + } + return unknown + } else { + if {![catch {exec kill -0 $pid}]} { + return alive + } else { + #kill -0 errors for both nonexistent (No such process) and not-permitted (alive, + #other user) - only the former is a confident 'dead' + catch {exec kill -0 $pid} errkill + if {[string match -nocase "*no such process*" $errkill]} { + return dead + } + return unknown + } + } + } + } + - #todo - work out way to use same punkcheck file for multiple installers running concurrently. Thread? - #an installtrack objects represents an installation path from sourceroot to targetroot + #Concurrent multi-process writer safety (G-095) lives at the single save chokepoint (installtrack + #method save_working_recordset) and its callers: saves are write-temp-then-atomic-rename, whole + #installer events hold the advisory .punkcheck.lock (punkcheck::lock, start_event through end), + #deferred flushes merge own records into freshly-loaded file state, and an optimistic + #mtime/size tripwire warns when a non-protocol writer touched the file between load and save. + #an installtrack object represents an installation path from sourceroot to targetroot #The source and target folders should be as specific as possible but it is valid to specify for example c:/ -> c:/ (or / -> /) if source and targets within the installation operation are spread around. # + #Record lifecycle (G-094): the installtrack/installevent OO layer is the sole implementation of the + #.punkcheck record lifecycle (targetset init / add-source / started / end). Each event carries a + #persistence policy chosen at start_event: + # eager (default) - every non-QUERY targetset operation is an independent read-modify-write of the file + # deferred - targetset operations update the installtrack's in-memory working recordset only; + # the recordset is persisted by an explicit $installer flush (event-scoped save). + # An ended deferred event that was never flushed deliberately discards its updates + # (this is how -source-checksum compare mode avoids storing). + #QUERY operations are never persisted in either mode and never touch the working recordset. set objname [namespace current]::installtrack if {$objname ni [info commands $objname]} { package require oolib #FILEINFO record - target fileset with body records: INSTALL-RECORD,INSTALL-INPROGRESS,INSTALL-SKIPPED,DELETE-RECORD,DELETE-INPROGRESS,MODIFY-INPROGRESS,MODIFY-RECORD #each FILEINFO body being a list of SOURCE records - oo::class create targetset { - variable o_targets - variable o_keep_installrecords - variable o_keep_skipped - variable o_keep_inprogress - variable o_records - constructor {args} { - #set o_records [oolib::collection create [namespace current]::recordcollection] - set o_records [list] - - } - - method as_record {} { - dict create {*}{ - } tag FILEINFO {*}{ - } -targets $o_targets {*}{ - } -keep_installrecords $o_keep_installrecords {*}{ - } -keep_skipped $o_keep_skipped {*}{ - } -keep_inprogress $o_keep_inprogress {*}{ - } body $o_records {*}{ - } - } - - #retrieve last completed record for the fileset ie exclude SKIPPED,INSTALL-INPROGRESS,DELETE-INPROGRESS,MODIFY-INPROGRESS - method get_last_record {fileset_record} { - set body [dict_getwithdefault $fileset_record body [list]] - set previous_records [lrange $body 0 end-1] - #get last previous that is tagged INSTALL-RECORD,MODIFY-RECORD,DELETE-RECORD - set revlist [lreverse $previous_records] - foreach rec $revlist { - switch -- [dict get $rec tag] { - INSTALL-RECORD - MODIFY-RECORD - DELETE-RECORD - VIRTUAL-RECORD { - return $rec - } - } - } - return [list] - } - } #instances created by an installtrack object in method start_event #also in installtrack constructor - to represent existing events from the .punkcheck data @@ -175,6 +398,7 @@ namespace eval punkcheck { variable o_fileset_record variable o_installer ;#parent object variable o_debugchannel + variable o_persistence constructor {installer rel_sourceroot rel_targetroot args} { set o_installer $installer set o_debugchannel [$installer get_debugchannel] @@ -182,13 +406,18 @@ namespace eval punkcheck { set o_path_cksum_cache [dict create] set o_operation "" set defaults [dict create {*}{ - -id "" - -tsbegin "" - -config {} - -tsend "" - -types {} + -id "" + -tsbegin "" + -config {} + -tsend "" + -types {} + -persistence eager }] set opts [dict merge $defaults $args] + set o_persistence [dict get $opts -persistence] + if {$o_persistence ni [list eager deferred]} { + error "[self] constructor error: -persistence must be 'eager' or 'deferred'. Received '$o_persistence'" + } if {[dict get $opts -id] eq ""} { set o_id [punkcheck::uuid] } else { @@ -238,6 +467,12 @@ namespace eval punkcheck { method get_operation {} { return $o_operation } + method get_persistence {} { + return $o_persistence + } + method get_installer {} { + return $o_installer + } method get_targets {} { return $o_targets } @@ -251,12 +486,30 @@ namespace eval punkcheck { } method end {} { set o_ts_end [clock microseconds] + #notify parent so its active-event slot clears and a subsequent start_event is valid + $o_installer event_ended [self] } method targetset_dict {} { - punk::records_as_target_dict [$o_installer get_recordlist] + punkcheck::recordlist::records_as_target_dict [$o_installer get_recordlist] + } + #merge the event's current fileset record into the parent installtrack's working recordset + #(replace the record with matching -targets, or append when absent). The parent also + #records the targetlist as touched - the 'own records' set its merge-on-flush carries + #into freshly-loaded file state. + method MergeFilesetToWorking {} { + set record_list [$o_installer get_recordlist] + set targetlist [dict get $o_fileset_record -targets] + set oldrecordinfo [punkcheck::recordlist::get_file_record $targetlist $record_list] + set old_posn [dict get $oldrecordinfo position] + if {$old_posn == -1} { + lappend record_list $o_fileset_record + } else { + lset record_list $old_posn $o_fileset_record + } + $o_installer set_recordlist $record_list + $o_installer touched_target $targetlist } - #related - installfile_begin #call init before we know if we are going to run the operation vs skip method targetset_init {operation targetset} { set known_ops [list QUERY INSTALL MODIFY DELETE VIRTUAL] @@ -300,18 +553,34 @@ namespace eval punkcheck { set o_targets [lsort -dictionary -increasing $relativepath_targetset] ;#exact sort order not critical - but must be consistent + #working recordset acquisition per persistence policy: + # eager - refresh the parent installtrack's working recordset from the file (each op is an independent read-modify-write) + # deferred - the parent's in-memory working recordset is authoritative between flushes; no file access + # QUERY - reads the freshest available state but never touches the working recordset (never persisted) + if {$o_operation eq "QUERY"} { + if {$o_persistence eq "deferred"} { + set record_list [$o_installer get_recordlist] + } else { + set record_list [punkcheck::load_records_from_file $punkcheck_file] + } + } else { + if {$o_persistence eq "eager"} { + $o_installer load_all_records + } + set record_list [$o_installer get_recordlist] + } - set record_list [punkcheck::load_records_from_file $punkcheck_file] - - #--------------------------------------------------------------------------- - #load as dict to test for dupes - #set _targetdict [my targetset_dict] - if {[catch { - set _targetdict [punkcheck::recordlist::records_as_target_dict $record_list] - } errMsg]} { - error "targetset_init operation:$operation error verifying existing records from file $punkcheck_file. Error: $errMsg" + if {$o_persistence eq "eager"} { + #--------------------------------------------------------------------------- + #load as dict to test for dupes (skipped in deferred mode - per-op scan cost, and the + #pre-G-094 batch recordset handling this mode inherits from never ran it either) + if {[catch { + set _targetdict [punkcheck::recordlist::records_as_target_dict $record_list] + } errMsg]} { + error "targetset_init operation:$operation error verifying existing records from file $punkcheck_file. Error: $errMsg" + } + #--------------------------------------------------------------------------- } - #--------------------------------------------------------------------------- set extractioninfo [punkcheck::recordlist::extract_or_create_fileset_record $o_targets $record_list] set o_fileset_record [dict get $extractioninfo record] @@ -319,23 +588,28 @@ namespace eval punkcheck { set isnew [dict get $extractioninfo isnew] set oldposition [dict get $extractioninfo oldposition] unset extractioninfo + if {$isnew && $o_debugchannel ne ""} { + puts $o_debugchannel "punkcheck: no existing FILEINFO record for targetset '$o_targets' - creating" + } #INSTALL-INPROGRESS will become INSTALL-RECORD or INSTALL-FAILED or INSTALL-SKIPPED upon finalisation #-installer and -eventid keys are added here set new_inprogress_record [dict create tag [string toupper $operation]-INPROGRESS {*}$fields -tempcontext [my as_record] body {}] - #set existing_body [dict_getwithdefault $o_fileset_record body [list]] #todo - look for existing "-INPROGRESS" records - mark as failed or incomplete? dict lappend o_fileset_record body $new_inprogress_record - if {$isnew} { - lappend record_list $o_fileset_record - } else { - #set record_list [linsert $record_list[unset record_list] $oldposition $o_fileset_record] - ledit record_list $oldposition -1 $o_fileset_record - } - if {$o_operation ne "QUERY"} { - punkcheck::save_records_to_file $record_list $punkcheck_file "targetset_init $o_operation [llength $targetset] targets" + if {$o_operation ne "QUERY" && $o_persistence eq "eager"} { + #reinsert the inprogress-marked record and persist - crash evidence in the file during long operations + if {$isnew} { + lappend record_list $o_fileset_record + } else { + ledit record_list $oldposition -1 $o_fileset_record + } + $o_installer set_recordlist $record_list + $o_installer save_working_recordset "targetset_init $o_operation [llength $targetset] targets" } + #deferred: the *-INPROGRESS state stays event-local (o_fileset_record) - only finalized records + #reach the working recordset (targetset_end), mirroring the pre-G-094 batch recordset handling. return $o_fileset_record } @@ -343,28 +617,31 @@ namespace eval punkcheck { #todo - upgrade .punkcheck format to hold more than just list of SOURCE entries in each record. # - allow arbitrary targetset_startphase targetset_endphase calls to store timestamps and calculate elapsed time method targetset_started {} { - set punkcheck_folder [file dirname [$o_installer get_checkfile]] - if {$o_operation eq "QUERY"} { - set fileinfo_body [dict get $o_fileset_record body] ;#body of FILEINFO record - set installing_record [lindex $fileinfo_body end] + if {$o_operation_start_ts eq ""} { + error "[self] targetset_started - no current operation - call targetset_init first" + } + if {![punkcheck::lib::is_file_record_inprogress $o_fileset_record]} { + error "targetset_started error: bad fileset_record - expected FILEINFO with last body element *-INPROGRESS" + } + set fileinfo_body [dict get $o_fileset_record body] ;#body of FILEINFO record + set installing_record [lindex $fileinfo_body end] - set ts_start [dict get $installing_record -ts] - set ts_now [clock microseconds] - set metadata_us [expr {$ts_now - $ts_start}] + set ts_start [dict get $installing_record -ts] + set ts_now [clock microseconds] + set metadata_us [expr {$ts_now - $ts_start}] - #?? - #JJJ - #dict set installing_record -metadata_us $metadata_us - dict set installing_record -ts_start_transfer $ts_now + dict set installing_record -metadata_us $metadata_us + dict set installing_record -ts_start_transfer $ts_now - lset fileinfo_body end $installing_record + lset fileinfo_body end $installing_record + dict set o_fileset_record body $fileinfo_body - return [dict set o_fileset_record body $fileinfo_body] - } else { - #legacy call - #saves to .punkcheck file - return [set o_fileset_record [punkcheck::installfile_started_install $punkcheck_folder $o_fileset_record]] + if {$o_operation ne "QUERY" && $o_persistence eq "eager"} { + $o_installer load_all_records + my MergeFilesetToWorking + $o_installer save_working_recordset "targetset_started $o_operation [llength $o_targets] targets" } + return $o_fileset_record } method targetset_end {status args} { set defaults [dict create {*}{ @@ -400,7 +677,6 @@ namespace eval punkcheck { set installing_record [lindex $file_record_body end] set punkcheck_file [$o_installer get_checkfile] set punkcheck_folder [file dirname $punkcheck_file] - set record_list [punkcheck::load_records_from_file $punkcheck_file] if {[dict exists $installing_record -ts_start_transfer]} { set ts_start_transfer [dict get $installing_record -ts_start_transfer] set transfer_us [expr {$operation_end_ts - $ts_start_transfer}] @@ -434,15 +710,15 @@ namespace eval punkcheck { dict set o_fileset_record body $file_record_body set o_fileset_record [punkcheck::recordlist::file_record_prune $o_fileset_record] - set oldrecordinfo [punkcheck::recordlist::get_file_record $targetlist $record_list] - set old_posn [dict get $oldrecordinfo position] - if {$old_posn == -1} { - lappend record_list $o_fileset_record - } else { - lset record_list $old_posn $o_fileset_record - } if {$o_operation ne "QUERY"} { - punkcheck::save_records_to_file $record_list $punkcheck_file "targetset_end $o_operation $status [llength $o_targets] targets" + if {$o_persistence eq "eager"} { + $o_installer load_all_records + my MergeFilesetToWorking + $o_installer save_working_recordset "targetset_end $o_operation $status [llength $o_targets] targets" + } else { + #deferred - finalized record joins the in-memory working recordset; persisted at flush + my MergeFilesetToWorking + } } set o_operation_start_ts "" set o_operation "" @@ -530,9 +806,15 @@ namespace eval punkcheck { variable o_active_event variable o_events variable o_debugchannel + variable o_event_lock ;#advisory lock token while an event (or transient flush) holds it + variable o_touched_targets ;#targetlists this instance's events merged - the 'own records' set for merge-on-flush + variable o_load_sig ;#file signature {mtime size} at last load - optimistic tripwire vs non-protocol writers constructor {installername punkcheck_file {debugchannel ""}} { set o_debugchannel $debugchannel set o_active_event "" + set o_event_lock "" + set o_touched_targets [dict create] + set o_load_sig "" set o_name $installername set o_checkfile [file normalize $punkcheck_file] @@ -571,12 +853,22 @@ namespace eval punkcheck { } } if {$insane ne ""} { + if {![punkcheck::lib::stdin_is_interactive]} { + #G-095: unattended runs get a clean actionable error instead of a prompt + #that would block on open stdin or mis-answer on closed/piped stdin + set errmsg "punkcheck installtrack sanity check failed: punkcheck file '$o_checkfile' contains multiple INSTALLER records with -name '$insane'." + append errmsg \n "Likely cause: concurrent writers racing the file (writers predating the G-095 lock protocol) or an interrupted run." + append errmsg \n "Session is non-interactive - not prompting. Recovery: inspect the file, or delete it and rerun." + append errmsg \n "Deleting loses install history and checksums (unnecessary recopies next run); for synced-targets consumers (e.g bin/ deploys) existing targets then skip until manually reconciled, since skipped records never store target cksums." + error $errmsg + } set msg "Sanity check: punkcheck file '$o_checkfile' contains multiple records for INSTALLER -name '$insane'." append msg \n "This may indicate a problem such as multiple concurrent installtrack instances using the same punkcheck file," append msg \n " or a previous installtrack instance that did not complete properly." append msg \n " Do you want to DELETE the .punkcheck file?" append msg \n " It is safe to delete .punkcheck files, at the cost of loss of history and checksums used to optimize installs." append msg \n " They are a record of installation events and checksums used to avoid unnecessary reinstalls." + append msg \n " Caveat: for synced-targets consumers (e.g bin/ deploys) deletion wedges existing targets into skip-until-manually-reconciled - skipped records never store the target cksums that mode compares against." append msg \n " If not confirmed, an error will be raised - likely aborting the current operation." append msg \n "confirm deletion and continue by regenerating the file, by typing the 3 letters: 'yes'." set answer [punk::lib::askuser $msg] @@ -614,14 +906,27 @@ namespace eval punkcheck { set o_events [oolib::collection create [namespace current]::eventcollection] set eventlist [punkcheck::dict_getwithdefault $this_installer_record body [list]] foreach e $eventlist { - set eobj [punkcheck::installevent create [namespace current]::event_[my events count] [self] [dict get $e -source] [dict get $e -targets] {*}$e] - #$o_events add $e [dict get $e -id] + #map the persisted EVENT record fields to constructor options explicitly. + #(the record keys are -ts_begin/-ts_end - passing the raw record gave the constructor's + # -tsbegin/-tsend defaults, so reconstructed events took 'now' as begin and empty end, + # and any later flush/save_installer_record rewrote prior event history with those values) + set eargs [list] + lappend eargs -id [punkcheck::dict_getwithdefault $e -id ""] + lappend eargs -tsbegin [punkcheck::dict_getwithdefault $e -ts_begin ""] + lappend eargs -tsend [punkcheck::dict_getwithdefault $e -ts_end ""] + lappend eargs -types [punkcheck::dict_getwithdefault $e -types {}] + lappend eargs -config [punkcheck::dict_getwithdefault $e -config {}] + set eobj [punkcheck::installevent create [namespace current]::event_[my events count] [self] [dict get $e -source] [dict get $e -targets] {*}$eargs] $o_events add $eobj [dict get $e -id] } } destructor { - #puts "[self] destructor called" + #release any lock still held (an abandoned event, or an error path that skipped end) + if {$o_event_lock ne ""} { + catch {punkcheck::lock::release $o_event_lock} + set o_event_lock "" + } } method test {} { return [self] @@ -655,6 +960,14 @@ namespace eval punkcheck { #review/fix to allow multiple installtrack objects on same punkcheck file. method load_all_records {} { set o_record_list [punkcheck::load_records_from_file $o_checkfile] + set o_load_sig [my Checkfile_signature] + } + #file signature for the optimistic tripwire ({} when the file doesn't exist yet) + method Checkfile_signature {} { + if {[catch {list [file mtime $o_checkfile] [file size $o_checkfile]} sig]} { + return {} + } + return $sig } #does not include associated FILEINFO records - as a targetset (FILEINFO record) can be associated with events from multiple installers over time. @@ -667,37 +980,118 @@ namespace eval punkcheck { set fields [list {*}{ } -tsiso $o_tsiso {*}{ } -ts $o_ts {*}{ - } -name $o_name\ {*}{ + } -name $o_name {*}{ } -keep_events $o_keep_events {*}{ } body $eventrecords {*}{ } ] set record [dict create tag INSTALLER {*}$fields] } - #open file and save only own records + #working recordset accessors - the installtrack's o_record_list is the working copy of the + #.punkcheck recordset. Eager operations and start_event refresh it from the file; deferred + #operations treat it as authoritative between flushes. + method set_recordlist {records} { + set o_record_list $records + } + #record a targetlist as touched by this instance's events - the 'own records' set that + #merge-on-flush carries into freshly-loaded file state + method touched_target {targetlist} { + dict set o_touched_targets $targetlist 1 + } + method lock_held {} { + return [expr {$o_event_lock ne ""}] + } + #single save chokepoint: every .punkcheck write from the record lifecycle funnels through here. + #G-095 measures live here: the write itself is write-temp-then-atomic-rename + #(save_records_to_file), a caller without the event lock gets a transient one, and the + #optimistic tripwire warns when the file changed on disk since this installer last loaded + #it (a writer bypassing the advisory protocol - e.g an older vendored punkcheck during + #the transition window). + method save_working_recordset {{trigger save_working_recordset}} { + set transient 0 + if {$o_event_lock eq ""} { + set o_event_lock [punkcheck::lock::acquire $o_checkfile -installer $o_name] + set transient 1 + } + try { + set current_sig [my Checkfile_signature] + if {$o_load_sig ne {} && $current_sig ne {} && $current_sig ne $o_load_sig} { + catch {puts stderr "punkcheck warning: '$o_checkfile' changed on disk since this installer last loaded it (advisory lock protocol bypassed by another writer?) - saving anyway (trigger: $trigger installer: $o_name)"} + } + set saveresult [punkcheck::save_records_to_file $o_record_list $o_checkfile $trigger $o_debugchannel] + set o_load_sig [my Checkfile_signature] + return $saveresult + } finally { + if {$transient} { + punkcheck::lock::release $o_event_lock + set o_event_lock "" + } + } + } + #sync this installer's own records into freshly-loaded file state and persist via the + #chokepoint - the event-scoped persistence point for deferred events. + #Merge-on-flush (G-095): the file is re-loaded under the lock and only this installer's + #own records are carried over - the INSTALLER record by -name and touched FILEINFO + #records by -targets - so records other processes wrote since our load are preserved + #instead of being wholesale-overwritten. + method flush {{trigger flush}} { + set transient 0 + if {$o_event_lock eq ""} { + set o_event_lock [punkcheck::lock::acquire $o_checkfile -installer $o_name] + set transient 1 + } + try { + #fresh file state under the lock + set base [punkcheck::load_records_from_file $o_checkfile] + #merge own FILEINFO records (by -targets) + foreach targetlist [dict keys $o_touched_targets] { + set owninfo [punkcheck::recordlist::get_file_record $targetlist $o_record_list] + if {[dict get $owninfo position] == -1} { + continue + } + set ownrec [dict get $owninfo record] + set baseinfo [punkcheck::recordlist::get_file_record $targetlist $base] + set base_posn [dict get $baseinfo position] + if {$base_posn == -1} { + lappend base $ownrec + } else { + lset base $base_posn $ownrec + } + } + #merge own INSTALLER record (by -name), event-pruned against the merged set + set this_installer_record [my as_record] + set persistedinfo [punkcheck::recordlist::get_installer_record $o_name $base] + set existing_header_posn [dict get $persistedinfo position] + if {$existing_header_posn == -1} { + ledit base -1 -1 $this_installer_record + set existing_header_posn 0 + } else { + lset base $existing_header_posn $this_installer_record + } + set this_installer_record [punkcheck::recordlist::installer_record_pruneevents $this_installer_record $base] + lset base $existing_header_posn $this_installer_record + + set o_record_list $base + set o_load_sig [my Checkfile_signature] + my save_working_recordset $trigger + } finally { + if {$transient} { + punkcheck::lock::release $o_event_lock + set o_event_lock "" + } + } + } + #save the working recordset (installer record synced) - historical name retained. method save_all_records {} { - my save_installer_record - #todo - save FILEINFO targetset records + my flush save_all_records } method save_installer_record {} { - set file_records [punkcheck::load_records_from_file $o_checkfile] - - set this_installer_record [my as_record] - - set persistedinfo [punkcheck::recordlist::get_installer_record $o_name $file_records] - set existing_header_posn [dict get $persistedinfo position] - if {$existing_header_posn == -1} { - #set file_records [linsert $file_records 0 $this_installer_record] - ledit file_records -1 -1 $this_installer_record - } else { - lset file_records $existing_header_posn $this_installer_record - } - punkcheck::save_records_to_file $file_records $o_checkfile "save_installer_record" + my flush save_installer_record } method events {args} { tailcall $o_events {*}$args } - method start_event {configdict} { + method start_event {configdict args} { if {$o_active_event ne ""} { error "[self] start_event error - event already started: $o_active_event" } @@ -706,36 +1100,75 @@ namespace eval punkcheck { } if {[llength $configdict] %2 != 0} { - error "[self] new_event configdict must have an even number of elements" + error "[self] start_event configdict must have an even number of elements" } - set resultinfo [punkcheck::recordlist::get_installer_record $o_name $o_record_list] - set existing_header_posn [dict get $resultinfo position] - if {$existing_header_posn == -1} { - error "[self] start_event - installer record missing. installer: $o_name" - } else { - set this_installer_record [dict get $resultinfo record] + set defaults [dict create -persistence eager] + if {[llength $args] % 2} { + error "[self] start_event arguments after configdict must be -flag value pairs. known flags: [dict keys $defaults]" + } + foreach {k v} $args { + if {$k ni [dict keys $defaults]} { + error "[self] start_event unrecognised flag '$k'. known flags: [dict keys $defaults]" + } } + set opts [dict merge $defaults $args] + set persistence [dict get $opts -persistence] + + #G-095: acquire the advisory event lock before reading - held from here until the + #event ends (event_ended releases). This serializes whole installer events per + #punkcheck root across processes; in-process sequential installers re-enter via the + #lock registry's refcount. + set acquired_here 0 + if {$o_event_lock eq ""} { + set o_event_lock [punkcheck::lock::acquire $o_checkfile -installer $o_name] + set acquired_here 1 + } + try { + #refresh the working recordset from the file so this event starts from persisted state. + #(coherence: a prior event's targetset writes - eager per-op saves or a deferred flush - must not + # be discarded by saving a stale constructor-era recordset here. Unflushed deferred updates are + # deliberately abandoned by this refresh - an ended deferred event that wasn't flushed chose not + # to persist.) + my load_all_records + set resultinfo [punkcheck::recordlist::get_installer_record $o_name $o_record_list] + set existing_header_posn [dict get $resultinfo position] + if {$existing_header_posn == -1} { + #no persisted installer record yet (first event since construction - the constructor only + #creates the record in memory; this save is the first write) + set this_installer_record [punkcheck::recordlist::new_installer_record $o_name] + ledit o_record_list -1 -1 $this_installer_record + set existing_header_posn 0 + } else { + set this_installer_record [dict get $resultinfo record] + } - set eventobj [punkcheck::installevent create [namespace current]::event_[my events count] [self] $o_rel_sourceroot $o_rel_targetroot -config $configdict] - set eventid [$eventobj get_id] - set event_record [$eventobj as_record] + set eventobj [punkcheck::installevent create [namespace current]::event_[my events count] [self] $o_rel_sourceroot $o_rel_targetroot -config $configdict -persistence $persistence] + set eventid [$eventobj get_id] + set event_record [$eventobj as_record] - set this_installer_record [punkcheck::recordlist::installer_record_add_event $this_installer_record $event_record] - set this_installer_record [punkcheck::recordlist::installer_record_pruneevents $this_installer_record $o_record_list] + set this_installer_record [punkcheck::recordlist::installer_record_add_event $this_installer_record $event_record] + set this_installer_record [punkcheck::recordlist::installer_record_pruneevents $this_installer_record $o_record_list] - #replace - lset o_record_list $existing_header_posn $this_installer_record + #replace + lset o_record_list $existing_header_posn $this_installer_record - punkcheck::save_records_to_file $o_record_list $o_checkfile "start_event $eventid" - set o_active_event $eventobj - my events add $eventobj $eventid - return $eventobj + my save_working_recordset "start_event $eventid" + set o_active_event $eventobj + my events add $eventobj $eventid + return $eventobj + } on error {result erropts} { + if {$acquired_here && $o_event_lock ne ""} { + catch {punkcheck::lock::release $o_event_lock} + set o_event_lock "" + } + return -options $erropts $result + } } method installer_record_from_file {} { set resultinfo [punkcheck::recordlist::get_installer_record $o_name $o_record_list] } method get_recordlist {} { - return $o_recordlist + return $o_record_list } method end_event {} { if {$o_active_event eq ""} { @@ -743,131 +1176,83 @@ namespace eval punkcheck { } $o_active_event end } + #called by installevent end - clears the active slot so a subsequent start_event on this + #installtrack is valid (sequential events on one instance), and releases the advisory + #event lock (G-095: lock scope is the whole installer event, start_event through end) + method event_ended {eventobj} { + if {$o_active_event eq $eventobj} { + set o_active_event "" + if {$o_event_lock ne ""} { + catch {punkcheck::lock::release $o_event_lock} + set o_event_lock "" + } + } + } method get_event {} { return $o_active_event } } } - proc start_installer_event {punkcheck_file installername from_fullpath to_fullpath config} { - set eventid [punkcheck::uuid] - if {[file pathtype $from_fullpath] ne "absolute"} { - error "start_installer_event error: from_fullpath must be absolute path. Received '$from_fullpath'" - } - if {[file pathtype $to_fullpath] ne "absolute"} { - error "start_installer_event error: to_fullpath must be absolute path. Received '$to_fullpath'" - } - set punkcheck_folder [file dirname $punkcheck_file] - set rel_source [punkcheck::lib::path_relative $punkcheck_folder $from_fullpath] - set rel_target [punkcheck::lib::path_relative $punkcheck_folder $to_fullpath] - - - set record_list [punkcheck::load_records_from_file $punkcheck_file] - set resultinfo [punkcheck::recordlist::get_installer_record $installername $record_list] - set existing_header_posn [dict get $resultinfo position] - if {$existing_header_posn == -1} { - set this_installer_record [punkcheck::recordlist::new_installer_record $installername] - } else { - set this_installer_record [dict get $resultinfo record] - } - - set event_record [punkcheck::recordlist::new_installer_event_record install -id $eventid -source $rel_source -targets $rel_target -config $config] - - set this_installer_record [punkcheck::recordlist::installer_record_add_event $this_installer_record $event_record] - set this_installer_record [punkcheck::recordlist::installer_record_pruneevents $this_installer_record $record_list] - - if {$existing_header_posn == -1} { - #not found - prepend - #set record_list [linsert $record_list 0 $this_installer_record] - ledit record_list -1 -1 $this_installer_record - } else { - #replace - lset record_list $existing_header_posn $this_installer_record - } - - punkcheck::save_records_to_file $record_list $punkcheck_file "start_installer_event $eventid" - return [list eventid $eventid recordset $record_list] + #----------------------------------------------- + #G-094: the legacy proc pipeline (start_installer_event + installfile_begin/started/finished/skipped) + #is retired. The installtrack/installevent OO layer above is the sole implementation of the record + #lifecycle. These shims error with a pointer so stale callers fail loud and actionable. + proc start_installer_event {args} { + error "punkcheck::start_installer_event retired (G-094). Use: set obj \[punkcheck::installtrack new \]; \$obj set_source_target ; \$obj start_event ?-persistence eager|deferred? - see punkcheck::installfile_help" + } + proc installfile_begin {args} { + error "punkcheck::installfile_begin retired (G-094). Use the installevent method: \$event targetset_init INSTALL - see punkcheck::installfile_help" + } + proc installfile_started_install {args} { + error "punkcheck::installfile_started_install retired (G-094). Use the installevent method: \$event targetset_started - see punkcheck::installfile_help" + } + proc installfile_finished_install {args} { + error "punkcheck::installfile_finished_install retired (G-094). Use the installevent method: \$event targetset_end OK - see punkcheck::installfile_help" + } + proc installfile_skipped_install {args} { + error "punkcheck::installfile_skipped_install retired (G-094). Use the installevent method: \$event targetset_end SKIPPED - see punkcheck::installfile_help" } #----------------------------------------------- proc installfile_help {} { set msg "" - append msg "Call in order:" \n - append msg " start_installer_event (get dict with eventid and recordset keys)" - append msg " installfile_begin (to return a new INSTALLING record) - must pass in a valid eventid" \n - append msg " installfile_add_source_and_fetch_metadata (1+ times to update SOURCE record with checksum/timestamp info from source)" \n - append msg " ( - possibly with same algorithm as previous installrecord)" \n - append msg " ( - todo - search/load metadata for this source from other FILEINFO records for same installer)" \n - append msg "Finalize by calling:" \n - append msg " installfile_started_install" \n - append msg " (install the file e.g file copy)" \n - append msg " installfile_finished_install" \n - append msg " OR" \n - append msg " installfile_skipped_install" \n - } - proc installfile_begin {punkcheck_folder target_relpath installername args} { - if {[llength $args] %2 !=0} { - error "punkcheck installfile_begin args must be name-value pairs" - } - set target_relpath [lsort -dictionary -increasing $target_relpath] ;#exact sort order not critical - but must be consistent - set ts [clock microseconds] - set seconds [expr {$ts / 1000000}] - set tsiso [clock format $seconds -format "%Y-%m-%dT%H:%M:%S"] - set defaults [list {*}{ - } -tsiso $tsiso {*}{ - } -ts $ts {*}{ - } -installer $installername {*}{ - } -eventid unspecified {*}{ - } - ] - set opts [dict merge $defaults $args] - set opt_eventid [dict get $opts -eventid] - - set punkcheck_file [file join $punkcheck_folder/.punkcheck] - set record_list [load_records_from_file $punkcheck_file] - - set resultinfo [punkcheck::recordlist::get_installer_record $installername $record_list] - set installer_record_position [dict get $resultinfo position] - if {$installer_record_position == -1} { - error "installfile_begin error: Failed to retrieve installer record for installer name:'$installername' - ensure start_installer_event has been called with same installer, and -eventid is passed to installfile_begin" - } - set this_installer_record [dict get $resultinfo record] - set events [dict get $this_installer_record body] - set active_event [list] - foreach evt [lreverse $events] { - if {[dict get $evt -id] eq $opt_eventid} { - set active_event $evt - break - } - } - if {![llength $active_event]} { - error "installfile_begin error: eventid $opt_eventid not found for installer '$installername' - aborting" - } - - - set extractioninfo [punkcheck::recordlist::extract_or_create_fileset_record $target_relpath $record_list] - set file_record [dict get $extractioninfo record] - set record_list [dict get $extractioninfo recordset] - set isnew [dict get $extractioninfo isnew] - set oldposition [dict get $extractioninfo oldposition] - unset extractioninfo - - #INSTALL-INPROGRESS will become INSTALL-RECORD or INSTALL-FAILED or INSTALL-SKIPPED upon finalisation - #-installer and -eventid keys are added here - set new_installing_record [dict create tag INSTALL-INPROGRESS {*}$opts -tempcontext $active_event body {}] - #set existing_body [dict_getwithdefault $file_record body [list]] - #todo - look for existing "INSTALL-INPROGRESS" records - mark as failed? - dict lappend file_record body $new_installing_record - - if {$isnew} { - lappend record_list $file_record - } else { - #set record_list [linsert $record_list[unset record_list] $oldposition $file_record] - ledit record_list $oldposition -1 $file_record - } - - save_records_to_file $record_list $punkcheck_file "installfile_begin $installername $opt_eventid $target_relpath" - return $file_record + append msg "punkcheck record lifecycle - installtrack/installevent object API (G-094)" \n + append msg "The legacy proc pipeline (start_installer_event, installfile_begin," \n + append msg "installfile_started_install, installfile_finished_install, installfile_skipped_install)" \n + append msg "is retired - those procs now raise errors pointing here." \n + append msg "" \n + append msg "Call in order:" \n + append msg " set installer \[punkcheck::installtrack new \]" \n + append msg " \$installer set_source_target " \n + append msg " set event \[\$installer start_event ?-persistence eager|deferred?\]" \n + append msg " per targetset:" \n + append msg " \$event targetset_init " \n + append msg " \$event targetset_addsource (1+ times - records source metadata/cksums)" \n + append msg " \$event targetset_addsource_virtual (named-value sources e.g build versions)" \n + append msg " decide skip/proceed via \$event targetset_source_changes and \$event get_targets_exist" \n + append msg " \$event targetset_started (immediately before performing the operation)" \n + append msg " \$event targetset_end OK|SKIPPED|FAILED ?-note ?" \n + append msg " \$event end (or \$installer end_event - allows a subsequent start_event)" \n + append msg "" \n + append msg "Persistence policy (chosen per event at start_event):" \n + append msg " eager (default): each non-QUERY targetset operation is an immediate read-modify-write" \n + append msg " of the .punkcheck file (crash evidence via *-INPROGRESS records)." \n + append msg " deferred: targetset operations update the installtrack's in-memory recordset only;" \n + append msg " call \$installer flush to persist (event-scoped batch save - punkcheck::install uses this)." \n + append msg " An ended deferred event that was never flushed deliberately discards its record updates." \n + append msg " QUERY operations are never persisted in either mode." \n + append msg "" \n + append msg "Concurrent-writer safety (G-095):" \n + append msg " Saves are write-temp-then-atomic-rename - readers never see torn content." \n + append msg " start_event acquires the advisory sibling lockfile .lock (released at event" \n + append msg " end), serializing whole installer events per punkcheck root across processes; flushes and" \n + append msg " chokepoint saves outside an event take a transient lock. Contention retries with backoff" \n + append msg " until timeout, then errors naming the holder (pid/host/installer/timestamp from the" \n + append msg " lockfile). Stale locks break on provably-dead holder pid (capability-gated) or age." \n + append msg " Env overrides: PUNKCHECK_LOCK_TIMEOUT (ms, default 15000), PUNKCHECK_LOCK_STALEAGE" \n + append msg " (seconds, default 300). Deferred flushes merge own records (INSTALLER by -name," \n + append msg " touched FILEINFO by -targets) into freshly-loaded file state." \n + return $msg } - #todo - ensure that removing a dependency is noticed as a change #e.g previous installrecord had 2 source records - but we now only depend on one. #The files we depended on for the previous record haven't changed themselves - but the list of files has (reduced by one) @@ -1041,7 +1426,7 @@ namespace eval punkcheck { #The -changed flag is computed by comparing -value against the matching virtual SOURCE in the last completed #install record (no filesystem access) - so virtual sources participate in targetset_source_changes like file sources. #Typical use: recording the resolved build version of a module target, so records identify which product of an - #unchanging source fileset (e.g -0.4.0.tm + -buildversion.txt) the target represents. + #unchanging source fileset (e.g -0.6.0.tm + -buildversion.txt) the target represents. proc installsource_add_virtual {file_record id value} { if {![lib::is_file_record_inprogress $file_record]} { error "installsource_add_virtual error: bad file_record - expected FILEINFO with last body element *-INPROGRESS ($file_record)" @@ -1081,114 +1466,6 @@ namespace eval punkcheck { return $file_record } - #write back to punkcheck - don't accept recordset - invalid to update anything other than the installing_record at this time - proc installfile_started_install {punkcheck_folder file_record} { - if {![lib::is_file_record_inprogress $file_record]} { - error "installfile_started_install error: bad file_record - expected FILEINFO with last body element *-INPROGRESS" - } - set punkcheck_file [file join $punkcheck_folder/.punkcheck] - set record_list [load_records_from_file $punkcheck_file] - - set file_record_body [dict get $file_record body] - set targetlist [dict get $file_record -targets] - set installing_record [lindex $file_record_body end] - - set ts_start [dict get $installing_record -ts] - set ts_now [clock microseconds] - set metadata_us [expr {$ts_now - $ts_start}] - - dict set installing_record -metadata_us $metadata_us - dict set installing_record -ts_start_transfer $ts_now - - lset file_record_body end $installing_record - - dict set file_record body $file_record_body - - - set getresult [punkcheck::recordlist::get_file_record $targetlist $record_list] - set old_posn [dict get $getresult position] - if {$old_posn == -1} { - lappend record_list $file_record - } else { - lset record_list $old_posn $file_record - } - - save_records_to_file $record_list $punkcheck_file "installfile_started_install [llength $targetlist] targets" - return $file_record - } - proc installfile_finished_install {punkcheck_folder file_record} { - if {![lib::is_file_record_inprogress $file_record]} { - error "installfile_finished_install error: bad file_record - expected FILEINFO with last body element *-INPROGRESS" - } - set punkcheck_file [file join $punkcheck_folder/.punkcheck] - set record_list [load_records_from_file $punkcheck_file] - - set file_record_body [dict get $file_record body] - set targetlist [dict get $file_record -targets] - set installing_record [lindex $file_record_body end] - - set ts_start [dict get $installing_record -ts] - set ts_start_transfer [dict get $installing_record -ts_start_transfer] - set ts_now [clock microseconds] - set elapsed_us [expr {$ts_now - $ts_start}] - set transfer_us [expr {$ts_now - $ts_start_transfer}] - dict set installing_record -transfer_us $transfer_us - dict set installing_record -elapsed_us $elapsed_us - dict unset installing_record -tempcontext - dict set installing_record tag "INSTALL-RECORD" - - lset file_record_body end $installing_record - dict set file_record body $file_record_body - - set file_record [punkcheck::recordlist::file_record_prune $file_record] - - set oldrecordinfo [punkcheck::recordlist::get_file_record $targetlist $record_list] - set old_posn [dict get $oldrecordinfo position] - if {$old_posn == -1} { - lappend record_list $file_record - } else { - lset record_list $old_posn $file_record - } - - save_records_to_file $record_list $punkcheck_file "installfile_finished_install [llength $targetlist] targets" - return $file_record - } - proc installfile_skipped_install {punkcheck_folder file_record} { - if {![lib::is_file_record_inprogress $file_record]} { - set msg "installfile_skipped_install error: bad file_record - expected FILEINFO with last body element *-INPROGRESS" - append msg \n "received:" - append msg \n $file_record - error $msg - } - set punkcheck_file [file join $punkcheck_folder/.punkcheck] - set record_list [load_records_from_file $punkcheck_file] - - set file_record_body [dict get $file_record body] - set targetlist [dict get $file_record -targets] - set installing_record [lindex $file_record_body end] - - set ts_start [dict get $installing_record -ts] - set tsnow [clock microseconds] - set elapsed_us [expr {$tsnow - $ts_start}] - dict set installing_record -elapsed_us $elapsed_us - dict set installing_record tag "INSTALL-SKIPPED" - - lset file_record_body end $installing_record - dict set file_record body $file_record_body - - set file_record [punkcheck::recordlist::file_record_prune $file_record] - - set getresult [punkcheck::recordlist::get_file_record $targetlist $record_list] - set old_posn [dict get $getresult position] - if {$old_posn == -1} { - lappend record_list $file_record - } else { - lset record_list $old_posn $file_record - } - - save_records_to_file $record_list $punkcheck_file "installfile_skipped_install [llength $targetlist] targets" - return $file_record - } #----------------------------------------------- #then: file_record_add_installrecord @@ -1248,6 +1525,33 @@ namespace eval punkcheck { proc path_relative {base dst} { return [punk::path::relative $base $dst] } + + #Is stdin a terminal a user can be prompted on? (G-095: the duplicate-INSTALLER recovery + #must not block or garble unattended runs with an interactive prompt.) + #Detection is tiered and defaults to NOT interactive when no probe is available - the + #non-interactive path raises a clean actionable error, which an interactive user can act + #on just as well, whereas a prompt in an unattended run blocks or mis-answers. + proc stdin_is_interactive {} { + if {"windows" eq $::tcl_platform(platform)} { + #strict check on the actual std handle: GetConsoleMode errors for pipe/file/NUL + #stdin (twapi::get_console_handle is unsuitable - it succeeds for piped children + #of console shells; same finding as runtests.tcl colour autodetection) + if {![catch {package require twapi}]} { + return [expr {![catch {twapi::GetConsoleMode [twapi::GetStdHandle -10]}]}] + } + return 0 + } else { + #tcl 9 (and 8.7) unix terminal channels expose -inputmode; pipes/files do not + if {[dict exists [chan configure stdin] -inputmode]} { + return 1 + } + #tcl 8.6 unix: POSIX test(1) isatty on fd 0 + if {![catch {exec test -t 0 <@stdin}]} { + return 1 + } + return 0 + } + } } #skip writing punkcheck during checksum/timestamp checks @@ -1391,13 +1695,13 @@ namespace eval punkcheck { is generated automatically. Pass a specific ID to group multiple install calls under the same event in the .punkcheck file." -punkcheck-records -default "" -help\ - "Empty string or a parsed TDL records structure. - e.g - {tag FILEINFO - ... body { - {tag INSTALL-RECORD - ... body {}} - ... - }... - }" + "DEPRECATED/ignored (G-094) - retained for call compatibility. + The working recordset lives in a punkcheck::installtrack instance for + the duration of the install walk; the passed value is not consulted + (pre-G-094 behaviour also replaced it from the file at depth 0)." + -punkcheck-eventobj -default "" -help\ + "(internal recursion carrier - the installevent object shared by all + levels of the install walk)" -installer -default "punkcheck::install" -help\ "A user nominated string that is stored in the .punkcheck file This might be the name of a script or installation process." @@ -1481,6 +1785,7 @@ namespace eval punkcheck { -punkcheck-folder target -punkcheck-eventid "\uFFFF" -punkcheck-records "" + -punkcheck-eventobj "" -installer punkcheck::install -progresschannel none }] @@ -1643,54 +1948,52 @@ namespace eval punkcheck { #review - leave empty? use pwd? } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- - set punkcheck_records [dict get $opts -punkcheck-records] - set punkcheck_records_init $punkcheck_records ;#change-detection + #-punkcheck-records is vestigial as of G-094 (the working recordset lives in the installtrack + #instance) - the option remains accepted for call compatibility. Pre-G-094 behaviour also + #discarded the passed value at depth 0 (replaced from the file via start_installer_event). # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_installer [dict get $opts -installer] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_punkcheck_eventid [dict get $opts -punkcheck-eventid] + set opt_punkcheck_eventobj [dict get $opts -punkcheck-eventobj] set punkcheck_file [file join $punkcheck_folder/.punkcheck] if {$CALLDEPTH == 0} { - set punkcheck_eventid "" - if {$punkcheck_folder ne ""} { - set config $opts - dict unset config -call-depth-internal - dict unset config -max-depth - dict unset config -subdirlist - dict unset config -progresschannel - tcl::dict::for {k v} $config { - if {$v eq "\uFFFF"} { - dict unset config $k - } - } - lassign [punkcheck::start_installer_event $punkcheck_file $opt_installer $srcdir $tgtdir $config] _eventid punkcheck_eventid _recordset punkcheck_records - } + if {$punkcheck_folder eq ""} { + #pre-G-094 code silently skipped event setup for an empty -punkcheck-folder and then failed + #during path relativization - fail early and clearly instead. (folder resolution above yields + #"" only when the caller explicitly passes -punkcheck-folder "") + error "punkcheck::install requires a resolvable -punkcheck-folder (target|source|project|) - received an empty value" + } + set config $opts + dict unset config -call-depth-internal + dict unset config -max-depth + dict unset config -subdirlist + dict unset config -progresschannel + dict unset config -punkcheck-eventobj + tcl::dict::for {k v} $config { + if {$v eq "\uFFFF"} { + dict unset config $k + } + } + #G-094: batch install is a tree-walking consumer of the OO layer in deferred persistence mode. + #The installtrack working recordset accumulates finalized records in memory; one flush at the + #end of the walk persists them (event-scoped save), preserving the original batch write pattern. + set punkcheck_installer [punkcheck::installtrack new $opt_installer $punkcheck_file] + $punkcheck_installer set_source_target $srcdir $tgtdir + set punkcheck_eventobj [$punkcheck_installer start_event $config -persistence deferred] + set punkcheck_eventid [$punkcheck_eventobj get_id] } else { + set punkcheck_eventobj $opt_punkcheck_eventobj + set punkcheck_installer [$punkcheck_eventobj get_installer] set punkcheck_eventid $opt_punkcheck_eventid } - if {$opt_source_checksum != 0} { - #we need to read the file even if only set to store (or we would overwrite entries) - set compare_cksums 1 - } else { - set compare_cksums 0 - } - - if {[string match *store* $opt_source_checksum]} { - set store_source_cksums 1 - } else { - set store_source_cksums 0 - } - - - - if {[llength $subdirlist] == 0} { set current_source_dir $srcdir @@ -1717,6 +2020,12 @@ namespace eval punkcheck { #puts "testing folder - globmatchpath $unpub $relative_source_dir" if {[punk::path::globmatchpath $unpub $relative_source_dir]} { lappend antiglob_paths_matched $current_source_dir + set punkcheck_records [$punkcheck_installer get_recordlist] + if {$CALLDEPTH == 0} { + $punkcheck_eventobj end + $punkcheck_eventobj destroy + $punkcheck_installer destroy + } return [list files_copied {} files_skipped {} sources_unchanged {} punkcheck_records $punkcheck_records antiglob_paths_matched $antiglob_paths_matched srcdir $srcdir tgtdir $tgtdir punkcheck_folder $punkcheck_folder] } } @@ -1760,11 +2069,11 @@ namespace eval punkcheck { #FILEINFO -targets jjjetc-0.1.0.tm -keep_installrecords 2 -keep_skipped 1 -keep_inprogress 2 { # INSTALL-RECORD -tsiso 2023-09-20T07:30:30 -ts 1695159030266610 -installer punk::mix::cli::build_modules_from_source_to_base -metadata_us 18426 -ts_start_transfer 1695159030285036 -transfer_us 10194 -elapsed_us 28620 { # SOURCE -type file -path ../src/modules/jjjetc-buildversion.txt -cksum c7c71839c36b3d21c8370fed106192fcd659eca9 -cksum_all_opts {-cksum_content 1 -cksum_meta 0 -cksum_acls 0 -cksum_usetar 0 -cksum_algorithm sha1} -changed 1 -metadata_us 3423 - # SOURCE -type file -path ../src/modules/jjjetc-0.4.0.tm -cksum b646fc2ee88cbd068d2e946fe929b7aea96bd39d -cksum_all_opts {-cksum_content 1 -cksum_meta 0 -cksum_acls 0 -cksum_usetar 0 -cksum_algorithm sha1} -changed 1 -metadata_us 3413 + # SOURCE -type file -path ../src/modules/jjjetc-0.6.0.tm -cksum b646fc2ee88cbd068d2e946fe929b7aea96bd39d -cksum_all_opts {-cksum_content 1 -cksum_meta 0 -cksum_acls 0 -cksum_usetar 0 -cksum_algorithm sha1} -changed 1 -metadata_us 3413 # } # INSTALL-SKIPPED -tsiso 2023-09-20T08:14:26 -ts 1695161666087880 -installer punk::mix::cli::build_modules_from_source_to_base -elapsed_us 18914 { # SOURCE -type file -path ../src/modules/jjjetc-buildversion.txt -cksum c7c71839c36b3d21c8370fed106192fcd659eca9 -cksum_all_opts {-cksum_content 1 -cksum_meta 0 -cksum_acls 0 -cksum_usetar 0 -cksum_algorithm sha1} -changed 0 -metadata_us 3435 - # SOURCE -type file -path ../src/modules/jjjetc-0.4.0.tm -cksum b646fc2ee88cbd068d2e946fe929b7aea96bd39d -cksum_all_opts {-cksum_content 1 -cksum_meta 0 -cksum_acls 0 -cksum_usetar 0 -cksum_algorithm sha1} -changed 0 -metadata_us 3338 + # SOURCE -type file -path ../src/modules/jjjetc-0.6.0.tm -cksum b646fc2ee88cbd068d2e946fe929b7aea96bd39d -cksum_all_opts {-cksum_content 1 -cksum_meta 0 -cksum_acls 0 -cksum_usetar 0 -cksum_algorithm sha1} -changed 0 -metadata_us 3338 # } #} @@ -1781,7 +2090,6 @@ namespace eval punkcheck { #puts stdout "Current target dir: $current_target_dir" set last_depth "" foreach m $match_list { - set new_tgt_cksum_info [list] set relative_target_path [file join $relative_target_dir $m] set relative_source_path [file join $relative_source_dir $m] set punkcheck_target_relpath [file join $target_relative_to_punkcheck_dir $m] @@ -1798,35 +2106,18 @@ namespace eval punkcheck { continue } - set ts_start [clock microseconds] - set seconds [expr {$ts_start / 1000000}] - set ts_start_iso [clock format $seconds -format "%Y-%m-%dT%H:%M:%S"] - - #puts stdout " rel_target: $punkcheck_target_relpath" - - set fetch_filerec_result [punkcheck::recordlist::get_file_record $punkcheck_target_relpath $punkcheck_records] - #change to use extract_or_create_fileset_record ? - set existing_filerec_posn [dict get $fetch_filerec_result position] - if {$existing_filerec_posn == -1} { - if {$opt_progresschannel ne ""} { + if {$opt_progresschannel ne ""} { + #pre-G-094 output parity: announce first-seen targets when progress output is active + set fetch_filerec_result [punkcheck::recordlist::get_file_record $punkcheck_target_relpath [$punkcheck_installer get_recordlist]] + if {[dict get $fetch_filerec_result position] == -1} { puts stdout "\nNO existing record for $punkcheck_target_relpath" } - set has_filerec 0 - set new_filerec [dict create tag FILEINFO -targets $punkcheck_target_relpath] - set filerec $new_filerec - } else { - set has_filerec 1 - #puts stdout " TDL existing FILEINFO record for $punkcheck_target_relpath" - #puts stdout " $existing_install_record" - set filerec [dict get $fetch_filerec_result record] } - set filerec [punkcheck::recordlist::file_record_set_defaults $filerec] - #new INSTALLREC must be tagged as INSTALL-INPROGRESS to use recordlist::installfile_ method - set new_install_record [dict create tag INSTALL-INPROGRESS -tsiso $ts_start_iso -ts $ts_start -installer $opt_installer -eventid $punkcheck_eventid] - dict lappend filerec body $new_install_record ;#can't use recordlist::file_record_add_installrecord as '*-INPROGRESS' isn't a final tag - so pruning would be mucked up. No need to prune now anyway. - unset new_install_record + #G-094: per-target record lifecycle through the OO layer (deferred persistence - no per-file saves, + #finalized records accumulate in the installtrack working recordset until the end-of-walk flush) + $punkcheck_eventobj targetset_init INSTALL $punkcheck_target_relpath if {$opt_progresschannel ne ""} { @@ -1847,11 +2138,10 @@ namespace eval punkcheck { #REVIEW #different volume or root #} - #Note this isn't a recordlist function - so it doesn't purely operate on the records - #this hits the filesystem for the sourcepath - gets checksums/timestamps depending on config. - #It doesn't save to .punkcheck (the only punkcheck::installfile_ method which doesn't) + #targetset_addsource hits the filesystem for the sourcepath - gets checksums/timestamps + #depending on config - and returns the updated fileset record (no save in deferred mode) set ts1 [clock milliseconds] - set filerec [punkcheck::installfile_add_source_and_fetch_metadata $punkcheck_folder $relative_source_path $filerec] + set filerec [$punkcheck_eventobj targetset_addsource $relative_source_path] set ts2 [clock milliseconds] set diff [expr {$ts2 - $ts1}] if {$diff > 100} { @@ -1874,7 +2164,7 @@ namespace eval punkcheck { #changeinfo comes from last record in body - which is the record we are working on and so will always exist - set changeinfo [punkcheck::recordlist::file_install_record_source_changes [lindex [dict get $filerec body] end]] + set changeinfo [$punkcheck_eventobj targetset_source_changes] set changed [dict get $changeinfo changed] set unchanged [dict get $changeinfo unchanged] @@ -1885,6 +2175,7 @@ namespace eval punkcheck { set is_skip 0 set is_new 0 if {$overwrite_what eq "all-targets"} { + $punkcheck_eventobj targetset_started file mkdir $current_target_dir #-------------------------------------------- #sometimes we get the error: 'error copying "file1" to "file2": invalid argument' @@ -1895,27 +2186,24 @@ namespace eval punkcheck { } else { if {![file exists $current_target_dir/$m]} { #puts stderr "punkcheck: first copy to $current_target_dir/$m " + $punkcheck_eventobj targetset_started file mkdir $current_target_dir puts stderr "punkcheck: about to: file copy $current_source_dir/$m $current_target_dir" file copy $current_source_dir/$m $current_target_dir - set new_tgt_cksum_info [punk::mix::base::lib::cksum_path $current_target_dir/$m] lappend files_copied $current_source_dir/$m - incr filecount_new set is_new 1 } else { switch -- $overwrite_what { installedsourcechanged-targets { if {[llength $changed]} { #An unrecorded installation is considered a source change (from unknown/unrecorded source to recorded) + $punkcheck_eventobj targetset_started puts -nonewline stderr "punkcheck: about to: file copy -force $current_source_dir/$m $current_target_dir" set ts1 [clock milliseconds] file mkdir $current_target_dir file copy -force $current_source_dir/$m $current_target_dir set ts2 [clock milliseconds] - puts -nonewline stderr " (copy time [expr {$ts2 - $ts1}] ms)" - set new_tgt_cksum_info [punk::mix::base::lib::cksum_path $current_target_dir/$m] - set ts3 [clock milliseconds] - puts stderr " (cksum time [expr {$ts2 - $ts1}] ms)" + puts stderr " (copy time [expr {$ts2 - $ts1}] ms)" lappend files_copied $current_source_dir/$m } else { set is_skip 1 @@ -1943,10 +2231,10 @@ namespace eval punkcheck { set target_cksum_compare "norecord" } if {$is_target_unmodified_since_install} { + $punkcheck_eventobj targetset_started file mkdir $current_target_dir puts stderr "punkcheck: synced-targets about to: file copy -force $current_source_dir/$m $current_target_dir" file copy -force $current_source_dir/$m $current_target_dir - set new_tgt_cksum_info [punk::mix::base::lib::cksum_path $current_target_dir/$m] lappend files_copied $current_source_dir/$m } else { #either cksum is different or we were unable to verify the record. Either way we can't know if the target is in sync so we must skip it @@ -1977,34 +2265,13 @@ namespace eval punkcheck { - set ts_now [clock microseconds] - set elapsed_us [expr {$ts_now - $ts_start}] - - #if {$store_source_cksums} { - #} - - set install_records [dict get $filerec body] - set current_install_record [lindex $install_records end] - #change the tag from *-INPROGRESS to INSTALL-RECORD/SKIPPED + #finalize the record: targetset_end sets the tag, -elapsed_us, and computes/stores post-install + #target cksums (-targets_cksums/-cksum_all_opts/-cksum_us) for successful installs, then merges + #the finalized record into the installtrack working recordset (in-memory - deferred mode) if {$is_skip} { - set tag INSTALL-SKIPPED - } else { - set tag INSTALL-RECORD - } - dict set current_install_record tag $tag - dict set current_install_record -elapsed_us $elapsed_us - if {[llength $new_tgt_cksum_info]} { - dict set current_install_record -targets_cksums [list [dict get $new_tgt_cksum_info cksum]] - dict set current_install_record -cksum_all_opts [dict get $new_tgt_cksum_info opts] - } - lset install_records end $current_install_record - dict set filerec body $install_records - set filerec [punkcheck::recordlist::file_record_prune $filerec] ;#prune now that tag is finalized - if {!$has_filerec} { - #not found in original recordlist - append - lappend punkcheck_records $filerec + $punkcheck_eventobj targetset_end SKIPPED } else { - lset punkcheck_records $existing_filerec_posn $filerec + $punkcheck_eventobj targetset_end OK } @@ -2075,28 +2342,12 @@ namespace eval punkcheck { #} - set sub_opts_1 [list {*}{ - } -call-depth-internal [expr {$CALLDEPTH + 1}] {*}{ - } -subdirlist [list {*}$subdirlist $d] {*}{ - } -glob $fileglob {*}{ - } -exclude-filetails-core $opt_excludefiletail_core {*}{ - } -exclude-filetails $opt_excludefiletail {*}{ - } -exclude-paths-core $opt_excludepaths_core {*}{ - } -exclude-paths $opt_excludepaths {*}{ - } -overwrite $overwrite_what {*}{ - } -source-checksum $opt_source_checksum {*}{ - } -punkcheck-folder $punkcheck_folder {*}{ - } -punkcheck-eventid $punkcheck_eventid {*}{ - } -punkcheck-records $punkcheck_records {*}{ - } -installer $opt_installer {*}{ - } - ] set sub_opts [list {*}{ } -call-depth-internal [expr {$CALLDEPTH + 1}] {*}{ } -subdirlist [list {*}$subdirlist $d] {*}{ } -punkcheck-folder $punkcheck_folder {*}{ } -punkcheck-eventid $punkcheck_eventid {*}{ - } -punkcheck-records $punkcheck_records {*}{ + } -punkcheck-eventobj $punkcheck_eventobj {*}{ } -progresschannel $opt_progresschannel {*}{ } ] @@ -2107,25 +2358,24 @@ namespace eval punkcheck { lappend files_skipped {*}[dict get $sub_result files_skipped] lappend sources_unchanged {*}[dict get $sub_result sources_unchanged] lappend antiglob_paths_matched {*}[dict get $sub_result antiglob_paths_matched] - set punkcheck_records [dict get $sub_result punkcheck_records] + #the evolving recordset is shared state in the installtrack instance - nothing to carry back } - if {[string match *store* $opt_source_checksum]} { - #puts "subdirlist: $subdirlist" - if {$CALLDEPTH == 0} { - if {[llength $files_copied] || [llength $files_skipped]} { - #puts stdout ">>>>>>>>>>>>>>>>>>>" - set saveresult [punkcheck::save_records_to_file $punkcheck_records $punkcheck_file "install $srcdir to $tgtdir"] - puts stdout "\npunkcheck::install [dict get $saveresult recordcount] records saved as [dict get $saveresult linecount] lines to $punkcheck_file copied: [llength $files_copied] skipped: [llength $files_skipped]" - #puts stdout ">>>>>>>>>>>>>>>>>>>" - } else { - #todo - write db INSTALLER record if -debug true - - } - #puts stdout "sources_unchanged" - #puts stdout "$sources_unchanged" - #puts stdout "- -- --- --- --- ---" - } + if {$CALLDEPTH == 0} { + #event-scoped deferred flush: one save persists the whole walk's finalized records. + #compare-only runs (-source-checksum compare) never flush - the in-memory updates are + #deliberately discarded, matching the pre-G-094 batch behaviour (the start_event save + #already registered the event itself in both cases). + if {[string match *store* $opt_source_checksum] && ([llength $files_copied] || [llength $files_skipped])} { + set saveresult [$punkcheck_installer flush "install $srcdir to $tgtdir"] + puts stdout "\npunkcheck::install [dict get $saveresult recordcount] records saved as [dict get $saveresult linecount] lines to $punkcheck_file copied: [llength $files_copied] skipped: [llength $files_skipped]" + } + set punkcheck_records [$punkcheck_installer get_recordlist] + $punkcheck_eventobj end + $punkcheck_eventobj destroy + $punkcheck_installer destroy + } else { + set punkcheck_records [$punkcheck_installer get_recordlist] } return [list files_copied $files_copied files_skipped $files_skipped sources_unchanged $sources_unchanged antiglob_paths_matched $antiglob_paths_matched punkcheck_records $punkcheck_records punkcheck_folder $punkcheck_folder srcdir $srcdir tgtdir $tgtdir] @@ -2486,12 +2736,12 @@ namespace eval punkcheck { } #extract new or existing filerecord for path given - #REVIEW - locking/concurrency + #locking/concurrency: G-095 (this is a pure record transform - no file access; the isnew key + #tells the caller whether a record existed, callers own any reporting) proc extract_or_create_fileset_record {relative_target_paths recordset} { set fetch_record_result [punkcheck::recordlist::get_file_record $relative_target_paths $recordset] set existing_posn [dict get $fetch_record_result position] if {$existing_posn == -1} { - puts stdout "punkcheck NO existing record for $relative_target_paths" set isnew 1 set fileset_record [dict create tag FILEINFO -targets $relative_target_paths body {}] } else { @@ -2513,7 +2763,7 @@ namespace eval punkcheck { namespace eval ::punk::args::register { #use fully qualified so 8.6 doesn't find existing var in global namespace - lappend ::punk::args::register::NAMESPACES ::punkcheck + lappend ::punk::args::register::NAMESPACES ::punkcheck ::punkcheck::lock } @@ -2528,6 +2778,6 @@ namespace eval ::punk::args::register { package provide punkcheck [namespace eval punkcheck { set pkg punkcheck variable version - set version 0.4.0 + set version 0.6.0 }] return