@ -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.<pid>)
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,18 +117,251 @@ 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 <chan> refcount <n>}
}
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 <punkcheck_file>.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 <lockfile>} 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
}
}
}
}
#Concurrent multi-process writers of one .punkcheck file are G-095's scope - the single save chokepoint
#(installtrack method save_working_recordset) is the attachment point for its locking/atomic-rename/merge measures.
#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.
#
@ -241,7 +493,9 @@ namespace eval punkcheck {
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)
#(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]
@ -253,6 +507,7 @@ namespace eval punkcheck {
lset record_list $old_posn $o_fileset_record
}
$o_installer set_recordlist $record_list
$o_installer touched_target $targetlist
}
#call init before we know if we are going to run the operation vs skip
@ -551,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]
@ -592,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]
@ -651,7 +922,11 @@ namespace eval punkcheck {
}
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]
@ -685,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.
@ -710,27 +993,93 @@ namespace eval punkcheck {
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 (concurrent-writer safety: locking, atomic rename, merge-on-flush) attaches at this point.
#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}} {
punkcheck::save_records_to_file $o_record_list $o_checkfile $trigger $o_debugchannel
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 record (from the live event objects) into the working recordset,
#prune unreferenced events beyond -keep_events, and persist via the chokepoint.
#This is the event-scoped persistence point for deferred events.
#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 this_installer_record [my as_record]
set persistedinfo [punkcheck::recordlist::get_installer_record $o_name $o_record_list]
set existing_header_posn [dict get $persistedinfo position]
if {$existing_header_posn == -1} {
ledit o_record_list -1 -1 $this_installer_record
set existing_header_posn 0
} else {
lset o_record_list $existing_header_posn $this_installer_record
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 ""
}
}
set this_installer_record [punkcheck::recordlist::installer_record_pruneevents $this_installer_record $o_record_list]
lset o_record_list $existing_header_posn $this_installer_record
my save_working_recordset $trigger
}
#save the working recordset (installer record synced) - historical name retained.
method save_all_records {} {
@ -765,38 +1114,55 @@ namespace eval punkcheck {
set opts [dict merge $defaults $args]
set persistence [dict get $opts -persistence]
#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]
}
#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 -persistence $persistence]
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
my save_working_recordset "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]
@ -811,10 +1177,15 @@ 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)
#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 {} {
@ -869,6 +1240,17 @@ namespace eval punkcheck {
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 <punkcheckfile>.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
@ -1044,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 <module>-0.5 .0.tm + <module>-buildversion.txt) the target represents.
#unchanging source fileset (e.g <module>-0.6 .0.tm + <module>-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)"
@ -1143,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
@ -1660,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.5 .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.5 .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
# }
#}
@ -2354,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
}
@ -2369,6 +2778,6 @@ namespace eval ::punk::args::register {
package provide punkcheck [namespace eval punkcheck {
set pkg punkcheck
variable version
set version 0.5 .0
set version 0.6 .0
}]
return
