diff --git a/src/bootsupport/modules/punkcheck-0.5.0.tm b/src/bootsupport/modules/punkcheck-0.6.0.tm similarity index 81% rename from src/bootsupport/modules/punkcheck-0.5.0.tm rename to src/bootsupport/modules/punkcheck-0.6.0.tm index 3b8ca952..e1839e8b 100644 --- a/src/bootsupport/modules/punkcheck-0.5.0.tm +++ b/src/bootsupport/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,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 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 + } + } + } + } + - #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 .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 -0.5.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)" @@ -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