From f2377f15b90ad30718bd1f792539b04f497e5fcf Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Thu, 14 May 2026 15:50:14 +1000 Subject: [PATCH] fix underlying cause of punkcheck file integrity - bad punk::lib::compat::ledit function. Quieten punkcheck debug output --- src/bootsupport/modules/punk/lib-0.1.6.tm | 52 +++++++++++++------ src/bootsupport/modules/punk/mix/cli-0.3.1.tm | 2 + src/bootsupport/modules/punkcheck-0.1.0.tm | 45 ++++++++++------ src/modules/punk/lib-999999.0a1.0.tm | 52 +++++++++++++------ src/modules/punk/mix/cli-999999.0a1.0.tm | 2 + src/modules/punkcheck-0.1.0.tm | 45 ++++++++++------ .../lib-0.1.3_testsuites/lib/compat.test | 12 +++++ .../lib/lineprocessing.test | 4 +- 8 files changed, 148 insertions(+), 66 deletions(-) diff --git a/src/bootsupport/modules/punk/lib-0.1.6.tm b/src/bootsupport/modules/punk/lib-0.1.6.tm index aee51015..dda806aa 100644 --- a/src/bootsupport/modules/punk/lib-0.1.6.tm +++ b/src/bootsupport/modules/punk/lib-0.1.6.tm @@ -459,26 +459,46 @@ tcl::namespace::eval punk::lib::compat { } } set lidx [punk::lib::lindex_resolve [llength $l] $last] - switch -exact -- $lidx { - -Inf { - #index below lower bound - set post [lrange $l 0 end] - } - Inf { - #index above upper bound - set post [list] - } - default { - if {$lidx < $fidx} { - #from ledit man page: - #If last is less than first, then any specified elements will be inserted into the list before the element specified by first with no elements being deleted. - set post [lrange $l $fidx end] - } else { - #set post [lrange $l $last+1 end] + if {$lidx < $fidx} { + #from ledit man page: + #If last is less than first, then any specified elements will be inserted into the list before the element specified by first with no elements being deleted. + set post [lrange $l $fidx end] + } else { + #set post [lrange $l $last+1 end] + switch -exact -- $lidx { + -Inf { + #index below lower bound + set post [lrange $l 0 end] + } + Inf { + #index above upper bound + set post [list] + } + default { set post [lrange $l $lidx+1 end] } } } + #switch -exact -- $lidx { + # -Inf { + # #index below lower bound + # set post [lrange $l 0 end] + # } + # Inf { + # #index above upper bound + # set post [list] + # } + # default { + # if {$lidx < $fidx} { + # #from ledit man page: + # #If last is less than first, then any specified elements will be inserted into the list before the element specified by first with no elements being deleted. + # set post [lrange $l $fidx end] + # } else { + # #set post [lrange $l $last+1 end] + # set post [lrange $l $lidx+1 end] + # } + # } + #} set l [list {*}$pre {*}$args {*}$post] } diff --git a/src/bootsupport/modules/punk/mix/cli-0.3.1.tm b/src/bootsupport/modules/punk/mix/cli-0.3.1.tm index 05e8724f..20810a0c 100644 --- a/src/bootsupport/modules/punk/mix/cli-0.3.1.tm +++ b/src/bootsupport/modules/punk/mix/cli-0.3.1.tm @@ -566,6 +566,7 @@ namespace eval punk::mix::cli { #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 $installer set_source_target $srcdir $basedir set event [$installer start_event $config] # -- --- @@ -662,6 +663,7 @@ namespace eval punk::mix::cli { # -max_depth -1 for no limit set build_installername pods_in_$current_source_dir set build_installer [punkcheck::installtrack new $build_installername $buildfolder/.punkcheck] + #set build_installer [punkcheck::installtrack new $build_installername $buildfolder/.punkcheck stderr] ;#with debugchannel $build_installer set_source_target $current_source_dir/$modpath $buildfolder set build_event [$build_installer start_event $config] # -- --- diff --git a/src/bootsupport/modules/punkcheck-0.1.0.tm b/src/bootsupport/modules/punkcheck-0.1.0.tm index 45b2a4c8..eb439c6e 100644 --- a/src/bootsupport/modules/punkcheck-0.1.0.tm +++ b/src/bootsupport/modules/punkcheck-0.1.0.tm @@ -81,17 +81,14 @@ namespace eval punkcheck { } return $record_list } - proc save_records_to_file {recordlist punkcheck_file {trigger {}}} { + proc save_records_to_file {recordlist punkcheck_file {trigger {}} {debugchannel ""}} { set newtdl [punk::tdl::prettyprint $recordlist] set linecount [llength [split $newtdl \n]] - if {$trigger ne ""} { - puts stderr "\x1b\[36mSaving [llength $recordlist] records as $linecount lines to file '$punkcheck_file' trigger: \x1b\[32m$trigger\x1b\[m" + 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 - if {[file exists $punkcheck_file] && [file type $punkcheck_file] eq "file"} { - file delete $punkcheck_file - } set fd [open $punkcheck_file w] chan configure $fd -translation binary puts -nonewline $fd $newtdl @@ -175,8 +172,10 @@ namespace eval punkcheck { variable o_path_cksum_cache variable o_fileset_record variable o_installer ;#parent object + variable o_debugchannel constructor {installer rel_sourceroot rel_targetroot args} { set o_installer $installer + set o_debugchannel [$installer get_debugchannel] set o_operation_start_ts "" set o_path_cksum_cache [dict create] set o_operation "" @@ -326,7 +325,7 @@ namespace eval punkcheck { set extractioninfo [punkcheck::recordlist::extract_or_create_fileset_record $o_targets $record_list] set o_fileset_record [dict get $extractioninfo record] - set record_list [dict get $extractioninfo recordset] + set record_list [dict get $extractioninfo recordset] ;#if fileset wasn't present, same as original record_list, otherwise full recordset with the fileset record removed, ready for reinsertion. set isnew [dict get $extractioninfo isnew] set oldposition [dict get $extractioninfo oldposition] unset extractioninfo @@ -535,7 +534,9 @@ namespace eval punkcheck { variable o_record_list variable o_active_event variable o_events - constructor {installername punkcheck_file} { + variable o_debugchannel + constructor {installername punkcheck_file {debugchannel ""}} { + set o_debugchannel $debugchannel set o_active_event "" set o_name $installername @@ -553,8 +554,8 @@ namespace eval punkcheck { } my load_all_records - if {![llength $o_record_list]} { - puts stderr "\x1b\[32mNo existing records found in punkcheck file '$o_checkfile' for installer '$installername'. Starting with empty record list.\x1b\[m" + if {![llength $o_record_list] && $o_debugchannel ne ""} { + puts $o_debugchannel "\x1b\[32mNo existing records found in punkcheck file '$o_checkfile' for installer '$installername'. Starting with empty record list.\x1b\[m" } else { #verify no duplicate installer records for this installer. #JMN @@ -565,7 +566,9 @@ namespace eval punkcheck { set name [dict get $rec -name] if {[dict exists $sanity_dict $name]} { #todo - warn - duplicate record for same targetlist - shouldn't happen as we should be using get_file_record to find existing records - puts stderr "\x1b\[31mpunkcheck installtrack - multiple INSTALLER records with same name '$name'\x1b\[m" + if {$o_debugchannel ne ""} { + puts $o_debugchannel "\x1b\[31mpunkcheck installtrack - multiple INSTALLER records with same name '$name'\x1b\[m" + } set insane "$name" break } @@ -576,10 +579,14 @@ namespace eval punkcheck { 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 " Please verify that this is expected and safe to proceed before confirming with 'yes'." + 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 " 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] - if {$answer ne "yes"} { - error "Aborting due to sanity check failure. User did not confirm with 'yes'." + if {[string tolower $answer] ne "yes"} { + error "Failing due to sanity check failure. User did not confirm with 'yes'." } if {[file exists $o_checkfile] && [file isfile $o_checkfile]} { file delete $o_checkfile @@ -589,7 +596,9 @@ namespace eval punkcheck { } set o_record_list [list] } else { - puts stderr "\x1b\[32mSanity check passed: no duplicate INSTALLER records found for installer '$installername' in punkcheck file '$o_checkfile'.\x1b\[m" + if {$o_debugchannel ne ""} { + puts $o_debugchannel "\x1b\[32mSanity check passed: no duplicate INSTALLER records found for installer '$installername' in punkcheck file '$o_checkfile'.\x1b\[m" + } } unset sanity_dict } @@ -628,6 +637,9 @@ namespace eval punkcheck { method get_checkfile {} { return $o_checkfile } + method get_debugchannel {} { + return $o_debugchannel + } #call set_source_target before calling start_event/end_event #each event can have different source->target pairs - but may often have same, so set on installtrack as defaults. Only persisted in event records. @@ -2430,7 +2442,8 @@ namespace eval punkcheck { set fileset_record [dict create tag FILEINFO -targets $relative_target_paths body {}] } else { #set recordset [lreplace $recordset[unset recordset] $existing_posn $existing_posn] - set recordset [lreplace $recordset[set recordset {}] $existing_posn $existing_posn] + #set recordset [lreplace $recordset[set recordset {}] $existing_posn $existing_posn] + ledit recordset $existing_posn $existing_posn set isnew 0 set fileset_record [dict get $fetch_record_result record] } diff --git a/src/modules/punk/lib-999999.0a1.0.tm b/src/modules/punk/lib-999999.0a1.0.tm index 574b136f..3c05a680 100644 --- a/src/modules/punk/lib-999999.0a1.0.tm +++ b/src/modules/punk/lib-999999.0a1.0.tm @@ -459,26 +459,46 @@ tcl::namespace::eval punk::lib::compat { } } set lidx [punk::lib::lindex_resolve [llength $l] $last] - switch -exact -- $lidx { - -Inf { - #index below lower bound - set post [lrange $l 0 end] - } - Inf { - #index above upper bound - set post [list] - } - default { - if {$lidx < $fidx} { - #from ledit man page: - #If last is less than first, then any specified elements will be inserted into the list before the element specified by first with no elements being deleted. - set post [lrange $l $fidx end] - } else { - #set post [lrange $l $last+1 end] + if {$lidx < $fidx} { + #from ledit man page: + #If last is less than first, then any specified elements will be inserted into the list before the element specified by first with no elements being deleted. + set post [lrange $l $fidx end] + } else { + #set post [lrange $l $last+1 end] + switch -exact -- $lidx { + -Inf { + #index below lower bound + set post [lrange $l 0 end] + } + Inf { + #index above upper bound + set post [list] + } + default { set post [lrange $l $lidx+1 end] } } } + #switch -exact -- $lidx { + # -Inf { + # #index below lower bound + # set post [lrange $l 0 end] + # } + # Inf { + # #index above upper bound + # set post [list] + # } + # default { + # if {$lidx < $fidx} { + # #from ledit man page: + # #If last is less than first, then any specified elements will be inserted into the list before the element specified by first with no elements being deleted. + # set post [lrange $l $fidx end] + # } else { + # #set post [lrange $l $last+1 end] + # set post [lrange $l $lidx+1 end] + # } + # } + #} set l [list {*}$pre {*}$args {*}$post] } diff --git a/src/modules/punk/mix/cli-999999.0a1.0.tm b/src/modules/punk/mix/cli-999999.0a1.0.tm index 564be7f3..a263edad 100644 --- a/src/modules/punk/mix/cli-999999.0a1.0.tm +++ b/src/modules/punk/mix/cli-999999.0a1.0.tm @@ -566,6 +566,7 @@ namespace eval punk::mix::cli { #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 $installer set_source_target $srcdir $basedir set event [$installer start_event $config] # -- --- @@ -662,6 +663,7 @@ namespace eval punk::mix::cli { # -max_depth -1 for no limit set build_installername pods_in_$current_source_dir set build_installer [punkcheck::installtrack new $build_installername $buildfolder/.punkcheck] + #set build_installer [punkcheck::installtrack new $build_installername $buildfolder/.punkcheck stderr] ;#with debugchannel $build_installer set_source_target $current_source_dir/$modpath $buildfolder set build_event [$build_installer start_event $config] # -- --- diff --git a/src/modules/punkcheck-0.1.0.tm b/src/modules/punkcheck-0.1.0.tm index 45b2a4c8..eb439c6e 100644 --- a/src/modules/punkcheck-0.1.0.tm +++ b/src/modules/punkcheck-0.1.0.tm @@ -81,17 +81,14 @@ namespace eval punkcheck { } return $record_list } - proc save_records_to_file {recordlist punkcheck_file {trigger {}}} { + proc save_records_to_file {recordlist punkcheck_file {trigger {}} {debugchannel ""}} { set newtdl [punk::tdl::prettyprint $recordlist] set linecount [llength [split $newtdl \n]] - if {$trigger ne ""} { - puts stderr "\x1b\[36mSaving [llength $recordlist] records as $linecount lines to file '$punkcheck_file' trigger: \x1b\[32m$trigger\x1b\[m" + 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 - if {[file exists $punkcheck_file] && [file type $punkcheck_file] eq "file"} { - file delete $punkcheck_file - } set fd [open $punkcheck_file w] chan configure $fd -translation binary puts -nonewline $fd $newtdl @@ -175,8 +172,10 @@ namespace eval punkcheck { variable o_path_cksum_cache variable o_fileset_record variable o_installer ;#parent object + variable o_debugchannel constructor {installer rel_sourceroot rel_targetroot args} { set o_installer $installer + set o_debugchannel [$installer get_debugchannel] set o_operation_start_ts "" set o_path_cksum_cache [dict create] set o_operation "" @@ -326,7 +325,7 @@ namespace eval punkcheck { set extractioninfo [punkcheck::recordlist::extract_or_create_fileset_record $o_targets $record_list] set o_fileset_record [dict get $extractioninfo record] - set record_list [dict get $extractioninfo recordset] + set record_list [dict get $extractioninfo recordset] ;#if fileset wasn't present, same as original record_list, otherwise full recordset with the fileset record removed, ready for reinsertion. set isnew [dict get $extractioninfo isnew] set oldposition [dict get $extractioninfo oldposition] unset extractioninfo @@ -535,7 +534,9 @@ namespace eval punkcheck { variable o_record_list variable o_active_event variable o_events - constructor {installername punkcheck_file} { + variable o_debugchannel + constructor {installername punkcheck_file {debugchannel ""}} { + set o_debugchannel $debugchannel set o_active_event "" set o_name $installername @@ -553,8 +554,8 @@ namespace eval punkcheck { } my load_all_records - if {![llength $o_record_list]} { - puts stderr "\x1b\[32mNo existing records found in punkcheck file '$o_checkfile' for installer '$installername'. Starting with empty record list.\x1b\[m" + if {![llength $o_record_list] && $o_debugchannel ne ""} { + puts $o_debugchannel "\x1b\[32mNo existing records found in punkcheck file '$o_checkfile' for installer '$installername'. Starting with empty record list.\x1b\[m" } else { #verify no duplicate installer records for this installer. #JMN @@ -565,7 +566,9 @@ namespace eval punkcheck { set name [dict get $rec -name] if {[dict exists $sanity_dict $name]} { #todo - warn - duplicate record for same targetlist - shouldn't happen as we should be using get_file_record to find existing records - puts stderr "\x1b\[31mpunkcheck installtrack - multiple INSTALLER records with same name '$name'\x1b\[m" + if {$o_debugchannel ne ""} { + puts $o_debugchannel "\x1b\[31mpunkcheck installtrack - multiple INSTALLER records with same name '$name'\x1b\[m" + } set insane "$name" break } @@ -576,10 +579,14 @@ namespace eval punkcheck { 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 " Please verify that this is expected and safe to proceed before confirming with 'yes'." + 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 " 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] - if {$answer ne "yes"} { - error "Aborting due to sanity check failure. User did not confirm with 'yes'." + if {[string tolower $answer] ne "yes"} { + error "Failing due to sanity check failure. User did not confirm with 'yes'." } if {[file exists $o_checkfile] && [file isfile $o_checkfile]} { file delete $o_checkfile @@ -589,7 +596,9 @@ namespace eval punkcheck { } set o_record_list [list] } else { - puts stderr "\x1b\[32mSanity check passed: no duplicate INSTALLER records found for installer '$installername' in punkcheck file '$o_checkfile'.\x1b\[m" + if {$o_debugchannel ne ""} { + puts $o_debugchannel "\x1b\[32mSanity check passed: no duplicate INSTALLER records found for installer '$installername' in punkcheck file '$o_checkfile'.\x1b\[m" + } } unset sanity_dict } @@ -628,6 +637,9 @@ namespace eval punkcheck { method get_checkfile {} { return $o_checkfile } + method get_debugchannel {} { + return $o_debugchannel + } #call set_source_target before calling start_event/end_event #each event can have different source->target pairs - but may often have same, so set on installtrack as defaults. Only persisted in event records. @@ -2430,7 +2442,8 @@ namespace eval punkcheck { set fileset_record [dict create tag FILEINFO -targets $relative_target_paths body {}] } else { #set recordset [lreplace $recordset[unset recordset] $existing_posn $existing_posn] - set recordset [lreplace $recordset[set recordset {}] $existing_posn $existing_posn] + #set recordset [lreplace $recordset[set recordset {}] $existing_posn $existing_posn] + ledit recordset $existing_posn $existing_posn set isnew 0 set fileset_record [dict get $fetch_record_result record] } diff --git a/src/modules/test/punk/#modpod-lib-999999.0a1.0/lib-0.1.3_testsuites/lib/compat.test b/src/modules/test/punk/#modpod-lib-999999.0a1.0/lib-0.1.3_testsuites/lib/compat.test index d19bfad4..fe2df0b9 100644 --- a/src/modules/test/punk/#modpod-lib-999999.0a1.0/lib-0.1.3_testsuites/lib/compat.test +++ b/src/modules/test/punk/#modpod-lib-999999.0a1.0/lib-0.1.3_testsuites/lib/compat.test @@ -27,4 +27,16 @@ namespace eval ::testspace { {a x c d} ] + test compat_ledit_insert {test basic ledit insertion}\ + -setup $common -body { + set l {0 1 2 3 4 5} + punk::lib::compat::ledit l 3 -1 2b + lappend result $l + }\ + -cleanup { + }\ + -result [list\ + {0 1 2 2b 3 4 5} + ] + } \ No newline at end of file diff --git a/src/modules/test/punk/#modpod-lib-999999.0a1.0/lib-0.1.3_testsuites/lib/lineprocessing.test b/src/modules/test/punk/#modpod-lib-999999.0a1.0/lib-0.1.3_testsuites/lib/lineprocessing.test index 04bc25fe..9ce3a327 100644 --- a/src/modules/test/punk/#modpod-lib-999999.0a1.0/lib-0.1.3_testsuites/lib/lineprocessing.test +++ b/src/modules/test/punk/#modpod-lib-999999.0a1.0/lib-0.1.3_testsuites/lib/lineprocessing.test @@ -26,7 +26,7 @@ namespace eval ::testspace { {line1 line2 line3} \ {{} line1 line2 line3 {}} \ {{} line1 line2 line3 {} {}} \ - {{} line1 line2 line3} \ + {{} line1 line2 line3} \ {line1 {} line2 {} {} line3} \ ] @@ -49,7 +49,7 @@ namespace eval ::testspace { {{} line1 line2 line3 {}} \ {{} line1 line2 line3 {}} \ {{} line1 line2 line3 {}} \ - {{} line1 line2 line3 {}} \ + {{} line1 line2 line3 {}} \ {{} line1 line2 line3 {}} ]