You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
2382 lines
122 KiB
2382 lines
122 KiB
# -*- tcl -*- |
|
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'dev make' or src/make.tcl to update from <pkg>-buildversion.txt |
|
# |
|
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. |
|
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. |
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
# (C) 2023 |
|
# |
|
# @@ Meta Begin |
|
# Application punkcheck 0.1.0 |
|
# Meta platform tcl |
|
# Meta license <unspecified> |
|
# @@ Meta End |
|
|
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
## Requirements |
|
##e.g package require frobz |
|
|
|
package require punk::tdl |
|
package require punk::path |
|
package require punk::repo |
|
package require punk::mix::util |
|
|
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
# Punkcheck uses the TDL format which is a list of lists in Tcl format |
|
# It is intended primarily for source build/distribution tracking within a punk project or single filesystem - with relative paths. |
|
# |
|
#see following article regarding the many problems with using mtime for build-decisions: https://apenwarr.ca/log/20181113 |
|
# |
|
namespace eval punkcheck { |
|
#namespace export\ |
|
# uuid\ |
|
# start_installer_event installfile_* |
|
namespace export\ |
|
uuid\ |
|
installtrack\ |
|
install\ |
|
install_tm_files\ |
|
install_non_tm_files\ |
|
summarize_install_resultdict\ |
|
|
|
#antiglob_dir & antiglob_file entries match the pattern at any level - should not contain path separators |
|
variable default_antiglob_dir_core [list "#*" "_aside" "_build" ".git" ".fossil*"] |
|
variable default_antiglob_file_core "" |
|
proc uuid {} { |
|
set has_twapi 0 |
|
if {"windows" eq $::tcl_platform(platform)} { |
|
if {![catch {package require twapi}]} { |
|
set has_twapi 1 |
|
} |
|
} |
|
if {!$has_twapi} { |
|
if {[catch {package require uuid} errM]} { |
|
error "punkcheck: Unable to load a package for uuid on this platform. Try tcllib's uuid (any platform) - twapi for windows" |
|
} |
|
return [uuid::uuid generate] |
|
} else { |
|
return [twapi::new_uuid] |
|
} |
|
} |
|
|
|
proc default_antiglob_dir_core {} { |
|
variable default_antiglob_dir_core |
|
return $default_antiglob_dir_core |
|
} |
|
proc default_antiglob_file_core {} { |
|
variable default_antiglob_file_core |
|
if {$default_antiglob_file_core eq ""} { |
|
set default_antiglob_file_core [list "*.swp" "*[punk::mix::util::magic_tm_version]*" "*-buildversion.txt" ".punkcheck"] |
|
} |
|
return $default_antiglob_file_core |
|
} |
|
|
|
|
|
proc load_records_from_file {punkcheck_file} { |
|
set record_list [list] |
|
if {[file exists $punkcheck_file]} { |
|
set tdlscript [punk::mix::util::fcat $punkcheck_file] |
|
if {[catch { |
|
set record_list [punk::tdl::prettyparse $tdlscript] |
|
} errparse]} { |
|
error "punkcheck::load_records_from_file failed to parse '$punkcheck_file'\n error:$errparse" |
|
} |
|
} |
|
return $record_list |
|
} |
|
proc save_records_to_file {recordlist punkcheck_file} { |
|
set newtdl [punk::tdl::prettyprint $recordlist] |
|
set linecount [llength [split $newtdl \n]] |
|
#puts stdout $newtdl |
|
set fd [open $punkcheck_file w] |
|
chan configure $fd -translation binary |
|
puts -nonewline $fd $newtdl |
|
close $fd |
|
return [list recordcount [llength $recordlist] linecount $linecount] |
|
} |
|
|
|
|
|
#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 |
|
#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. |
|
# |
|
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 {} { |
|
#set fields [list\ |
|
# -targets $o_targets\ |
|
# -keep_installrecords $o_keep_installrecords\ |
|
# -keep_skipped $o_keep_skipped\ |
|
# -keep_inprogress $o_keep_inprogress\ |
|
# body $o_records\ |
|
#] |
|
|
|
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 |
|
oo::class create installevent { |
|
variable o_id |
|
variable o_rel_sourceroot |
|
variable o_rel_targetroot |
|
variable o_ts_begin |
|
variable o_ts_end |
|
variable o_types |
|
variable o_configdict |
|
variable o_targets |
|
variable o_operation |
|
variable o_operation_start_ts |
|
variable o_path_cksum_cache |
|
variable o_fileset_record |
|
variable o_installer ;#parent object |
|
constructor {installer rel_sourceroot rel_targetroot args} { |
|
set o_installer $installer |
|
set o_operation_start_ts "" |
|
set o_path_cksum_cache [dict create] |
|
set o_operation "" |
|
set defaults [dict create\ |
|
-id ""\ |
|
-tsbegin ""\ |
|
-config [list]\ |
|
-tsend ""\ |
|
-types [list]\ |
|
] |
|
set opts [dict merge $defaults $args] |
|
if {[dict get $opts -id] eq ""} { |
|
set o_id [punkcheck::uuid] |
|
} else { |
|
set o_id [dict get $opts -id] |
|
} |
|
if {[dict get $opts -tsbegin] eq ""} { |
|
set o_ts_begin [clock microseconds] |
|
} else { |
|
set o_ts_begin [dict get $opts -tsbegin] |
|
} |
|
set o_ts_end [dict get $opts -tsend] |
|
set o_types [dict get $opts -types] |
|
set o_configdict [dict get $opts -config] |
|
|
|
set o_rel_sourceroot $rel_sourceroot |
|
set o_rel_targetroot $rel_targetroot |
|
} |
|
destructor { |
|
#puts "[self] destructor called" |
|
} |
|
method as_record {} { |
|
set begin_seconds [expr {$o_ts_begin / 1000000}] |
|
set tsiso_begin [clock format $begin_seconds -format "%Y-%m-%dT%H:%M:%S"] |
|
if {$o_ts_end ne ""} { |
|
set end_seconds [expr {$o_ts_end / 1000000}] |
|
set tsiso_end [clock format $end_seconds -format "%Y-%m-%dT%H:%M:%S"] |
|
} else { |
|
set tsiso_end "" |
|
} |
|
#set fields [list\ |
|
# -tsiso_begin $tsiso_begin\ |
|
# -ts_begin $o_ts_begin\ |
|
# -tsiso_end $tsiso_end\ |
|
# -ts_end $o_ts_end\ |
|
# -id $o_id\ |
|
# -source $o_rel_sourceroot\ |
|
# -targets $o_rel_targetroot\ |
|
# -types $o_types\ |
|
# -config $o_configdict\ |
|
#] |
|
#set record [dict create tag EVENT {*}$fields] |
|
|
|
dict create \ |
|
tag EVENT\ |
|
-tsiso_begin $tsiso_begin\ |
|
-ts_begin $o_ts_begin\ |
|
-tsiso_end $tsiso_end\ |
|
-ts_end $o_ts_end\ |
|
-id $o_id\ |
|
-source $o_rel_sourceroot\ |
|
-targets $o_rel_targetroot\ |
|
-types $o_types\ |
|
-config $o_configdict |
|
|
|
} |
|
method get_id {} { |
|
return $o_id |
|
} |
|
method get_operation {} { |
|
return $o_operation |
|
} |
|
method get_targets {} { |
|
return $o_targets |
|
} |
|
method get_targets_exist {} { |
|
set punkcheck_folder [file dirname [$o_installer get_checkfile]] |
|
#puts stdout "### punkcheck glob -dir $punkcheck_folder -tails {*}$o_targets" |
|
#targets can be paths such as punk/mix/commandset/module-0.1.0.tm - glob can search levels below supplied -dir |
|
set existing [glob -nocomplain -dir $punkcheck_folder -tails {*}$o_targets] |
|
|
|
return $existing |
|
} |
|
method end {} { |
|
set o_ts_end [clock microseconds] |
|
} |
|
method targetset_dict {} { |
|
punk::records_as_target_dict [$o_installer get_recordlist] |
|
} |
|
|
|
#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] |
|
if {[string toupper $operation] ni $known_ops} { |
|
error "[self] add_target unknown operation '$operation'. Known operations $known_ops" |
|
} |
|
set o_operation [string toupper $operation] |
|
|
|
if {$o_operation_start_ts ne ""} { |
|
error "[self] targetset_init $o_operation operation already in progress. Use targetset_finished or targetset_complete to finish." |
|
} |
|
set o_operation_start_ts [clock microseconds] |
|
set seconds [expr {$o_operation_start_ts / 1000000}] |
|
set tsiso [clock format $seconds -format "%Y-%m-%dT%H:%M:%S"] |
|
set punkcheck_file [$o_installer get_checkfile] |
|
set punkcheck_folder [file dirname $punkcheck_file] |
|
|
|
set relativepath_targetset [list] |
|
if {$o_operation eq "VIRTUAL"} { |
|
foreach p $targetset { |
|
lappend relativepath_targetset $p |
|
} |
|
} else { |
|
foreach p $targetset { |
|
if {[file pathtype $p] eq "absolute"} { |
|
lappend relativepath_targetset [punkcheck::lib::path_relative $punkcheck_folder $p] |
|
} else { |
|
lappend relativepath_targetset $p |
|
} |
|
} |
|
} |
|
|
|
|
|
set fields [list\ |
|
-tsiso $tsiso\ |
|
-ts $o_operation_start_ts\ |
|
-installer [$o_installer get_name]\ |
|
-eventid $o_id\ |
|
] |
|
|
|
set o_targets [lsort -dictionary -increasing $relativepath_targetset] ;#exact sort order not critical - but must be consistent |
|
|
|
#set targetdict [my targetset_dict] |
|
|
|
set record_list [punkcheck::load_records_from_file $punkcheck_file] |
|
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 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_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] |
|
} |
|
if {$o_operation ne "QUERY"} { |
|
punkcheck::save_records_to_file $record_list $punkcheck_file |
|
} |
|
return $o_fileset_record |
|
|
|
} |
|
#operation has been started |
|
#todo - upgrade .punkcheck format to hold more than just list of SOURCE entries in each record. |
|
# - allow arbitrary targetset_startphase <name> targetset_endphase <name> 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] |
|
|
|
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 |
|
|
|
lset fileinfo_body end $installing_record |
|
|
|
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]] |
|
} |
|
} |
|
method targetset_end {status args} { |
|
set defaults [dict create\ |
|
-note \uFFFF\ |
|
] |
|
set known_opts [dict keys $defaults] |
|
if {[llength $args] % 2} { |
|
error "targetset_end arguments after status must be in the form of -flag value pairs. known flags: $known_opts" |
|
} |
|
set opts [dict merge $defaults $args] |
|
if {[dict get $opts -note] eq "\uFFFF"} { |
|
dict unset opts -note |
|
} |
|
|
|
set status [string toupper $status] |
|
set statusdict [dict create OK RECORD SKIPPED SKIPPED FAILED FAILED] |
|
if {$o_operation_start_ts eq ""} { |
|
error "[self] targetset_end $status - no current operation - call targetset_started first" |
|
} |
|
if {$status ni [dict keys $statusdict]} { |
|
error "[self] targetset_end unrecognized status:$status known values: [dict keys $statusdict]" |
|
} |
|
if {![punkcheck::lib::is_file_record_inprogress $o_fileset_record]} { |
|
error "targetset_end $status error: bad fileset_record - expected FILEINFO with last body element *-INPROGRESS" |
|
} |
|
set targetlist [dict get $o_fileset_record -targets] |
|
if {$targetlist ne $o_targets} { |
|
error "targetset_end $status error. targetlist mismatch between file : $targetlist vs $o_targets" |
|
} |
|
set operation_end_ts [clock microseconds] |
|
set elapsed_us [expr {$operation_end_ts - $o_operation_start_ts}] |
|
set file_record_body [dict get $o_fileset_record body] |
|
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}] |
|
dict set installing_record -transfer_us $transfer_us |
|
} |
|
if {[dict exists $opts -note]} { |
|
dict set installing_record -note [dict get $opts -note] |
|
} |
|
|
|
dict set installing_record -elapsed_us $elapsed_us |
|
dict unset installing_record -tempcontext |
|
dict set installing_record tag "${o_operation}-[dict get $statusdict $status]" ;# e.g INSTALL-RECORD, INSTALL-SKIPPED |
|
if {$o_operation in [list INSTALL MODIFY] && [dict get $statusdict $status] eq "RECORD"} { |
|
#only calculate and store post operation target cksums on successful INSTALL or MODIFY, doesn't make sense for DELETE or VIRTUAL operations |
|
set new_targets_cksums [list] ;#ordered list of cksums matching targetset order |
|
set cksum_all_opts "" ;#same cksum opts for each target so we store it once |
|
set ts_begin_cksum [clock microseconds] |
|
foreach p $o_targets { |
|
set tgt_cksum_info [punk::mix::base::lib::cksum_path [file join $punkcheck_folder $p]] |
|
lappend new_targets_cksums [dict get $tgt_cksum_info cksum] |
|
if {$cksum_all_opts eq ""} { |
|
set cksum_all_opts [dict get $tgt_cksum_info opts] |
|
} |
|
} |
|
set cksum_us [expr {[clock microseconds] - $ts_begin_cksum}] |
|
dict set installing_record -targets_cksums $new_targets_cksums |
|
dict set installing_record -cksum_all_opts $cksum_all_opts |
|
dict set installing_record -cksum_us $cksum_us |
|
} |
|
lset file_record_body end $installing_record |
|
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 |
|
} |
|
set o_operation_start_ts "" |
|
set o_operation "" |
|
return $o_fileset_record |
|
} |
|
#can supply empty cksum value |
|
# - that will influence the opts used if there is no existing install record |
|
method targetset_cksumcache_set {path_cksum_dict} { |
|
set o_path_cksum_cache $path_cksum_dict |
|
} |
|
method targetset_cksumcache_configure {path {cksuminfodict {}}} { |
|
if {$cksuminfodict eq {}} { |
|
if {[dict exists $o_path_cksum_cache $path]} { |
|
return [dict get $o_path_cksum_cache $path] |
|
} else { |
|
return |
|
} |
|
} |
|
dict for {k v} $cksuminfodict { |
|
switch -- $k { |
|
cksum - opts {} |
|
default { |
|
error "targetset_cksumcache_configure error. Unknown dict value $k. Allowed values {cksum opts}" |
|
} |
|
} |
|
} |
|
dict set o_path_cksum_cache $path $cksuminfodict |
|
} |
|
method targetset_addsource {source_path} { |
|
set punkcheck_file [$o_installer get_checkfile] |
|
set punkcheck_folder [file dirname $punkcheck_file] |
|
if {[file pathtype $source_path] eq "absolute"} { |
|
set rel_source_path [punkcheck::lib::path_relative $punkcheck_folder $source_path] |
|
} else { |
|
set rel_source_path $source_path |
|
} |
|
|
|
#installfile_add_source_and_fetch_metadata accepts list of {cksum <val> opt <cksum opts>} dictionaries - although we only have one per path from our configured cksumcache |
|
if {[dict exists $o_path_cksum_cache $rel_source_path]} { |
|
set path_cksum_caches [list [dict get $o_path_cksum_cache $rel_source_path]] |
|
} else { |
|
set path_cksum_caches [list] |
|
} |
|
set o_fileset_record [punkcheck::installfile_add_source_and_fetch_metadata $punkcheck_folder $rel_source_path $o_fileset_record $path_cksum_caches] |
|
#JJJ - update -metadata_us here? |
|
|
|
} |
|
method targetset_last_complete {} { |
|
#retrieve last completed record for the fileset ie exclude SKIPPED,INSTALL-INPROGRESS,DELETE-INPROGRESS,MODIFY-INPROGRESS |
|
set body [punkcheck::dict_getwithdefault $o_fileset_record body [list]] |
|
set previous_records [lrange $body 0 end] |
|
#get last that is tagged INSTALL-RECORD,MODIFY-RECORD,DELETE-RECORD |
|
set revlist [lreverse $previous_records] |
|
foreach rec $revlist { |
|
if {[dict get $rec tag] in [list "INSTALL-RECORD" "MODIFY-RECORD" "DELETE-RECORD" "VIRTUAL-RECORD"]} { |
|
return $rec |
|
} |
|
} |
|
return [list] |
|
|
|
} |
|
method targetset_source_changes {} { |
|
punkcheck::recordlist::file_install_record_source_changes [lindex [dict get $o_fileset_record body] end] |
|
} |
|
|
|
} |
|
|
|
|
|
oo::class create installtrack { |
|
variable o_name |
|
variable o_tsiso |
|
variable o_ts |
|
variable o_keep_events |
|
variable o_checkfile |
|
variable o_sourceroot |
|
variable o_rel_sourceroot |
|
variable o_targetroot |
|
variable o_rel_targetroot |
|
variable o_record_list |
|
variable o_active_event |
|
variable o_events |
|
constructor {installername punkcheck_file} { |
|
set o_active_event "" |
|
set o_name $installername |
|
|
|
set o_checkfile [file normalize $punkcheck_file] |
|
set o_sourceroot "" |
|
set o_targetroot "" |
|
set o_rel_sourceroot "" |
|
set o_rel_targetroot "" |
|
#todo - validate punkcheck file location further?? |
|
set punkcheck_folder [file dirname $o_checkfile] |
|
if {![file isdirectory $punkcheck_folder]} { |
|
error "[self] constructor error. Folder for punkcheck_file not found - $o_checkfile" |
|
} |
|
|
|
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} { |
|
set this_installer_record [punkcheck::recordlist::new_installer_record $o_name] |
|
set o_record_list [linsert $o_record_list 0 $this_installer_record] |
|
} else { |
|
set this_installer_record [dict get $resultinfo record] |
|
} |
|
set o_tsiso [dict get $this_installer_record -tsiso] |
|
set o_ts [dict get $this_installer_record -ts] |
|
set o_keep_events [dict get $this_installer_record -keep_events] |
|
|
|
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] |
|
$o_events add $eobj [dict get $e -id] |
|
} |
|
|
|
} |
|
destructor { |
|
#puts "[self] destructor called" |
|
} |
|
method test {} { |
|
return [self] |
|
} |
|
method get_name {} { |
|
return $o_name |
|
} |
|
method get_checkfile {} { |
|
return $o_checkfile |
|
} |
|
|
|
#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. |
|
method set_source_target {sourceroot targetroot} { |
|
if {[file pathtype $sourceroot] ne "absolute"} { |
|
error "[self] set_source_target error: sourceroot must be absolute path. Received '$sourceroot'" |
|
} |
|
if {[file pathtype $targetroot] ne "absolute"} { |
|
error "[self] set_source_target error: targetroot must be absolute path. Received '$targetroot'" |
|
} |
|
set punkcheck_folder [file dirname $o_checkfile] |
|
set o_sourceroot $sourceroot |
|
set o_targetroot $targetroot |
|
set o_rel_sourceroot [punkcheck::lib::path_relative $punkcheck_folder $sourceroot] |
|
set o_rel_targetroot [punkcheck::lib::path_relative $punkcheck_folder $targetroot] |
|
return [list $o_rel_sourceroot $o_rel_targetroot] |
|
} |
|
#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] |
|
} |
|
|
|
#does not include associated FILEINFO records - as a targetset (FILEINFO record) can be associated with events from multiple installers over time. |
|
#e.g a logfile common to installers, or a separate installer that updates a previous output. |
|
method as_record {} { |
|
set eventrecords [list] |
|
foreach eobj [my events items] { |
|
lappend eventrecords [$eobj as_record] |
|
} |
|
set fields [list\ |
|
-tsiso $o_tsiso\ |
|
-ts $o_ts\ |
|
-name $o_name\ |
|
-keep_events $o_keep_events\ |
|
body $eventrecords\ |
|
] |
|
set record [dict create tag INSTALLER {*}$fields] |
|
} |
|
#open file and save only own records |
|
method save_all_records {} { |
|
my save_installer_record |
|
#todo - save FILEINFO targetset 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] |
|
} else { |
|
lset file_records $existing_header_posn $this_installer_record |
|
} |
|
punkcheck::save_records_to_file $file_records $o_checkfile |
|
} |
|
method events {args} { |
|
tailcall $o_events {*}$args |
|
} |
|
method start_event {configdict} { |
|
if {$o_active_event ne ""} { |
|
error "[self] start_event error - event already started: $o_active_event" |
|
} |
|
if {$o_rel_sourceroot eq "" || $o_rel_targetroot eq ""} { |
|
error "[self] No configured sourceroot or targetroot. Call [self] set_source_target <abspath_sourceroot> <abspath_targetroot> first" |
|
} |
|
|
|
if {[llength $configdict] %2 != 0} { |
|
error "[self] new_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 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 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 |
|
|
|
punkcheck::save_records_to_file $o_record_list $o_checkfile |
|
set o_active_event $eventobj |
|
my events add $eventobj $eventid |
|
return $eventobj |
|
} |
|
method installer_record_from_file {} { |
|
set resultinfo [punkcheck::recordlist::get_installer_record $o_name $o_record_list] |
|
} |
|
method get_recordlist {} { |
|
return $o_recordlist |
|
} |
|
method end_event {} { |
|
if {$o_active_event eq ""} { |
|
error "[self] end_event error - no active event" |
|
} |
|
$o_active_event end |
|
} |
|
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] |
|
} else { |
|
#replace |
|
lset record_list $existing_header_posn $this_installer_record |
|
} |
|
|
|
punkcheck::save_records_to_file $record_list $punkcheck_file |
|
return [list eventid $eventid recordset $record_list] |
|
} |
|
#----------------------------------------------- |
|
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] |
|
} |
|
|
|
save_records_to_file $record_list $punkcheck_file |
|
return $file_record |
|
} |
|
|
|
#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) |
|
#cached_cksums is list of dicts with keys cksum & opts |
|
#Will only be used if any opts values present match those from file_record's -cksum_all_opts (in last install record) or first cached_cksum will be used if no last install record values |
|
proc installfile_add_source_and_fetch_metadata {punkcheck_folder source_relpath file_record {cached_cksums {}}} { |
|
if {![lib::is_file_record_inprogress $file_record]} { |
|
error "installfile_add_source_and_fetch_metadata error: bad file_record - expected FILEINFO with last body element *-INPROGRESS ($file_record)" |
|
} |
|
#validate any passed cached_cksums |
|
foreach cacheinfo $cached_cksums { |
|
if {[llength $cacheinfo] % 2 != 0} { |
|
error "installfile_add_source_and_fetch_metadata error.If cached_cksums is supplied, it must be a list of dicts containing keys cksum & opts" |
|
} |
|
dict for {k v} $cacheinfo { |
|
switch -- $k { |
|
cksum {} |
|
opts { |
|
#todo - validate $v keys |
|
} |
|
default { |
|
error "installfile_add_source_and_fetch_metadata error. Unrecognised key $k. Known keys {cksum opts}" |
|
} |
|
} |
|
|
|
} |
|
} |
|
set ts_start [clock microseconds] |
|
set last_installrecord [lib::file_record_get_last_installrecord $file_record] |
|
set prev_ftype "" |
|
set prev_fsize "" |
|
set prev_cksum "" |
|
set prev_cksum_opts "" |
|
if {[llength $last_installrecord]} { |
|
set src [lib::install_record_get_matching_source_record $last_installrecord $source_relpath] |
|
if {[llength $src]} { |
|
if {[dict_getwithdefault $src -path ""] eq $source_relpath} { |
|
set prev_ftype [dict_getwithdefault $src -type ""] |
|
set prev_fsize [dict_getwithdefault $src -size ""] |
|
set prev_cksum [dict_getwithdefault $src -cksum ""] |
|
set prev_cksum_opts [dict_getwithdefault $src -cksum_all_opts ""] |
|
} |
|
} |
|
} |
|
#check that this relpath not already added as child of *-INPROGRESS |
|
set file_record_body [dict_getwithdefault $file_record body [list]] ;#new file_record may have no body |
|
set installing_record [lindex $file_record_body end] |
|
set already_present_record [lib::install_record_get_matching_source_record $installing_record $source_relpath] |
|
if {[llength $already_present_record]} { |
|
error "installfile_add_source_and_fetch_metadata error: source path $source_relpath already exists in the file_record - cannot add again" |
|
} |
|
|
|
set use_cache 0 |
|
if {$prev_cksum_opts ne ""} { |
|
set cksum_opts $prev_cksum_opts |
|
#find first cached_cksum that is compatible with cksum opts used in latest install record |
|
foreach cacheinfo $cached_cksums { |
|
set cachedopts [dict get $cacheinfo opts] |
|
set cache_is_match 1 |
|
dict for {k v} $cachedopts { |
|
if {[dict exists $prev_cksum_opts $k] && $v ne [dict get $prev_cksum_opts $k]} { |
|
set cache_is_match 0 |
|
break |
|
} |
|
} |
|
if {$cache_is_match} { |
|
set use_cache_record $cacheinfo |
|
set use_cache 1 |
|
break |
|
} |
|
} |
|
|
|
} else { |
|
#no cksum opts available from an install record |
|
set cksum_opts "" |
|
#use first entry in cached_cksums if we can |
|
if {[llength $cached_cksums]} { |
|
set use_cache 1 |
|
set use_cache_record [lindex $cached_cksums 0] |
|
} |
|
} |
|
|
|
#todo - accept argument of cached source cksum info (for client calling multiple targets with same source in quick succession e.g when building .vfs kits with multiple runtimes) |
|
#if same cksum_opts - then use cached data instead of checksumming here. |
|
|
|
#allow nonexistant as a source |
|
set fpath [file join $punkcheck_folder $source_relpath] |
|
#windows: file exist + file type = 2ms vs 500ms for 2x glob |
|
set floc [file dirname $fpath] |
|
set fname [file tail $fpath] |
|
set file_set [glob -nocomplain -dir $floc -type f -tails $fname] |
|
set dir_set [glob -nocomplain -dir $floc -type d -tails $fname] |
|
set link_set [glob -nocomplain -dir $floc -type l -tails $fname] |
|
if {[llength $file_set] == 0 && [llength $dir_set] == 0 && [llength $link_set] == 0} { |
|
#could also theoretically exist as less common types, b,c,p,s (block,char,pipe,socket) |
|
#- we don't expect them here - REVIEW - ever possible? |
|
#- installing/examining such things an unlikely usecase and would require special handling anyway. |
|
set ftype "missing" |
|
set fsize "" |
|
} else { |
|
if {[llength $dir_set]} { |
|
set ftype "directory" |
|
set fsize "NA" |
|
} elseif {[llength $link_set]} { |
|
set ftype "link" |
|
set fsize 0 |
|
} else { |
|
set ftype "file" |
|
#todo - optionally use mtime instead of cksum (for files only)? |
|
#mtime is not reliable across platforms and filesystems though.. see article linked at top. |
|
set fsize [file size $fpath] |
|
} |
|
} |
|
|
|
#if {![file exists $fpath]} { |
|
# set ftype "missing" |
|
# set fsize "" |
|
#} else { |
|
# set ftype [file type $fpath] |
|
# if {$ftype eq "directory"} { |
|
# set fsize "NA" |
|
# } else { |
|
# #todo - optionally use mtime instead of cksum (for files only)? |
|
# #mtime is not reliable across platforms and filesystems though.. see article linked at top. |
|
# set fsize [file size $fpath] |
|
# } |
|
#} |
|
#get_relativecksum_from_base and fill_relativecksums_from_base_and_relativepathdict will set cksum to <PATHNOTFOUND> if fpath doesn't exist |
|
if {$use_cache} { |
|
set source_cksum_info [punk::mix::base::lib::fill_relativecksums_from_base_and_relativepathdict $punkcheck_folder [dict create $source_relpath $use_cache_record]] |
|
} else { |
|
set source_cksum_info [punk::mix::base::lib::get_relativecksum_from_base $punkcheck_folder $source_relpath {*}$cksum_opts] |
|
} |
|
|
|
|
|
lassign $source_cksum_info pathkey ckinfo |
|
if {$pathkey ne $source_relpath} { |
|
error "installfile_add_source_and_fetch_metadata error: cksum returned wrong path info '$pathkey' expected '$source_relpath'" |
|
} |
|
set cksum [dict get $ckinfo cksum] |
|
#set cksum_all_opts [dict get $ckinfo cksum_all_opts] |
|
set cksum_all_opts [dict get $ckinfo opts] |
|
if {$cksum ne $prev_cksum || $ftype ne $prev_ftype || $fsize ne $prev_fsize} { |
|
set changed 1 |
|
} else { |
|
set changed 0 |
|
} |
|
set installing_record_sources [dict_getwithdefault $installing_record body [list]] |
|
set ts_now [clock microseconds] ;#gathering metadata - especially checksums on folder can take some time - calc and store elapsed us for time taken to gather metadata |
|
set metadata_us [expr {$ts_now - $ts_start}] |
|
set this_source_record [dict create tag SOURCE -type $ftype -size $fsize -path $source_relpath -cksum $cksum -cksum_all_opts $cksum_all_opts -changed $changed -metadata_us $metadata_us] |
|
lappend installing_record_sources $this_source_record |
|
dict set installing_record body $installing_record_sources |
|
|
|
lset file_record_body end $installing_record |
|
|
|
dict set file_record body $file_record_body |
|
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 |
|
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 |
|
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 |
|
return $file_record |
|
} |
|
#----------------------------------------------- |
|
#then: file_record_add_installrecord |
|
|
|
namespace eval lib { |
|
set pkg punkcheck |
|
namespace path ::punkcheck |
|
proc is_file_record_inprogress {file_record} { |
|
if {[dict get $file_record tag] ne "FILEINFO"} { |
|
return 0 |
|
} |
|
set installing_record [lindex [dict_getwithdefault $file_record body [list]] end] |
|
if {[dict_getwithdefault $installing_record tag [list]] ni [list QUERY-INPROGRESS INSTALL-INPROGRESS MODIFY-INPROGRESS DELETE-INPROGRESS VIRTUAL-INPROGRESS]} { |
|
return 0 |
|
} |
|
return 1 |
|
} |
|
proc is_file_record_installing {file_record} { |
|
if {[dict get $file_record tag] ne "FILEINFO"} { |
|
return 0 |
|
} |
|
set installing_record [lindex [dict_getwithdefault $file_record body [list]] end] |
|
if {[dict_getwithdefault $installing_record tag [list]] ne "INSTALL-INPROGRESS"} { |
|
return 0 |
|
} |
|
return 1 |
|
} |
|
proc file_record_get_last_installrecord {file_record} { |
|
set body [dict_getwithdefault $file_record body [list]] |
|
set previous_install_records [lrange $body 0 end-1] |
|
#get last previous that is tagged INSTALL-RECORD,MODIFY-RECORD,VIRTUAL-RECORD |
|
#REVIEW DELETERECORD ??? |
|
set revlist [lreverse $previous_install_records] |
|
foreach rec $revlist { |
|
if {[dict get $rec tag] in [list "INSTALL-RECORD" "MODIFY-RECORD" "VIRTUAL-RECORD"]} { |
|
return $rec |
|
} |
|
} |
|
return [list] |
|
} |
|
|
|
#should work on *-INPROGRESS or INSTALL(etc) record - don't restrict tag to INSTALL |
|
proc install_record_get_matching_source_record {install_record source_relpath} { |
|
set body [dict_getwithdefault $install_record body [list]] |
|
foreach src $body { |
|
if {[dict get $src tag] eq "SOURCE"} { |
|
if {[dict_getwithdefault $src -path ""] eq $source_relpath} { |
|
return $src |
|
} |
|
} |
|
} |
|
return [list] |
|
} |
|
|
|
|
|
|
|
#maint warning - also in punk::mix::util |
|
proc path_relative {base dst} { |
|
#see also kettle |
|
# Modified copy of ::fileutil::relative (tcllib) |
|
# Adapted to 8.5 ({*}). |
|
# |
|
# Taking two _directory_ paths, a base and a destination, computes the path |
|
# of the destination relative to the base. |
|
# |
|
# Arguments: |
|
# base The path to make the destination relative to. |
|
# dst The destination path |
|
# |
|
# Results: |
|
# The path of the destination, relative to the base. |
|
|
|
# Ensure that the link to directory 'dst' is properly done relative to |
|
# the directory 'base'. |
|
|
|
#review - check volume info on windows.. UNC paths? |
|
if {[file pathtype $base] ne [file pathtype $dst]} { |
|
return -code error "Unable to compute relation for paths of different pathtypes: [file pathtype $base] vs. [file pathtype $dst], ($base vs. $dst)" |
|
} |
|
|
|
#avoid normalizing if possible - at least for relative paths which we are likely to loop on (file normalize *very* expensive on windows) |
|
set do_normalize 0 |
|
if {[file pathtype $base] eq "relative"} { |
|
#if base is relative so is dst |
|
if {[regexp {[.]{2}} [list $base $dst]]} { |
|
set do_normalize 1 |
|
} |
|
if {[regexp {[.]/} [list $base $dst]]} { |
|
set do_normalize 1 |
|
} |
|
} else { |
|
#case differences in volumes is common on windows |
|
set do_normalize 1 |
|
} |
|
if {$do_normalize} { |
|
set base [file normalize $base] |
|
set dst [file normalize $dst] |
|
} |
|
|
|
set save $dst |
|
set base [file split $base] |
|
set dst [file split $dst] |
|
|
|
while {[lindex $dst 0] eq [lindex $base 0]} { |
|
set dst [lrange $dst 1 end] |
|
set base [lrange $base 1 end] |
|
if {![llength $dst]} {break} |
|
} |
|
|
|
set dstlen [llength $dst] |
|
set baselen [llength $base] |
|
|
|
if {($dstlen == 0) && ($baselen == 0)} { |
|
# Cases: |
|
# (a) base == dst |
|
|
|
set dst . |
|
} else { |
|
# Cases: |
|
# (b) base is: base/sub = sub |
|
# dst is: base = {} |
|
|
|
# (c) base is: base = {} |
|
# dst is: base/sub = sub |
|
|
|
while {$baselen > 0} { |
|
set dst [linsert $dst 0 ..] |
|
incr baselen -1 |
|
} |
|
set dst [file join {*}$dst] |
|
} |
|
|
|
return $dst |
|
} |
|
} |
|
#skip writing punkcheck during checksum/timestamp checks |
|
|
|
#todo - punk::args - fetch from punkcheck::install (with overrides) |
|
proc install_tm_files {srcdir basedir args} { |
|
set defaults [list\ |
|
-glob *.tm\ |
|
-antiglob_file [list "*[punk::mix::util::magic_tm_version]*"]\ |
|
-installer punkcheck::install_tm_files\ |
|
] |
|
set opts [dict merge $defaults $args] |
|
punkcheck::install $srcdir $basedir {*}$opts |
|
} |
|
proc install_non_tm_files {srcdir basedir args} { |
|
#set keys [dict keys $args] |
|
#adjust the default antiglob_dir_core entries so that .fossil-custom, .fossil-settings are copied |
|
set antiglob_dir_core [punkcheck::default_antiglob_dir_core] |
|
set posn [lsearch $antiglob_dir_core ".fossil*"] |
|
if {$posn >=0} { |
|
set antiglob_dir_core [lreplace $antiglob_dir_core $posn $posn] |
|
} |
|
set defaults [list\ |
|
-glob *\ |
|
-antiglob_file [list "*.tm" "*-buildversion.txt" "*.exe"]\ |
|
-antiglob_dir_core $antiglob_dir_core\ |
|
-installer punkcheck::install_non_tm_files\ |
|
] |
|
set opts [dict merge $defaults $args] |
|
punkcheck::install $srcdir $basedir {*}$opts |
|
} |
|
|
|
#for tcl8.6 - tcl8.7+ has dict getwithdefault (dict getdef) |
|
proc dict_getwithdefault {dictValue args} { |
|
if {[llength $args] < 2} { |
|
error {wrong # args: should be "dict_getdef dictionary ?key ...? key default"} |
|
} |
|
set keys [lrange $args 0 end-1] |
|
if {[dict exists $dictValue {*}$keys]} { |
|
return [dict get $dictValue {*}$keys] |
|
} else { |
|
return [lindex $args end] |
|
} |
|
} |
|
lappend PUNKARGS [list { |
|
@id -id ::punkcheck::install |
|
@cmd -name ::punkcheck::install -help\ |
|
"Unidirectional file transfer to possibly non-empty target folder. |
|
This is the simpler form of the API, performing a transfer from one |
|
directory tree to another, copying each file when changes in the source |
|
file are detected. |
|
Changes are detected by content checksum. The first install will record |
|
source checksums in a .punkcheck file (ideally located at the root of the |
|
target folder). Subsequent installs will compare stored checksums with |
|
the current checksums of the source files. |
|
For more advanced install operations, the object command installtrack |
|
can be used to define install operations. e.g when the transfer is not |
|
one-to-one and a target file depends on multiple source files." |
|
@leaders -min 2 -max 2 |
|
srcdir -type directory |
|
tgtdir -type directory |
|
-call-depth-internal -type integer -default 0 -help "(internal recursion tracker)" |
|
-subdirlist -type list -default "" -help "(primarily internal - length generally matching -call-depth-internal)" |
|
-max_depth -type integer -default 1000 -help\ |
|
"Deepest subdirectory - use -1 for no limit." |
|
-createdir -type boolean -default 0 -help\ |
|
"Whether to create the folder at tgtdir. |
|
Any required subdirectories are created regardless of this setting." |
|
-createempty -type boolean -default 0 -help\ |
|
"Whether to create folders at target that had no matches for our glob" |
|
-glob -type string -default "*" -help\ |
|
"Pattern matching for source file(s) to copy. Can be glob based or exact match." |
|
-antiglob_file_core -default {${[::punkcheck::default_antiglob_file_core]}} |
|
-antiglob_file -default "" |
|
-antiglob_dir_core -default {${[::punkcheck::default_antiglob_dir_core]}} |
|
-antiglob_dir -default "" |
|
-antiglob_paths -default {} |
|
-overwrite -default no-targets\ |
|
-choices {no-targets newer-targets older-targets all-targets installedsourcechanged-targets synced-targets}\ |
|
-choicecolumns 1\ |
|
-choicelabels { |
|
no-targets "only copy files that are missing at the target" |
|
newer-targets "copy files with older source timestamp over newer |
|
target timestamp and those missing at the target |
|
(a form of 'restore' operation)" |
|
older-targets "copy files with newer source timestamp over older |
|
target timestamp and those missing at the target" |
|
all-targets "copy regardless of timestamp at target" |
|
installedsourcechanged-targets "copy if the target doesn't exist or the source changed" |
|
synced-targets "copy if the target doesn't exist or the source changed |
|
and the target cksum is the same as the last INSTALL-RECORD -targets_cksums entry" |
|
} |
|
-source_checksum -default comparestore -choicecolumns 3 -choices {compare store comparestore false true}\ |
|
-choicelabels { |
|
true "same as comparestore" |
|
} |
|
-punkcheck_folder -default target -choices {target source project} -choicerestricted 0 -help\ |
|
"The location of the .punkcheck file to track installations and checksums. |
|
The default value 'target' is generally recommended. |
|
Can also be an absolute path to a folder." |
|
-punkcheck_records -default "" -help\ |
|
"Empty string or a parsed TDL records structure. |
|
e.g |
|
{tag FILEINFO -<opt> <val>... body { |
|
{tag INSTALL-RECORD -<opt> <val>... body {<sublist>}} |
|
... |
|
}... |
|
}" |
|
-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." |
|
-progresschannel -default none -type string -help\ |
|
"Name of channel e.g stderr, stdout to which progress messages are written. |
|
This includes the tree-like output consisting of dots (or green U) for each |
|
file processed. As the number of files in a tree is not known beforehand, |
|
it isn't useful for a percentage-based progress meter, but it could potentially |
|
be used to drive a spinner if the textual data is not desired. |
|
Setting to none or an invalid channel will deactivate the output." |
|
}] |
|
## unidirectional file transfer to possibly non empty folder |
|
#default of -overwrite no-targets will only copy files that are missing at the target |
|
# -overwrite newer-targets will copy files with older source timestamp over newer target timestamp and those missing at the target (a form of 'restore' operation) |
|
# -overwrite older-targets will copy files with newer source timestamp over older target timestamp and those missing at the target |
|
# -overwrite all-targets will copy regardless of timestamp at target |
|
# -overwrite installedsourcechanged-targets will copy if the target doesn't exist or the source changed |
|
# -overwrite synced-targets will copy if the target doesn't exist or the source changed and the target cksum is the same as the last INSTALL-RECORD -targets_cksums entry |
|
# review - timestamps unreliable |
|
# - what about slightly mismatched system clocks and mounted filesystems? caller responsibility to verify first? |
|
# if timestamp exactly equal - should we check content-hash? This is presumably only likely to occur deliberately(maliciously?) |
|
# e.g some process that digitally signs or otherwise modifies a file and preserves update timestmp? |
|
# if such a content-mismatch - what default behaviour and what options would make sense? |
|
# probably it's reasonable that only all-targets would overwrite such files. |
|
# consider -source_fudge_seconds +-X ?, -source_override_timestamp ts ??? etc which only adjust timestamp for calculation purposes? Define a specific need/usecase when reviewing. |
|
# |
|
# valid filetypes for src tgt |
|
# src dir tgt dir |
|
# todo - review and consider enabling symlink src and dst |
|
# no need for src file - as we use -glob with no glob characters to match one source file file |
|
# no ability to target file with different name - keep it simpler and caller will have to use an intermediate folder/file if they need to rename something? |
|
# |
|
# todo - determine what happens if mismatch between file type of a src vs target e.g target has dir matching filename at source |
|
# A pre-scan to determine no such conflict - before attempting to copy anything might provide the most integrity at slight cost in speed. |
|
# REVIEW we should only expect dirs to be created as necessary to hold files? i.e target folder won't be created if no source file matches for that folder |
|
# -source_checksum compare|store|comparestore|false|true where true == comparestore |
|
# -punkcheck_folder target|source|project|<absolutepath> target is default and is generally recommended |
|
# -punkcheck_records empty string | parsed TDL records ie {tag xxx k v} structure |
|
# install creates FILEINFO records with a single entry in the -targets field (it is legitimate to have a list of targets for an installation operation - the oo interface supports this) |
|
proc install {srcdir tgtdir args} { |
|
set defaults [list\ |
|
-call-depth-internal 0\ |
|
-max_depth 1000\ |
|
-subdirlist {}\ |
|
-createdir 0\ |
|
-createempty 0\ |
|
-glob *\ |
|
-antiglob_file_core "\uFFFF"\ |
|
-antiglob_file "" \ |
|
-antiglob_dir_core "\uFFFF"\ |
|
-antiglob_dir {}\ |
|
-antiglob_paths {}\ |
|
-overwrite no-targets\ |
|
-source_checksum comparestore\ |
|
-punkcheck_folder target\ |
|
-punkcheck_eventid "\uFFFF"\ |
|
-punkcheck_records ""\ |
|
-installer punkcheck::install\ |
|
-progresschannel none\ |
|
] |
|
|
|
if {([llength $args] %2) != 0} { |
|
error "punkcheck::install requires option-style arguments to be in pairs. Received args: $args" |
|
} |
|
foreach {k -} $args { |
|
if {$k ni [dict keys $defaults]} { |
|
error "punkcheck::install unrecognised option '$k' known options: '[dict keys $defaults]'" |
|
} |
|
} |
|
set opts [dict merge $defaults $args] |
|
|
|
#The choice to recurse using the original values of srcdir & tgtdir, and passing the subpath down as a list in -subdirlist seems an odd one. |
|
#(as opposed to a more 'standard' mechanism of adjusting srcdir & tgtdir as we move down the tree) |
|
#It comes from build_modules_from_source_to_base where we need to keep track of position relative to our targetdir starting point to handle submodules e.g pkg::something::mypkg-0.1.tm |
|
#It could have been handled with some other parameter such as -depth, but this -subdirlist mechanism, whilst perhaps not beautiful, is straightforward enough |
|
#and may be less error prone than doing slightly more opaque path manipulations at each recursion level to determine where we started |
|
#For consistency - we'll use the same mechanism in various recursive directory walking procedures such as this one. |
|
set CALLDEPTH [dict get $opts -call-depth-internal] ;#added for extra debug/sanity checking - clearer test for initial function call ie CALLDEPTH = 0 |
|
set max_depth [dict get $opts -max_depth] ;# -1 for no limit |
|
set subdirlist [dict get $opts -subdirlist] ;# generally should be same length as CALLDEPTH - but user could prefill |
|
set fileglob [dict get $opts -glob] |
|
set createdir [dict get $opts -createdir] ;#defaults to zero to help avoid mistakes with initial target dir - required target subdirs are created regardless of this setting |
|
set opt_createempty [dict get $opts -createempty] |
|
set opt_progresschannel [dict get $opts -progresschannel] |
|
if {$opt_progresschannel in {"" none} || [catch {chan configure $opt_progresschannel}]} { |
|
set opt_progresschannel "" |
|
} |
|
|
|
if {$CALLDEPTH == 0} { |
|
#expensive to normalize but we need to do it at least once |
|
set srcdir [file normalize $srcdir] |
|
set tgtdir [file normalize $tgtdir] |
|
if {$createdir} { |
|
file mkdir $tgtdir |
|
} else { |
|
if {![file exists $tgtdir]} { |
|
error "punkcheck::install base target dir:'$tgtdir' doesn't exist (srcdir:$srcdir tgtdir:$tgtdir args:'$args')" |
|
} |
|
} |
|
if {([file type $srcdir] ni [list directory]) || ([file type $tgtdir] ni [list directory])} { |
|
error "punkcheck::install requires source and target dirs to be of type 'directory' type current source: [file type $srcdir] type current target: [file type $tgtdir]" |
|
} |
|
#now the values we build from these will be properly cased |
|
} |
|
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- |
|
set opt_antiglob_file_core [dict get $opts -antiglob_file_core] |
|
if {$opt_antiglob_file_core eq "\uFFFF"} { |
|
set opt_antiglob_file_core [default_antiglob_file_core] |
|
dict set opts -antiglob_file_core $opt_antiglob_file_core |
|
} |
|
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- |
|
set opt_antiglob_file [dict get $opts -antiglob_file] |
|
#validate no path seps |
|
foreach af $opt_antiglob_file { |
|
if {[llength [file split $af]] > 1} { |
|
error "punkcheck::install received invalid -antiglob_file entry '$af'. -antiglob_file entries are meant to match to a file name at any level so cannot contain path separators" |
|
} |
|
} |
|
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- |
|
set opt_antiglob_dir_core [dict get $opts -antiglob_dir_core] |
|
if {$opt_antiglob_dir_core eq "\uFFFF"} { |
|
set opt_antiglob_dir_core [default_antiglob_dir_core] |
|
dict set opts -antiglob_dir_core $opt_antiglob_dir_core |
|
} |
|
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- |
|
set opt_antiglob_dir [dict get $opts -antiglob_dir] |
|
#validate no path seps |
|
foreach ad $opt_antiglob_dir { |
|
if {[llength [file split $ad]] > 1} { |
|
error "punkcheck::install received invalid -antiglob_dir entry '$ad'. -antiglob_dir entries are meant to match to a directory name at any level so cannot contain path separators" |
|
} |
|
} |
|
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- |
|
set opt_antiglob_paths [dict get $opts -antiglob_paths] ;#todo - combine with config file in source tree .punkcheckpublish (?) |
|
#antiglob_paths will usually contain file separators - and may contain glob patterns within each segment |
|
set antiglob_paths_matched [list] |
|
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- |
|
set known_whats [list no-targets newer-targets older-targets all-targets installedsourcechanged-targets synced-targets] |
|
set overwrite_what [string tolower [dict get $opts -overwrite]]; #accept any case for value to allow emphasis by caller e.g -overwrite NEWER-TARGETS |
|
if {$overwrite_what ni $known_whats} { |
|
error "punkcheck::install received unrecognised value for -overwrite. Received value '$overwrite_what' vs known values '$known_whats'" |
|
} |
|
if {$overwrite_what in [list newer-targets older-targets]} { |
|
error "punkcheck::install newer-target, older-targets not implemented - sorry" |
|
#TODO - check crossplatform availability of ctime (on windows it still seems to be creation time, but on bsd/linux it's last attribute mod time) |
|
# external pkg? use twapi and ctime only on other platforms? |
|
} |
|
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- |
|
set opt_source_checksum [dict get $opts -source_checksum] |
|
if {[string is boolean $opt_source_checksum]} { |
|
if {$opt_source_checksum} { |
|
set opt_source_checksum "comparestore" |
|
} else { |
|
set opt_source_checksum 0 |
|
} |
|
dict set opts -source_checksum $opt_source_checksum |
|
} |
|
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- |
|
set opt_punkcheck_folder [dict get $opts -punkcheck_folder] |
|
if {$opt_punkcheck_folder eq "target"} { |
|
set punkcheck_folder $tgtdir |
|
} elseif {$opt_punkcheck_folder eq "source"} { |
|
set punkcheck_folder $srcdir |
|
} elseif {$opt_punkcheck_folder eq "project"} { |
|
set sourceprojectinfo [punk::repo::find_repos $srcdir] |
|
set targetprojectinfo [punk::repo::find_repos $tgtdir] |
|
set srcproj [lindex [dict get $sourceprojectinfo project] 0] |
|
set tgtproj [lindex [dict get $targetprojectinfo project] 0] |
|
if {$srcproj eq $tgtproj} { |
|
set punkcheck_folder $tgtproj |
|
} else { |
|
error "copy_files_from_source_to_target error: Unable to find common project dir for source and target folder - use absolutepath for -punkcheck_folder if source and target are not within same project" |
|
} |
|
} else { |
|
set punkcheck_folder $opt_punkcheck_folder |
|
} |
|
if {$punkcheck_folder ne ""} { |
|
if {[file pathtype $punkcheck_folder] ne "absolute"} { |
|
error "copy_files_from_source_to_target error: -punkcheck_folder '$punkcheck_folder' must be an absolute path, or one of: target|source|project" |
|
} |
|
if {![file isdirectory $punkcheck_folder]} { |
|
error "copy_files_from_source_to_target error: -punkcheck_folder '$punkcheck_folder' not found" |
|
} |
|
} else { |
|
#review - leave empty? use pwd? |
|
} |
|
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- |
|
set punkcheck_records [dict get $opts -punkcheck_records] |
|
set punkcheck_records_init $punkcheck_records ;#change-detection |
|
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- |
|
set opt_installer [dict get $opts -installer] |
|
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- |
|
set opt_punkcheck_eventid [dict get $opts -punkcheck_eventid] |
|
|
|
|
|
|
|
set punkcheck_file [file join $punkcheck_folder/.punkcheck] |
|
|
|
if {$CALLDEPTH == 0} { |
|
set punkcheck_eventid "<invalid>" |
|
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 |
|
} |
|
} else { |
|
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 |
|
set current_target_dir $tgtdir |
|
} else { |
|
set current_source_dir $srcdir/[file join {*}$subdirlist] |
|
set current_target_dir $tgtdir/[file join {*}$subdirlist] |
|
} |
|
|
|
|
|
set relative_target_dir [lib::path_relative $tgtdir $current_target_dir] |
|
if {$relative_target_dir eq "."} { |
|
set relative_target_dir "" |
|
} |
|
set relative_source_dir [lib::path_relative $srcdir $current_source_dir] |
|
if {$relative_source_dir eq "."} { |
|
set relative_source_dir "" |
|
} |
|
set target_relative_to_punkcheck_dir [lib::path_relative $punkcheck_folder $current_target_dir] |
|
if {$target_relative_to_punkcheck_dir eq "."} { |
|
set target_relative_to_punkcheck_dir "" |
|
} |
|
foreach unpub $opt_antiglob_paths { |
|
#puts "testing folder - globmatchpath $unpub $relative_source_dir" |
|
if {[punk::path::globmatchpath $unpub $relative_source_dir]} { |
|
lappend antiglob_paths_matched $current_source_dir |
|
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] |
|
} |
|
} |
|
|
|
|
|
if {![file exists $current_source_dir]} { |
|
error "punkcheck::install current source dir:'$current_source_dir' doesn't exist (srcdir:$srcdir tgtdir:$tgtdir args:'$args')" |
|
} |
|
|
|
set files_copied [list] |
|
set files_skipped [list] |
|
set sources_unchanged [list] |
|
|
|
|
|
set candidate_list [glob -nocomplain -dir $current_source_dir -type f -tail $fileglob] |
|
set hidden_candidate_list [glob -nocomplain -dir $current_source_dir -types {hidden f} -tail $fileglob] |
|
foreach h $hidden_candidate_list { |
|
if {$h ni $candidate_list} { |
|
lappend candidate_list $h |
|
} |
|
} |
|
set match_list [list] |
|
foreach m $candidate_list { |
|
set suppress 0 |
|
foreach anti [concat $opt_antiglob_file_core $opt_antiglob_file] { |
|
if {[string match $anti $m]} { |
|
#puts stderr "anti: $anti vs m:$m" |
|
set suppress 1 |
|
break |
|
} |
|
} |
|
if {$suppress == 0} { |
|
lappend match_list $m |
|
} |
|
} |
|
|
|
#sample .punkcheck file record (raw form) to make the code clearer |
|
#punk::tdl converts to dict form e.g: tag FILEINFO -targets filename body sublist |
|
#Valid installrecord types are INSTALL-RECORD SKIPPED INSTALL-INPROGRESS, MODIFY-RECORD MODIFY-INPROGRESS DELETE-RECORD DELETE-INPROGRESS |
|
# |
|
#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-999999.0a1.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-999999.0a1.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 |
|
# } |
|
#} |
|
|
|
if {[llength $match_list]} { |
|
#example - target dir has a file where there is a directory at the source |
|
if {[file exists $current_target_dir] && ([file type $current_target_dir] ni [list directory])} { |
|
error "punkcheck::install target subfolder $current_target_dir exists but is not of type 'directory'. Type current target folder: [file type $current_target_dir]" |
|
} |
|
} |
|
|
|
#proc get_relativecksum_from_base_and_fullpath {base fullpath args} |
|
|
|
|
|
#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] |
|
set is_antipath 0 |
|
foreach antipath $opt_antiglob_paths { |
|
#puts "testing file - globmatchpath $antipath vs $relative_source_path" |
|
if {[punk::path::globmatchpath $antipath $relative_source_path]} { |
|
lappend antiglob_paths_matched $current_source_dir |
|
set is_antipath 1 |
|
break |
|
} |
|
} |
|
if {$is_antipath} { |
|
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 ""} { |
|
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 |
|
|
|
|
|
if {$opt_progresschannel ne ""} { |
|
if {$last_depth ne $CALLDEPTH} { |
|
if {$CALLDEPTH <=1} { |
|
puts -nonewline $opt_progresschannel \n[string repeat " " $CALLDEPTH][file tail $relative_source_dir] |
|
} |
|
flush $opt_progresschannel |
|
##set last_depth $CALLDEPTH ;# done down below |
|
} |
|
} |
|
|
|
|
|
|
|
set relative_source_path [lib::path_relative $punkcheck_folder $current_source_dir/$m] |
|
#puts stdout " rel_source: $relative_source_path" |
|
#if {[file pathtype $relative_source_path] ne "relative"} { |
|
#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) |
|
set ts1 [clock milliseconds] |
|
set filerec [punkcheck::installfile_add_source_and_fetch_metadata $punkcheck_folder $relative_source_path $filerec] |
|
set ts2 [clock milliseconds] |
|
set diff [expr {$ts2 - $ts1}] |
|
if {$diff > 100} { |
|
#todo -errorchannel |
|
set errprefix ">>> punkcheck:" |
|
puts stderr "\n$errprefix performance warning: fetch_metadata for $m took $diff ms." |
|
set lb [lindex [dict get $filerec body] end] |
|
#puts stderr "$errprefix filerec last body record:$lb" |
|
set records [dict get $lb body] |
|
set lr [lindex $records end] |
|
set alg [dict get $lr -cksum_all_opts -cksum_algorithm] |
|
if {$alg eq "sha1"} { |
|
puts stderr "$errprefix cksum_algorithm: sha1 (accelerators: [::sha1::Implementations])" |
|
puts stderr "$errprefix sha1 from: [package ifneeded sha1 [package present sha1]]" |
|
} else { |
|
puts stderr "$errprefix cksum_algorithm: $alg" |
|
} |
|
} |
|
|
|
|
|
|
|
#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 changed [dict get $changeinfo changed] |
|
set unchanged [dict get $changeinfo unchanged] |
|
|
|
if {[llength $unchanged]} { |
|
lappend sources_unchanged $current_source_dir/$m |
|
} |
|
|
|
set is_skip 0 |
|
set is_new 0 |
|
if {$overwrite_what eq "all-targets"} { |
|
file mkdir $current_target_dir |
|
#-------------------------------------------- |
|
#sometimes we get the error: 'error copying "file1" to "file2": invalid argument' |
|
#-------------------------------------------- |
|
puts stderr "punkcheck: about to: file copy -force $current_source_dir/$m $current_target_dir" |
|
file copy -force $current_source_dir/$m $current_target_dir |
|
lappend files_copied $current_source_dir/$m |
|
} else { |
|
if {![file exists $current_target_dir/$m]} { |
|
#puts stderr "punkcheck: first copy to $current_target_dir/$m " |
|
file mkdir $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) |
|
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)" |
|
lappend files_copied $current_source_dir/$m |
|
} else { |
|
set is_skip 1 |
|
lappend files_skipped $current_source_dir/$m |
|
} |
|
} |
|
synced-targets { |
|
#disallow overwriting of target that has been modified by some other mechanism |
|
#review |
|
if {[llength $changed]} { |
|
#only overwrite if the target file checksum equals the last installed checksum (ie target is in sync with previous source-set and so hasn't been customized) |
|
set existing_tgt_cksum_info [punk::mix::base::lib::cksum_path $current_target_dir/$m] |
|
set is_target_unmodified_since_install 0 |
|
set target_cksum_compare "unknown" |
|
set latest_install_record [punkcheck::recordlist::file_record_latest_installrecord $filerec] ;#may be no such record - in which case we get an empty list |
|
if {[dict exists $latest_install_record -targets_cksums]} { |
|
set last_install_cksum [dict get $latest_install_record -targets_cksums] ;#in this case we know there is only one as 'install' always uses targetset size of 1. (FILEINFO record per file in source folder) |
|
if {[dict get $existing_tgt_cksum_info cksum] eq $last_install_cksum} { |
|
set is_target_unmodified_since_install 1 |
|
set target_cksum_compare "match" |
|
} else { |
|
set target_cksum_compare "nomatch" |
|
} |
|
} else { |
|
set target_cksum_compare "norecord" |
|
} |
|
if {$is_target_unmodified_since_install} { |
|
file mkdir $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 |
|
set is_skip 1 |
|
puts stderr "Skipping file copy $m target $current_target_dir/$m - require synced_target to overwrite - current target cksum compared to previous install: $target_cksum_compare" |
|
lappend files_skipped $current_source_dir/$m |
|
} |
|
} else { |
|
set is_skip 1 |
|
lappend files_skipped $current_source_dir/$m |
|
} |
|
} |
|
default { |
|
set is_skip 1 |
|
puts stderr "Skipping file copy $m target $current_target_dir/$m already exists (use -overwrite all-targets to overwrite)" |
|
#TODO! implement newer-targets older-targets? (note ctimes/mtimes are unreliable - may not be worth implementing) |
|
lappend files_skipped $current_source_dir/$m |
|
} |
|
} |
|
} |
|
} |
|
#target dir was created as necessary if files matched above |
|
#now ensure target dir exists if -createempty true |
|
if {$opt_createempty && ![file exists $current_target_dir]} { |
|
file mkdir $current_target_dir |
|
} |
|
|
|
|
|
|
|
|
|
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 |
|
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 |
|
} else { |
|
lset punkcheck_records $existing_filerec_posn $filerec |
|
} |
|
|
|
|
|
#------------------------------------------------------------ |
|
if {$is_skip} { |
|
set mark . |
|
} else { |
|
if {$is_new} { |
|
set mark \x1b\[32\;1mN\x1b\[m |
|
} else { |
|
#updated |
|
set mark \x1b\[32\;1mU\x1b\[m |
|
} |
|
} |
|
if {$opt_progresschannel ne ""} { |
|
if {$last_depth ne $CALLDEPTH} { |
|
puts -nonewline $opt_progresschannel \n[string repeat " " $CALLDEPTH]$mark |
|
flush $opt_progresschannel |
|
set last_depth $CALLDEPTH |
|
} else { |
|
puts -nonewline $opt_progresschannel $mark |
|
} |
|
} |
|
#------------------------------------------------------------ |
|
|
|
} |
|
|
|
if {$max_depth != -1 && $CALLDEPTH >= $max_depth} { |
|
#don't process any more subdirs |
|
#sometimes deliberately called with max_depth 1 - so don't warn here. review |
|
#puts stderr "punkcheck::install warning - reached max_depth $max_depth" |
|
set subdirs [list] |
|
} else { |
|
set subdirs [glob -nocomplain -dir $current_source_dir -type d -tail *] |
|
set hiddensubdirs [glob -nocomplain -dir $current_source_dir -type {hidden d} -tail *] |
|
foreach h $hiddensubdirs { |
|
switch -- $h { |
|
"." - ".." { |
|
continue |
|
} |
|
default { |
|
if {$h ni $subdirs} { |
|
lappend subdirs $h |
|
} |
|
} |
|
} |
|
} |
|
} |
|
#puts stderr "subdirs: $subdirs" |
|
foreach d $subdirs { |
|
set skipd 0 |
|
foreach dg [concat $opt_antiglob_dir_core $opt_antiglob_dir] { |
|
if {[string match $dg $d]} { |
|
#puts stdout "SKIPPING FOLDER $d due to antiglob_dir-match: $dg " |
|
set skipd 1 |
|
break |
|
} |
|
} |
|
if {$skipd} { |
|
continue |
|
} |
|
|
|
set relative_source_path [file join $relative_source_dir $d] |
|
set is_antipath 0 |
|
foreach antipath $opt_antiglob_paths { |
|
#puts "testing folder - globmatchpath $antipath vs $relative_source_path" |
|
if {[punk::path::globmatchpath $antipath $relative_source_path]} { |
|
lappend antiglob_paths_matched [file join $current_source_dir $d] |
|
#puts stdout "SKIPPING FOLDER $relative_source_path due to antiglob_path-match: $antipath " |
|
set is_antipath 1 |
|
break |
|
} |
|
} |
|
if {$is_antipath} { |
|
continue |
|
} |
|
|
|
#if {![file exists $current_target_dir/$d]} { |
|
# file mkdir $current_target_dir/$d |
|
#} |
|
|
|
|
|
set sub_opts_1 [list\ |
|
-call-depth-internal [expr {$CALLDEPTH + 1}]\ |
|
-subdirlist [list {*}$subdirlist $d]\ |
|
-glob $fileglob\ |
|
-antiglob_file_core $opt_antiglob_file_core\ |
|
-antiglob_file $opt_antiglob_file\ |
|
-antiglob_dir_core $opt_antiglob_dir_core\ |
|
-antiglob_dir $opt_antiglob_dir\ |
|
-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\ |
|
-progresschannel $opt_progresschannel\ |
|
] |
|
set sub_opts [dict merge $opts $sub_opts] |
|
set sub_result [punkcheck::install $srcdir $tgtdir {*}$sub_opts] |
|
|
|
lappend files_copied {*}[dict get $sub_result files_copied] |
|
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] |
|
} |
|
|
|
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] |
|
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 "- -- --- --- --- ---" |
|
} |
|
} |
|
|
|
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] |
|
} |
|
|
|
|
|
lappend PUNKARGS [list { |
|
@id -id ::punkcheck::summarize_install_resultdict |
|
@cmd -name punkcheck::summarize_install_resultdict -help\ |
|
"Emits a string summarizing a punkcheck resultdict, showing |
|
how many items were copied, and the source, target locations" |
|
@opts |
|
-title -type string -default "" |
|
-forcecolour -type boolean -default 0 -help\ |
|
"When true, passes the forcecolour tag to punk::ansi functions. |
|
This enables ANSI sgr colours even when colour |
|
is off. (ignoring env(NO_COLOR)) |
|
To disable colour - ensure the NO_COLOR env var is set, |
|
or use: |
|
namespace eval ::punk::console {variable colour_disabled 1}" |
|
@values -min 1 -max 1 |
|
resultdict -type dict |
|
}] |
|
proc summarize_install_resultdict {args} { |
|
set argd [punk::args::parse $args withid ::punkcheck::summarize_install_resultdict] |
|
lassign [dict values $argd] leaders opts values received |
|
set title [dict get $opts -title] |
|
set forcecolour [dict get $opts -forcecolour] |
|
set resultdict [dict get $values resultdict] |
|
|
|
set has_ansi [expr {![catch {package require punk::ansi}]}] |
|
if {$has_ansi} { |
|
if {$forcecolour} { |
|
set fc "forcecolour" |
|
} else { |
|
set fc "" |
|
} |
|
set R [punk::ansi::a] ;#reset |
|
set LINE_COLOUR [punk::ansi::a+ {*}$forcecolour bold cyan] |
|
set LOW_COLOUR [punk::ansi::a+ {*}$forcecolour bold green] |
|
set HIGH_COLOUR [punk::ansi::a+ {*}$forcecolour bold yellow] |
|
} else { |
|
set R "" |
|
set LINE_COLOUR "" |
|
set LOW_COLOUR "" |
|
set HIGH_COLOUR "" |
|
} |
|
|
|
set msg "" |
|
if {[dict size $resultdict]} { |
|
set copied [dict get $resultdict files_copied] |
|
if {[llength $copied] == 0} { |
|
set HIGHLIGHT $LOW_COLOUR |
|
} else { |
|
set HIGHLIGHT $HIGH_COLOUR |
|
} |
|
set ruler $LINE_COLOUR[string repeat - 78]$R |
|
if {$title ne ""} { |
|
append msg $ruler \n |
|
append msg $title \n |
|
} |
|
append msg $ruler \n |
|
#append msg "[dict keys $resultdict]" \n |
|
set tgtdir [dict get $resultdict tgtdir] |
|
set checkfolder [dict get $resultdict punkcheck_folder] |
|
append msg "${HIGHLIGHT}Copied [llength $copied] files from [dict get $resultdict srcdir] to [dict get $resultdict tgtdir]$R" \n |
|
foreach f $copied { |
|
append msg "COPIED [punkcheck::lib::path_relative $checkfolder $f]" \n |
|
append msg " TO $tgtdir" \n |
|
} |
|
append msg "[llength [dict get $resultdict sources_unchanged]] unchanged source files" \n |
|
append msg "[llength [dict get $resultdict files_skipped]] skipped files" \n |
|
append msg $ruler \n |
|
} |
|
return $msg |
|
} |
|
|
|
namespace eval recordlist { |
|
set pkg punkcheck |
|
namespace path ::punkcheck |
|
|
|
proc records_as_target_dict {record_list} { |
|
set result [dict create] |
|
foreach rec $record_list { |
|
if {[dict get $rec tag] eq "FILEINFO"} { |
|
set tgtlist [dict get $rec -targets] |
|
dict set result $tgtlist $rec |
|
} |
|
} |
|
return $result |
|
} |
|
|
|
|
|
|
|
|
|
#will only match if same base was used.. and same targetlist |
|
proc get_file_record {targetlist record_list} { |
|
set posn 0 |
|
set found_posn -1 |
|
set record "" |
|
foreach rec $record_list { |
|
if {[dict get $rec tag] eq "FILEINFO"} { |
|
if {[dict get $rec -targets] eq $targetlist} { |
|
set found_posn $posn |
|
set record $rec |
|
break |
|
} |
|
} |
|
incr posn |
|
} |
|
return [list position $found_posn record $record] |
|
} |
|
proc file_install_record_source_changes {install_record} { |
|
#reject INSTALLFAILED items ? |
|
switch -- [dict get $install_record tag] { |
|
"QUERY-INPROGRESS" - |
|
"INSTALL-RECORD" - |
|
"INSTALL-SKIPPED" - |
|
"INSTALL-INPROGRESS" - |
|
"MODIFY-INPROGRESS" - |
|
"MODIFY-RECORD" - |
|
"MODIFY-SKIPPED" - |
|
"VIRTUAL-INPROGRESS" - |
|
"VIRTUAL-RECORD" - |
|
"VIRTUAL-SKIPPED" - |
|
"DELETE-RECORD" - |
|
"DELETE-INPROGRESS" - |
|
"DELETE-SKIPPED" { |
|
} |
|
default { |
|
error "file_install_record_source_changes bad install record: tag '[dict get $install_record tag]' not INSTALL-RECORD|SKIPPED|INSTALL-INPROGRESS|MODIFY-RECORD|MODIFY-INPROGRESS|VIRTUAL-RECORD|VIRTUAL-INPROGRESS|DELETE-RECORD|DELETE-INPROGRESS" |
|
} |
|
} |
|
set source_list [dict_getwithdefault $install_record body [list]] |
|
set changed [list] |
|
set unchanged [list] |
|
foreach src $source_list { |
|
if {[dict exists $src -changed]} { |
|
if {[dict get $src -changed] !=0} { |
|
lappend changed [dict get $src -path] |
|
} else { |
|
lappend unchanged [dict get $src -path] |
|
} |
|
} else { |
|
lappend changed [dict get $src -path] |
|
} |
|
} |
|
return [dict create changed $changed unchanged $unchanged] |
|
} |
|
|
|
#assume only one for name - use first encountered |
|
proc get_installer_record {name record_list} { |
|
set posn 0 |
|
set found_posn -1 |
|
set record "" |
|
#puts ">>>> checking [llength $record_list] punkcheck records" |
|
foreach rec $record_list { |
|
if {[dict get $rec tag] eq "INSTALLER"} { |
|
if {[dict get $rec -name] eq $name} { |
|
set found_posn $posn |
|
set record $rec |
|
break |
|
} |
|
} |
|
incr posn |
|
} |
|
return [list position $found_posn record $record] |
|
} |
|
|
|
proc new_installer_record {name args} { |
|
if {[llength $args] %2 !=0} { |
|
error "punkcheck new_installer_record args must be name-value pairs" |
|
} |
|
set ts [clock microseconds] |
|
set seconds [expr {$ts / 1000000}] |
|
set tsiso [clock format $seconds -format "%Y-%m-%dT%H:%M:%S"] |
|
|
|
#put -tsiso first so it lines up with -tsiso in event records |
|
set defaults [list\ |
|
-tsiso $tsiso\ |
|
-ts $ts\ |
|
-name $name\ |
|
-keep_events 5\ |
|
] |
|
set opts [dict merge $defaults $args] |
|
|
|
#set this_installer_record_list [punk::tdl::prettyparse [list INSTALLER name $opt_installer ts $ts tsiso $tsiso keep_events 5 {}]] |
|
#set this_installer_record [lindex $this_installer_record_list 0] |
|
|
|
set record [dict create tag INSTALLER {*}$opts body {}] |
|
|
|
|
|
return $record |
|
} |
|
proc new_installer_event_record {type args} { |
|
if {[llength $args] %2 !=0} { |
|
error "punkcheck new_installer_event_record args must be name-value pairs" |
|
} |
|
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\ |
|
-type $type\ |
|
] |
|
set opts [dict merge $defaults $args] |
|
|
|
set record [dict create tag EVENT {*}$opts] |
|
} |
|
#need to scan entire set if filerecords to check if event is still referenced |
|
proc installer_record_pruneevents {installer_record record_list} { |
|
set keep 5 |
|
if {[dict exists $installer_record -keep_events]} { |
|
set keep [dict get $installer_record -keep_events] |
|
} |
|
|
|
if {[dict exists $installer_record body]} { |
|
set body_items [dict get $installer_record body] |
|
} else { |
|
set body_items [list] |
|
} |
|
set kept_body_items [list] |
|
set kcount 0 |
|
foreach item [lreverse $body_items] { |
|
if {[dict get $item tag] eq "EVENT"} { |
|
incr kcount |
|
if {$keep < 0 || $kcount <= $keep} { |
|
lappend kept_body_items $item |
|
} else { |
|
set eventid "" |
|
if {[dict exists $item -id]} { |
|
set eventid [dict get $item -id] |
|
} |
|
if {$eventid ne "" && $eventid ne "unspecified"} { |
|
#keep if referenced, discard if not, or if eventid empty/unspecified |
|
set is_referenced 0 |
|
foreach rec $record_list { |
|
if {[dict get $rec tag] eq "FILEINFO"} { |
|
if {[dict exists $rec body]} { |
|
foreach install [dict get $rec body] { |
|
if {[dict exists $install -eventid] && [dict get $install -eventid] eq $eventid} { |
|
set is_referenced 1 |
|
break |
|
} |
|
} |
|
} |
|
} |
|
if {$is_referenced} { |
|
break |
|
} |
|
} |
|
if {$is_referenced} { |
|
lappend kept_body_items $item |
|
} |
|
} |
|
} |
|
} else { |
|
lappend kept_body_items $item |
|
} |
|
} |
|
set kept_body_items [lreverse $kept_body_items] |
|
dict set installer_record body $kept_body_items |
|
return $installer_record |
|
} |
|
proc installer_record_add_event {installer_record event} { |
|
if {[dict get $installer_record tag] ne "INSTALLER"} { |
|
error "installer_record_add_event bad installer record: tag not INSTALLER" |
|
} |
|
if {[dict get $event tag] ne "EVENT"} { |
|
error "installer_record_add_event bad event record: tag not EVENT" |
|
} |
|
if {[dict exists $installer_record body]} { |
|
set body_items [dict get $installer_record body] |
|
} else { |
|
set body_items [list] |
|
} |
|
lappend body_items $event |
|
dict set installer_record body $body_items |
|
return $installer_record |
|
} |
|
proc file_record_latest_installrecord {file_record} { |
|
tailcall file_record_latest_operationrecord INSTALL $file_record |
|
} |
|
proc file_record_latest_operationrecord {operation file_record} { |
|
set operation [string toupper $operation] |
|
if {[dict get $file_record tag] ne "FILEINFO"} { |
|
error "file_record_latest_operationrecord bad file_record: tag not FILEINFO" |
|
} |
|
if {![dict exists $file_record body]} { |
|
return [list] |
|
} |
|
set body_items [dict get $file_record body] |
|
foreach item [lreverse $body_items] { |
|
if {[dict get $item tag] eq "$operation-RECORD"} { |
|
return $item |
|
} |
|
} |
|
return [list] |
|
} |
|
|
|
|
|
proc file_record_set_defaults {file_record} { |
|
if {[dict get $file_record tag] ne "FILEINFO"} { |
|
error "file_record_set_defaults bad file_record: tag not FILEINFO" |
|
} |
|
set defaults [list -keep_installrecords 3 -keep_skipped 1 -keep_inprogress 2] |
|
foreach {k v} $defaults { |
|
if {![dict exists $file_record $k]} { |
|
dict set file_record $k $v |
|
} |
|
} |
|
return $file_record |
|
} |
|
|
|
#negative keep_ value will keep all |
|
proc file_record_prune {file_record} { |
|
if {[dict get $file_record tag] ne "FILEINFO"} { |
|
error "file_record_prune bad file_record: tag not FILEINFO" |
|
} |
|
set file_record [file_record_set_defaults $file_record] |
|
set kmap [list -keep_installrecords *-RECORD -keep_skipped *-SKIPPED -keep_inprogress *-INPROGRESS] |
|
foreach {key rtype} $kmap { |
|
set keep [dict get $file_record $key] |
|
if {[dict exists $file_record body]} { |
|
set body_items [dict get $file_record body] |
|
} else { |
|
set body_items [list] |
|
} |
|
set kept_body_items [list] |
|
set kcount 0 |
|
foreach item [lreverse $body_items] { |
|
if {[string match $rtype [dict get $item tag]]} { |
|
incr kcount |
|
if {$keep < 0 || $kcount <= $keep} { |
|
lappend kept_body_items $item |
|
} |
|
} else { |
|
lappend kept_body_items $item |
|
} |
|
} |
|
set kept_body_items [lreverse $kept_body_items] |
|
dict set file_record body $kept_body_items |
|
} |
|
return $file_record |
|
} |
|
|
|
#extract new or existing filerecord for path given |
|
#review - locking/concurrency |
|
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 "NO existing record for $relative_target_paths" |
|
set isnew 1 |
|
set fileset_record [dict create tag FILEINFO -targets $relative_target_paths body {}] |
|
} else { |
|
set recordset [lreplace $recordset[unset recordset] $existing_posn $existing_posn] |
|
set isnew 0 |
|
set fileset_record [dict get $fetch_record_result record] |
|
} |
|
return [list record $fileset_record recordset $recordset isnew $isnew oldposition $existing_posn] |
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
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 |
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
## Ready |
|
package provide punkcheck [namespace eval punkcheck { |
|
set pkg punkcheck |
|
variable version |
|
set version 0.1.0 |
|
}] |
|
return
|
|
|