# Recursive file compare utility for Windows. # Calls diff.exe or fc.exe for each file found. # Updated by John Brearley Apr 2017 # email: brearley@bell.net # email: jrbrearley4@gmail.com # License: This script is free to use, modify and/or redistribute, # however you MUST leave the author credit information above as is # and intact. # Support: Available on a best effort basis. # Notes # 1) For Win10, when you reboot with Repair disk, you cant run TCL from the command prompt. # There is something about the Repair DOS environment that does not let even a command line # oriented program to run. Same goes for Windows Powershell. # 2) Need to try on Win7 Repair disk some time... # 3) Some files are locked, so cant be read, eg c:\Windows\ServiceProfiles\LocalService\NTUSER.DAT # and FC gives misleading error about "no such file", even though it is visible. # 4) regedit.exe is a perennial failure, but manually compares OK with fc.exe. # 5) Upgrading TCL from 8.63b (Nov 2012) to 8.6.4.1 (Jan 2017) really reduced the number of errors # flagged, as the fc.exe retry mechanism shows many files are identical, even if diff.exe does # NOT agree. This is the fcr counter counter in the stats summary. #==================== check_file_name ================================== # Check if file is a constantly changing Windows or Norton file. These # files are often locked down from even admin access, and cant be readily # updated. # # Returns: "windows" | "norton" | "other" #======================================================================= proc check_file_name {file} { # NB: The categories used here MUST be kept in sync with ::cat_list !!! # Look for selected Windows or Norton directories. # NB: Some of the regexp patterns here rely on having the full file pathname! if {[regexp -nocase {^[a-z]:/?(ProgramData|Program\s*Files).*(Microsoft|Windows)} $file]} { return "windows" } elseif {[regexp -nocase {^[a-z]:/?(Windows|Users.*(Microsoft|Windows))} $file]} { return "windows" } elseif {[regexp -nocase {(hiberfil|pagefile|swapfile).*sys$} $file]} { return "windows" } elseif {[regexp -nocase {^[a-z]:/?(ProgramData|Program\s*Files).*Norton} $file]} { return "norton" } elseif {[regexp -nocase {^[a-z]:/?Users.*/Norton} $file]} { return "norton" } else { # Catchall for everything else. return "other" } } #==================== cleanup ========================================== # Cleanup exit routine #======================================================================= proc cleanup { } { # log summary details set total_min [expr int(([clock seconds] - $::start_sec)/60)] log_info "\n[timestamp] $::self All done, $::error_cnt errors, $::nolog_cnt nolog, $::warning_cnt warn\ \npattern=$::pattern src_dir=$::src_dir dest_dir=$::dest_dir" # Dump formatted stats names as header lines for a table. set f1 "%8s" ;# format for category column set f2 "%6s" ;# format for stat number column set hdr1 [format $f1 "category"] set hdr2 [format $f1 "========"] foreach i $::stat_list { # puts "i=$i" set hdr1 "$hdr1 [format $f2 $i]" set hdr2 "$hdr2 ======" } log_info "\n$hdr1\n$hdr2" # Dump formatted stats on table with one row per category. foreach i $::cat_list { set line [format $f1 $i] ;# start line with category name foreach j $::stat_list { set x $::stats_array($i,$j) set line "$line [format $f2 $x]" # puts "i=$i j=$j x=$x" } if {$i == "total"} { # Put visual break before total line. log_info $hdr2 } log_info $line } # Other info log_info "\n$::subdir_cnt subdirectories, $::hidden_files_cnt hidden_files, $::hidden_subdir_cnt hidden_subdir, copy_opt=$::copy_opt" log_info "$::curly_tot_cnt curly_brace_tot, $::curly_matched_pair_cnt matched, $::curly_open_only_cnt open, $::curly_close_only_cnt close, $::curly_error_cnt error" log_info "TCL $::tcl_patchLevel, total time $total_min minutes \nsee $::out_file \nsee $::retry_file" # Exit with error count. exit $::error_cnt } #==================== compare_files ==================================== # Compares a specified source file to specified destination file # # Returns: OK, FAIL #======================================================================= proc compare_files {i src dest no_log category} { # If necessary, convert / to \ for optional retry by fc.exe set src2 $src set dest2 $dest # set ::compare_tool "fc.exe" ;# test code # First we escape curly-braces # if {[regexp {\{.*\}} $src]} { # regsub -all "\{" $src2 "\\\{" src2 ;# Yes, 3 escapes, not 4! # regsub -all "\}" $src2 "\\\}" src2 ;# Yes, 3 escapes, not 4! # regsub -all "\{" $dest2 "\\\{" dest2 ;# Yes, 3 escapes, not 4! # regsub -all "\}" $dest2 "\\\}" dest2 ;# Yes, 3 escapes, not 4! # } # Now covert / to \ Windows style. regsub -all {/} $src2 {\\} src2 regsub -all {/} $dest2 {\\} dest2 # Finally, add double-quotes for case of embedded whitespace. # No, this makes things worse... # if {[regexp {\s} $src2]} { # set src2 "\"$src2\"" # set dest2 "\"$dest2\"" # } # log_info "compare_files i=$i src2=$src2 dest2=$dest2" # Compare the files. if {$::compare_tool == "fc.exe"} { # fc.exe uses src2 / dest2 with windows path format set catch_resp [catch "exec $::compare_tool {$src2} {$dest2}" catch_msg] } else { # diff.exe uses Unix path format set catch_resp [catch "exec $::compare_tool {$src} {$dest}" catch_msg] } # If files compared OK, we are done. # set catch_resp 1 ;# test code if {$catch_resp == 0} { log_info "compare_files i=$i $dest $::compare_tool compared (OK)" "true" return "OK" } # For Windows & Program directories, compare again using fc.exe. # Tried wrapping fc.exe inside .bat file, also run as cmd.exe /c fc.bat, no improvement. set no_log [string trim $no_log] if {$::compare_tool != "fc.exe" && [regexp -nocase {^[a-z]:/?(Windows|Program)} $src]} { # See if fc.exe gives a different result. log_info "compare_file retry with fc.exe i=$i src2=$src2 dest2=$dest2 compare_tool=$::compare_tool no_log=$no_log" set catch_resp [catch "exec fc.exe {$src2} {$dest2}" catch_msg] set catch_msg [truncate_msg $catch_msg] ;# limit the garbage dumped into the log file log_info "fc.exe i=$i catch_resp=$catch_resp catch_msg=$catch_msg" # set catch_resp 0 ;# test code if {$catch_resp == 0} { # Always show when fc retry succeeded, increment specific counters for this event. log_info "compare_files i=$i $dest2 fc.exe retry compared (OK)" incr ::stats_array(total,fcr) incr ::stats_array($category,fcr) return "OK" } } # Deal with the error. The calling routine will suppress the first compare failure. set status [get_status $catch_msg $no_log $category "diff"] log_error "compare_files i=$i $dest $::compare_tool failed ($status $category)" $no_log # log_info "$catch_msg" ;# shows actual file differences, really floods the log. # Add this file to running list in DOS batch file for manual retry later on. log_retry $i $src $dest $no_log return "FAIL" } #==================== copy_file ======================================== # Copies specified source file to specified destination # # Returns: OK, FAIL #======================================================================= proc copy_file {i src dest dest_dir no_log category} { # If copy not requested, return. if {$::copy_opt == ""} { # Return status FAIL signals the calling routine to move on. # There are no stats counters to increment here. return "FAIL" } # If necessary, create the required destination directory. # TCL dirname has issue with unmatched close curly-brace, so we use the dest_dir # that was passed to this routine # log_info "copy_file i=$i src=$src dest=$dest dest_dir=$dest_dir" if {![file isdirectory "$dest_dir"]} { set catch_resp [catch "file mkdir {$dest_dir}" catch_msg] # set catch_resp 1 ;# test code # set catch_msg abcd ;# test code if {$catch_resp == 0} { # Always log directory creation. log_info "copy_file i=$i created destination directory: $dest_dir (OK $category)" } else { # Always log the error. set status [get_status $catch_msg "" $category] log_error "copy_file i=$i could not create dest_dir=$dest_dir, $catch_msg ($status $category)" # Increment the appropiate counters. incr ::stats_array(total,cpyfl) incr ::stats_array($category,cpyfl) return "FAIL" } } else { # puts "copy_file i=$i dest_dir=$dest_dir already exists, (OK $category)" } # Check if the source file is still there. There are a number of temporary folders, # such as /Windows/SoftwareDistribution/Download, also some Norton folders, where # items may have been found earlier by rec_find, but the OS has quietly purged # them by the time we actually get around to checking on them. if {[file exists "$src"]} { # puts "copy_file i=$i src=$src still exists, (OK $category)" } else { # Always log the error. log_error "copy_file i=$i src=$src is now missing, (gone $category)" incr ::stats_array(total,gone) incr ::stats_array($category,gone) return "FAIL" } # Copy the file. File names have largely been vetted for unmatched curly-braces. set catch_resp [catch "file copy -force {$src} {$dest}" catch_msg] # set catch_resp 1 ;# test code # set catch_msg abcd ;# test code if {$catch_resp == 0} { log_info "copy_file i=$i copied $dest (OK $category)" $no_log return "OK" } else { # Always log the error. set status [get_status $catch_msg "" $category] log_error "copy_file i=$i could not copy to $dest, $catch_msg ($status $category)" incr ::stats_array(total,cpyfl) incr ::stats_array($category,cpyfl) return "FAIL" } } #==================== fix_curly ======================================== # Attempts to work around known issues with missing curly brackets in # path/file names # # Returns: string #======================================================================= proc fix_curly {path category} { # NB: Initially, I had been converting / in pathnames to \ for the benefit # of fc.exe. This appears to have created a lot of issues with TCL file copy. # When the pathname looked like abc\def\\{1234}..., the open curly-brace looked # like it was being escaped, when in reality it was a directory delimiter. # NB: extra \ in pathname above is to work around TCL interpreter known issue of # unmatched curly braces in comments inside a loop, yes comments inside a loop, # choking up!!! # Deal with single unmatched curly-brace. This does NOT handle case of a # correctly matched pair of curly-braces followed by an unmatched curly-brace. if {[regexp {(\{.*)} $path - x]} { # Found open curly-brace incr ::curly_tot_cnt # log_info "main i=$i file=$file found open curly-brace x=$x" # Check for matching close curly-brace AFTER the open curly-brace. # This is done by checking $x, which starts with the open curly-brace. if {[regexp {\}} $x]} { # TCL file copy works with matched curly-braces in the filenames, no need to escape them. incr ::curly_matched_pair_cnt # log_info "fix_curly found matched pair curly-braces x=$x path=$path category=$category" } else { incr ::curly_open_only_cnt regsub -all "\{" $path "\\\{" path ;# Yes, 3 escapes, not 4! # log_info "fix_curly escaped unmatched open curly-brace path=$path category=$category" } } elseif {[regexp {\}} $path]} { # There is no open curly-brace, but we found an unmatched close curly-brace incr ::curly_tot_cnt incr ::curly_close_only_cnt regsub -all "\}" $path "\\\}" path ;# Yes, 3 escapes, not 4! # log_info "fix_curly escaped unmatched close curly-brace path=$path category=$category" } # Return modified path return $path } #==================== get_status ======================================= # Parses the error msg, determines the appropriate status code and # increments the appropriate category counter. # # Returns: string #======================================================================= proc get_status {msg no_log category {tool ""}} { # Look for selected error messages. set status "" set no_log [string trim $no_log] set tool [string trim $tool] # For tool=diff, use different counters. if {$tool == "diff"} { set status "diff" if {$no_log == ""} { incr ::stats_array(total,diff) incr ::stats_array($category,diff) } } elseif {[regexp -nocase "permission.*denied" $msg]} { set status "noacc" if {$no_log == ""} { incr ::stats_array($category,noacc) incr ::stats_array(total,noacc) } } elseif {[regexp -nocase "brace" $msg]} { set status "curly" if {$no_log == ""} { incr ::curly_error_cnt incr ::stats_array($category,curly) incr ::stats_array(total,curly) } } else { # Catch all bucket. set status "unexp" if {$no_log == ""} { incr ::stats_array($category,unexp) incr ::stats_array(total,unexp) } } return $status } #==================== log_error ======================================== # Displays error message right now, adds message to the log file, # increments error counter. # # Optional no_log parameter can suppress messages in log_file. This # allows you to stop flooding the log_file for known conditions. #======================================================================= proc log_error {msg {no_log ""}} { # Prepend ERROR: & hand off to log_info set msg "ERROR: $msg" set no_log [string trim $no_log] if {$no_log == ""} { incr ::error_cnt } log_info $msg $no_log # Test code # if {$::error_cnt >= 100} { # puts "\n\nToo many errors, stopping!" # cleanup # } } #==================== log_info ========================================= # Displays info message right now, adds message to the log file. # # Optional no_log parameter can suppress messages in log_file. This # allows you to stop flooding the log_file for known conditions. #======================================================================= proc log_info {msg {no_log ""}} { # Always display msg. Add "not logged" as appropriate. set no_log [string trim $no_log] if {$no_log != ""} { set msg "$msg (NL)" incr ::nolog_cnt } puts "$msg" # Append msg to running log file, when it is available for use. # no_log allows for suppressing repeated messages that flood the # log_file and make it unreadable. if {$::out != "" && $no_log == ""} { puts $::out "$msg" flush $::out } } #==================== log_retry ======================================== # Appends data to retry_cfc.bat file so user can easily manually retry # failed file compare operations. #======================================================================= proc log_retry {i src dest no_log} { # For no_log not null, we are done set no_log [string trim $no_log] if {$no_log != ""} { return } # Now covert / to \ Windows style. regsub -all {/} $src {\\} src regsub -all {/} $dest {\\} dest # Add this file to running list in DOS batch file for manual retry later on. puts $::retry "echo i=$i $src" puts $::retry "fc.exe \"$src\" \"$dest\"" puts $::retry "echo i=$i $src" puts $::retry "if '%tr%' == '1' pause" flush $::retry } #==================== log_warning ====================================== # Appends specified WARNING msg to log file, displays msg on terminal. # # Optional no_log parameter can suppress messages in log_file. This # allows you to stop flooding the log_file for known conditions. #======================================================================= proc log_warning {msg {no_log ""}} { # Prepend WARNING: & handoff to log_info set msg "WARNING: $msg" set no_log [string trim $no_log] if {$no_log == ""} { incr ::warning_cnt } log_info $msg $no_log } #==================== rec_find ========================================= # Takes list of file in the specified directory and adds them to the # global file list. Calls itself recursively for any subdirectories found. #======================================================================= proc rec_find {cur_dir} { # If no directories specified, we are done. set cur_dir [string trim $cur_dir] # puts "rec_find start cur_dir=$cur_dir" if {$cur_dir == ""} { return } # More recent versions of TCL 8.6+ seem to need a trailing / on the directories. # If not, rec_find will mess up and only get the subdirectories of pwd. # Also need trailing / for case of whole mounted subdirectory. # The setup routine ensures a single trailing / is present. # Get the category for this directory. set category [check_file_name $cur_dir] # puts "rec_find start cur_dir=$cur_dir category=$category" # Attempt to fix up known curly brace issues. # It turns out that glob cant handle directory name with unmatched curly brace either. # We allow the error to occur in order to make it more visible to the user. # So any files in a directory with unmatched curly braces are NOT listed and processed. # set cur_dir [fix_curly $cur_dir $category] ;# turned off so errors are NOT hidden!!! # Find all files in the current directory that match the specified pattern. # NB: You need to explicitly ask for hidden files as a separate glob request! # NB: Some directories start with $ (eg: $Recycle.Bin) which can make the TCL # interpreter think this is a variable. So put { } around $cur_dir to fix. set current_files "" set status "" # log_info "rec_find(1) calling glob cur_dir=$cur_dir" set catch_resp [catch "set current_files \[glob -nocomplain -type f -directory {$cur_dir} $::pattern\]" catch_msg] # log_info "rec_find(1) return glob cur_dir=$cur_dir catch_resp=$catch_resp catch_msg=$catch_msg category=$category" if {$catch_resp != 0} { set status [get_status $catch_msg "" $category] log_error "rec_find(1) $cur_dir $catch_msg ($status $category)" } set cnt_cf [llength $current_files] # Testing has shown that when you cant access a directory list of files due to # permission access issues or curly brace issues, you wont be able to get hidden file # or directories either. So there is no point continuing onwards, getting the same # error repeatedly. if {$status == "noacc" || $status == "curly"} { return } # Now get hidden files set hidden_files "" set catch_resp [catch "set hidden_files \[glob -nocomplain -type {f hidden} -directory {$cur_dir} $::pattern\]" catch_msg] if {$catch_resp != 0} { set status [get_status $catch_msg "" $category] log_error "rec_find(2) $cur_dir $catch_msg ($status $category)" } set cnt_hf [llength $hidden_files] incr ::hidden_files_cnt $cnt_hf # if {$hidden_files != ""} { # log_info "\nrec_find cur_dir=$cur_dir \ncnt=$cnt_cf current_files=$current_files \ncnt=$cnt_hf hidden_files=$hidden_files" # } # Get sorted unique list of all files set sorted_files [lsort -unique "$current_files $hidden_files"] set cnt_sf [llength $sorted_files] # log_info "rec_find cur_dir=$cur_dir cnt_sf=$cnt_sf" # Save each file as a seperate element in file_array. This avoids issues # with long lists and mismatched curly braces for filenames that have # embedded spaces or curly braces in them foreach file $sorted_files { set cnt_tot $::stats_array(total,found) incr cnt_tot set ::stats_array(total,found) $cnt_tot set ::file_array($cnt_tot) $file ;# NB: This is the full file pathname! if {$cnt_tot % 1000 == 0} { log_info "rec_find i=$cnt_tot file=$file ($category)" "true" } # log_info "rec_find i=$cnt_tot file=$file ($category)" "true" set category [check_file_name $file] incr ::stats_array($category,found) } # Find all subdirectories at this level. set current_subdir "" set catch_resp [catch "set current_subdir \[glob -nocomplain -type d -directory {$cur_dir} *\]" catch_msg] if {$catch_resp != 0} { set status [get_status $catch_msg "" $category] log_error "rec_find(3) $cur_dir $catch_msg ($status $category)" } set cnt_csd [llength $current_subdir] # You need to explicitly ask for hidden directories set hidden_subdir "" set catch_resp [catch "set hidden_subdir \[glob -nocomplain -type {d hidden} -directory {$cur_dir} *\]" catch_msg] if {$catch_resp != 0} { set status [get_status $catch_msg "" $category] log_error "rec_find(4) $cur_dir $catch_msg ($status $category)" } set cnt_hsd [llength $hidden_subdir] incr ::hidden_subdir_cnt $cnt_hsd # if {$hidden_subdir != ""} { # log_info "\nrec_find cur_dir=$cur_dir \ncnt=$cnt_csd current_subdir=$current_subdir \ncnt=$cnt_hsd hidden_subdir=$hidden_subdir" # } # Get sorted unique list of all subdirectories set sorted_subdir [lsort -unique "$current_subdir $hidden_subdir"] set cnt_ssd [llength $sorted_subdir] # log_info "rec_find cur_dir=$cur_dir cnt_ssd=$cnt_ssd" # Call ourselves recursively for each subdirectory. foreach dir $sorted_subdir { incr ::subdir_cnt # puts "calling rec_find cur_dir=$cur_dir next subdir dir=$dir" rec_find "$dir" } } #==================== setup ============================================ # Does basic initialization, gives online help if needed. #======================================================================= proc setup { } { # Initialize global counters set ::curly_close_only_cnt 0 set ::curly_error_cnt 0 set ::curly_matched_pair_cnt 0 set ::curly_open_only_cnt 0 set ::curly_tot_cnt 0 set ::copy_opt "" ;# null value used to control optional logging of events. set ::error_cnt 0 set ::hidden_files_cnt 0 set ::hidden_subdir_cnt 0 set ::nolog_cnt 0 set ::out "" ;# log file is not available yet set ::subdir_cnt 0 set ::warning_cnt 0 # Set up global stats array, indexed by category & statistic name. # NB: The order of the items in these lists determines the data table # order of the rows and columns displayed by the exit cleanup routine. set ::cat_list "windows norton other total" set ::stat_list "noacc found miss diff repr cpyfl gone curly unexp fcr" foreach i $::cat_list { foreach j $::stat_list { set ::stats_array($i,$j) 0 set x $::stats_array($i,$j) # puts "stats_array i=$i j=$j x=$x" } } # Give online help if necessary set ::self [file tail $::argv0] set x [lindex $::argv 0] set x [string tolower $x] set x [string range $x 0 1] if {$x == "-h" || $x == "/?"} { puts "Basic Usage: tclsh $::self \[pattern\] \[src_dir\] \[dest_dir\] <-copy>" puts " " puts "Utility recursively gets list of all files in the src_dir" puts "directory that match the specified \[pattern\]. Files are compared" puts "to same file name in the \[dest_dir\] using diff.exe or fc.exe." puts " " puts "Use pattern \"*\" to compare all files." puts "Use pattern \"*.jpeg\" to compare only .jpg files." puts " " puts "Optional <-copy> will copy missing or overwrite different files in" puts "the \[destination_directory\]." exit 1 } # Save start time, in seconds. set ::start_sec [clock seconds] # Check for 3 required command line tokens if {$::argc < 3} { log_error "Must specify minimum 3 command line tokens! \nFor more info, type: tclsh $::self -h" exit 1 } # Get 3 required command line parms. regsub -all {\\} $::argv {/} ::argv ;# convert \ for windows filesystem to / set ::pattern [lindex $::argv 0] set ::src_dir [lindex $::argv 1] if {[regexp {^\.} $::src_dir]} { regsub {^\.} $::src_dir [pwd] ::src_dir ;# convert relative path to full path } set ::dest_dir [lindex $::argv 2] if {[regexp {^\.} $::dest_dir]} { regsub {^\.} $::dest_dir [pwd] ::dest_dir ;# convert relative path to full path } # More recent versions of TCL 8.6+ seem to need a single trailing / on the directories. # If not, rec_find calls to glob will mess up and only get the subdirectories of pwd. # Also need trailing / for case of whole mounted subdirectory. set ::src_dir "${::src_dir}/" set ::dest_dir "${::dest_dir}/" # Convert multiple repeated / in directories to a single /. # NB: The extra / royally messed up destination file path computations made in main program loop. # The leading charactar of each directory got lost, causing each directory to be recopied with # the wrong name, filled up the destination disk. # NB: For the case of temporary network mounts in the form of //host/directory, we MUST preserve # the leading //. This is why we start the regsub pattern matching after the first 2 characters! regsub -start 2 -all {/+} $::src_dir {/} ::src_dir regsub -start 2 -all {/+} $::dest_dir {/} ::dest_dir # Needed in main program loop for computing correct destination directory set ::src_dir_len [string length $::src_dir] # Check for optional -copy token. if {$::argc >= 4} { set y [lindex $::argv 3] set y [string tolower $y] if {$y == "-copy"} { set ::copy_opt "true" } else { log_error "Invalid option: $y ! \nFor more info, type: tclsh $::self -h" exit 1 } } # Choose directory for log file & retry batch file based on known options of different OS. # NB: Windows admin user usually doesnt have HOMEPATH defined, but does have USERPROFILE. if {[info exists ::env(HOMEPATH)]} { set out_path $::env(HOMEPATH) ;# Windows first choice } elseif {[info exists ::env(USERPROFILE)]} { set out_path $::env(USERPROFILE) ;# Windows second choice, often needed by admin } elseif {[info exists ::env(HOME)]} { set out_path $::env(HOME) ;# Linux default } else { set out_path "[pwd]" } regsub -all {\\} $out_path {/} out_path ;# convert \ for windows filesystem to / # Choose log file name. set log_fn [file root $::self] set ::out_file "$out_path/$log_fn.log" # Open running log file for append. set catch_resp [catch "set ::out \[open \"$::out_file\" a\]" catch_msg] if {$catch_resp != 0} { log_error "Could not open $::out_file catch_msg=$catch_msg" exit 1 } # puts "out_path=$out_path out_file=$::out_file out=$::out" # Choose error retry DOS batch file name. set retry_fn "retry_fc" set ::retry_file "$out_path/$retry_fn.bat" # Open running error retry DOS batch file for append. set catch_resp [catch "set ::retry \[open \"$::retry_file\" a\]" catch_msg] if {$catch_resp != 0} { log_error "Could not open $::retry_file catch_msg=$catch_msg" exit 1 } # puts "out_path=$out_path retry_file=$::retry_file retry=$::retry" # Log start date/time, calling parms. set ts [timestamp] log_info "\n$ts $::self starting pattern=$::pattern\ \nsrc_dir=$::src_dir dest_dir=$::dest_dir copy_opt=$::copy_opt\ \nsee: $::out_file \nsee$::retry_file" # Add header to retry DOS batch file. puts $::retry "\n\n@echo off\necho.\necho.\necho $ts issues from $::self" flush $::retry # Check source directory exists. if {![file isdirectory "$::src_dir"]} { log_error "src_dir=$::src_dir not found!" exit 1 } # Check destination directory exists. if {![file isdirectory "$::dest_dir"]} { log_error "dest_dir=$::dest_dir not found!" exit 1 } # Are src_dir & dest_dir the same? We allow this for self-test, but warn user. if {[string tolower $::src_dir] == [string tolower $::dest_dir]} { log_warning "$::self setup src_dir EQ dest_dir $::src_dir !" log_warning "Hopefully you are doing a self-test here?" log_warning "All files MUST be identical in this case!" } # Choose compare_tool. If tkdiff suite is not available, then use fc.exe. set ::compare_tool "diff.exe" set catch_resp [catch "exec $::compare_tool --help" catch_msg] if {$catch_resp == 0} { # diff.exe give rc=0 on help msg. log_info "$::compare_tool is present (OK)" } else { # Look at error msg. If diff.exe not found, switch to fc.exe. if {[regexp "couldn.t.*execute.*no.*such.*file" $catch_msg]} { log_info "$::compare_tool does not appear to be installed: $catch_msg" set ::compare_tool "fc.exe" log_warning "Default tool $::compare_tool is known to lockup on large runs" } else { log_error "$::compare_tool unexpected response: $catch_msg" } } } #==================== timestamp ======================================== # Returns current date & time formatted as: YYYY/MM/DD HH:MM #======================================================================= proc timestamp { } { return [clock format [clock seconds] -format "%Y/%m/%d %H:%M"] } #==================== truncate_msg ===================================== # Truncates a msg string to limit how much garbage gets dumped into the # log file. # # Returns: string #======================================================================= proc truncate_msg {msg} { # Define max length of msg to return. set max_len 300 # Get length of msg. set len [string length $msg] # Do we need to truncate the msg? if {$len <= $max_len} { return $msg } else { set len $max_len set msg [string range $msg 0 $len] # log_info "truncate_msg len=$len msg=$msg" return $msg } } #==================== Main program ===================================== # Main program #======================================================================= # Initialization, give help if needed. setup # Test code # log_info "copied file afdfsdf" # log_info "should not be logged" "no_log" # log_error "fsdf sf sf sf sd " # log_error "error should not be logged" "no_log" # log_warning "test warn" # log_warning "warning should not be logged" "no_log" # cleanup # Recursively get all files that match the desired pattern. rec_find "$src_dir" log_info "[timestamp] main found $::stats_array(total,found) files, $subdir_cnt subdirectories,\ $error_cnt errors, $::stats_array(total,noacc) noacc \nsee $out_file \nsee$::retry_file" # Compare source file with corresponding file in destination_directory. # When copy_opt=true, copy missing files, recopy different files and compare again. for {set i 1} {$i <= $stats_array(total,found)} {incr i} { # Get the source file full path name & src_subdir. set src_path $file_array($i) ;# NB: file full source path name is in file_array! set src_subdir [file dirname "$src_path"] if {![regexp {/$} $src_subdir]} { set src_subdir "${src_subdir}/" ;# add trailing / if missing } set src_file [file tail $src_path] # Check if this file is one of the constantly changing Windows or Norton files. # This category is used to classify error messages with separate statistic counts, # resulting in a much more comprehensible log. set category [check_file_name $src_path] set category [string trim $category] # TCL dirname has issue with unmatched escaped close curly-brace, so save dest_subdir here # before we escape the curly-braces. # regsub messes up when directory names have embedded spaces # set dest_subdir "" # regsub "$src_dir" "$src_subdir" "$dest_dir" dest_subdir ;# doesnt always work! # puts "regsub: dest_subdir=$dest_subdir" # So we use string range to correctly get dest_subdir set dest_subdir [string range $src_subdir $src_dir_len end] set dest_subdir "${dest_dir}${dest_subdir}" ;# dont need to insert / # Set the destination file full path name. set dest_path "${dest_subdir}${src_file}" ;# dont need to insert / # Attempt to fix up known curly brace issues. set src_path [fix_curly $src_path $category] set dest_path [fix_curly $dest_path $category] # log_info "main i=$i src_path=$src_path src_subdir=$src_subdir src_file=$src_file \ # dest_subdir=$dest_subdir dest_path=$dest_path category=$category" # Watch for src_path EQ dest_path. Error vs Warning response depends on # what user specified for src_dir & dest_dir. We keep processing this # file, regardless. # set dest_path $src_path ;# test code if {[string tolower $src_path] == [string tolower $dest_path]} { if {[string tolower $src_dir] == [string tolower $dest_dir]} { log_warning "main i=$i src_path EQ dest_path $src_path, src_dir EQ dest_dir $src_dir, presumably this is a self-test, all files MUST be identical!" } else { log_error "main i=$i src_path EQ dest_path $src_path, BUT src_dir=$src_dir NE dest_dir=$dest_dir, something went seriously wrong! (unexp $category)" incr stats_array(total,unexp) incr ::stats_array($category,unexp) } } # Check if destination file exists, copy if requested. set repair "no" if {[file exists "$dest_path"]} { log_info "main i=$i $dest_path found (OK $category)" "true" } else { log_error "main i=$i dest_path=$dest_path NOT found (missing $category)" $copy_opt # Always count missing files. These stats help explain what we really did. incr stats_array(total,miss) incr stats_array($category,miss) # If requested, copy the file. File copy success is NOT logged, as # we will keep processing this file. However, file copy error is always # logged, as this will be the last thing we do for this file. set rc [copy_file $i "$src_path" "$dest_path" "$dest_subdir" $copy_opt $category] if {$rc == "OK"} { # File was successfully copied. set repair "yes" ;# shows we are attempting to repair file } else { # If copy_opt was null, then we did NOT try to copy the file, and # we move on to the next file, perfectly normal occurance. # If copy_opt was true, we tried and failed to copy this file. # The copy error is logged, and we move on to the next file. continue } } # Compare src & dest files. The first compare error can be suppressed # when copy_opt is true. set rc [compare_files $i "$src_path" "$dest_path" $copy_opt $category] if {$rc == "OK"} { # Are we trying to repair this file? if {$repair == "yes"} { # Repairs are complete. incr stats_array(total,repr) incr stats_array($category,repr) log_info "main i=$i repair(1) succeeded $dest_path (OK $category)" } # Processing this file is all done. continue } else { # Files are different. Do we copy and compare again? if {$::copy_opt != ""} { set rc [copy_file $i "$src_path" "$dest_path" "$dest_subdir" $copy_opt $category] if {$rc != "OK"} { # We tried and failed to copy this file. Copy error will always be logged. # First compare failed, so add this file to running list in DOS batch file for manual retry later on. log_retry $i $src_path $dest_path "" continue } # One last try at comparing these files. At this point, we always log # the compare errors. set rc [compare_files $i "$src_path" "$dest_path" "" $category] if {$rc == "OK"} { incr stats_array(total,repr) incr stats_array($category,repr) log_info "main i=$i repair(2) succeeded $dest_path (OK $category)" } } } } # Cleanup routine cleanup