#!/usr/bin/tclsh
#
# <License>
# "comeforth" -- Scan, view, and assemble raw filesystem blocks.
# Copyright (c) 2003-2004 Danamis Associates (http://danamis.com).
#
# This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License
# as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version.
# 
# This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details.
# 
# You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free
# Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# <Description>
# Parse raw filesystem blocks, or block image data produced by "dls", found in the TASK kit from www.atstake.com. This was
# inspired by lazarus (www.porcupine.org/forensics) but provides a bit more flexibility for processing very large data sets.
# 
# Blocks of certain file types or matching certain regular expressions are first found and saved in a scan phase.
# 
# After scanning, blocks that have been saved can be viewed, and based on their contents files can be reassembled from various
# other blocks. An auto-assemble feature is provided which can reassemble a complete file in many cases, knowing only the first
# block in the file (only for ext2/ext3 filesystems).
#
# <Usage>
# comeforth -?
#
# <Notes>
# - You'll need Tcl 8.4 compiled with 64 bit support if you want to work on more than 2GB.
# - You need to be on a somewhat ANSI-compatible terminal (for reverse video). Note: For now, reverse video escapes are completely
#   disabled on Windows.
# - At least a 132x40 terminal is necessary for 4K blocks.
# - This is tested mainly on Linux; everything SHOULD work with Windows, but Cygwin would be required (www.cygwin.com), or at least
#   a Unix-ish "file" command in your path.
# - If you want to use a file containing multiple regexes, it's best to append all of them into a single long one with backslash at
#   the end of each line. This is because each regex has to be compiled before it's used.
#
# <Signature>
# Created Feb 2003 by Dan Higgins.
# Last updated $Id: comeforth,v 1.12 2004/07/02 21:25:09 dan Exp $.

# -------------------------------------------------------------------------
# Main
# -------------------------------------------------------------------------

proc main {} { uplevel \#0 {

set errC [catch {

puts "
comeforth 1.12, Copyright (c) 2003-2004 Danamis Associates (http://danamis.com).
This program comes with ABSOLUTELY NO WARRANTY; this is free software, and you
are welcome to redistribute it under certain conditions; for details view the
GNU Lesser General Public License at http://www.gnu.org."

# -------------------------------------------------------------------------
# Global defaults

if {$tcl_platform(platform) != {windows}} {
    set HaveTerm 1
    set vRev "\033\[7m"
    set vNor "\033\[m"
} else {
    set HaveTerm 0
    set vRev {}
    set vNor {}
}

if {0xffffffff < 0} {
    set WideFunc {}
    puts "\n- WARNING: File size limit is 2GB."
} else {
    set WideFunc wide
}

set ScreenWidth 132
set doScan 1
set SkipTo 0

# Help when not outputting newlines
fconfigure stdout -buffering none

# -------------------------------------------------------------------------
# Process args

for {set i 0} {$i < [llength $argv]} {incr i} {
    set arg [lindex $argv $i]
    if {[string match -noscan $arg]} {
        set doScan 0

    } elseif {[regexp -- {-width(.*)} $arg {} val]} {
        if {$val == {}} { set val [lindex $argv [incr i]] }
        set ScreenWidth $val
        
    } elseif {[regexp -- {-skip(.*)} $arg {} val]} {
        if {$val == {}} { set val [lindex $argv [incr i]] }
        set SkipTo $val
        
    } else {
        usage "Invalid argument '$arg'."
    }
}

# -------------------------------------------------------------------------
# Get parameters

set file [lindex [glob -nocomplain *.dls] 0]
set file [getParam "Data file" $file]
if {! [file exists $file]} { error "Can't open $file." }
set fileSz [getSize $file]

set blockSz [getParam "Data block size" 4096]
set numBlocks [expr {$fileSz / $blockSz}]
if {($fileSz % $blockSz) != 0} {
    puts "\n- WARNING: The file is not a whole number of blocks."
}

set tgtDir [getParam "Recovery directory" recov]
if {! [file exists $tgtDir]} { file mkdir $tgtDir }

if {$doScan} {
    
    # ---------------------------------------------------------------------
    # Scan-only params

    set helpStr    "- Enter an empty \"File type regex\" to specify a custom data regex.\n"
    append helpStr "- Use \"< file\" to specify a file with 1 regex per line;\n"
    append helpStr "  long lines can be split with \"\\\".\n"
    append helpStr "- Backslash substitution is performed on this input,\n"
    append helpStr "  whether from a file or entered directly."

    set typeRe [getParam "File type regex\n" {} $helpStr]
    if {$typeRe == {}} {
        set haveCustRe 1
        set custRe [getParam "Custom data regex\n" {} $helpStr]
        if {$custRe == {}} {
            error "Either file type or custom regex is required."
        }
        set userRes [parseReParam $custRe]
        
        set checkByteSz [getParam "Number of bytes to check" $blockSz]
        if {$checkByteSz < $blockSz} {
            set checkByteOff [getParam "Offset of bytes to check" 0]
        } else {
            set checkByteOff 0
        }
        
    } else {
        set haveCustRe 0
        set userRes [parseReParam $typeRe]
        set workDir "[file tail $argv0]-[pid].tmp"
        set workDir [getParam "Block work dir" $workDir]
        if {! [file exists $workDir]} { file mkdir $workDir }
    }
    
    set progStep [expr {$numBlocks / 10000}]
    if {$progStep < 10} { set progStep 10 }
    set progStep [getParam "Progress indicator block interval" $progStep]
    
    if {$SkipTo < 1} {
        set startBlock [getParam "Start at block" 1]
    } else {
        puts "\n- Starting at block ${SkipTo}."
        set startBlock $SkipTo
    }
    
    # ---------------------------------------------------------------------
    # Scan defaults
    
    # How many digits should block filenames have (so sorts work)
    set maxBlockNumDigs [expr {int(log10($numBlocks)) + 1}]
    
    if {! $haveCustRe} {
        # How many blocks to feed to the "file" command at a time.
        # Note that this can be tuned for your particular system, by adjusting
        # until the reported blocks/second is maximized.
        set fileBuffCountMax 100
        set fileBuffNamePad [expr {int(log10($fileBuffCountMax)) + 1}]
        # This var avoids doing a glob over and over inside the main loop.
        set fileBuffNames [list]
        for {set i 1} {$i <= $fileBuffCountMax} {incr i} {
            lappend fileBuffNames "$workDir/[::util::zpad $i $fileBuffNamePad]"
        }
    }
    
    # ---------------------------------------------------------------------
    # Scan for blocks
    
    puts "\nScanning data for matching blocks..."
    
    set startScanTs [::progressIndicator::ts]
    
    set inFh [open $file r]
    fconfigure $inFh -translation binary
    
    if {$startBlock > 1} {
        puts "- Skipping to block $startBlock..."
        seek $inFh [calcByteOffset $startBlock] start
    }
    set blockNum [expr {$startBlock - 1}]
    
    if {! $haveCustRe} { # Scan for file types

        set fileBuffNum 0
        set prNums 0
        ::progressIndicator::start $numBlocks $startBlock
        # Optimize this loop!
        while 1 {
            # Read in block and write to working dir
            set block [read $inFh $blockSz]
            incr blockNum
            
            set tmpFh [open [lindex $fileBuffNames $fileBuffNum] w]
            fconfigure $tmpFh -translation binary
            puts -nonewline $tmpFh $block
            close $tmpFh
            incr fileBuffNum
            
            set done [expr {$blockNum == $numBlocks}]
            
            # Check if it's time to process buffered blocks
            if {$fileBuffNum == $fileBuffCountMax || $done} {
    
                if {$done} {
                    # Prepare for a partial set of buffered blocks
                    set fileBuffNames [lrange $fileBuffNames 0 [expr {$fileBuffNum - 1}]]
                }
                
                # Run the file command with all buffered block files at once
                set fileTypes [split [eval exec file $fileBuffNames] \n]
                
                # Process results of file command.
                # Note that a regular for loop would be most efficient here, but the file command sometimes
                # includes garbage in a file description that includes extra newlines. Hence, the
                # [string match ...] is needed.
                set i 0
                foreach fType $fileTypes {
                    if {! [string match $workDir/* $fType]} continue
                    incr i
                    foreach typeRe $userRes {
                        if {[regexp -- $typeRe $fType]} {
                            set relBlockNum [expr {$blockNum - $fileBuffNum + $i}]
                            file copy $workDir/[::util::zpad $i $fileBuffNamePad] $tgtDir/[::util::zpad $relBlockNum $maxBlockNumDigs]
                            if {! $prNums} {
                                set prNums 1
                                puts -nonewline "\nBlock found: $relBlockNum"
                            } else {
                                puts -nonewline ", $relBlockNum"
                            }
                            break
                        }
                    }
                }
    
                set fileBuffNum 0
            }
    
            # Display progress
            if {$blockNum % $progStep == 0 || $done} {
                # Note: Both checks are needed here in case only 1 block is being scanned.
                if {$blockNum != $startBlock || $done} {
                    if {$prNums} {
                        set prNums 0
                        puts {}
                    }
                    ::progressIndicator::display $blockNum
                }
                if {$done} break
            }
        } ;# while 1
    
    } else { # Scan for matching data
        
        set prNums 0
        set checkByteSz [expr {$checkByteSz + $checkByteOff - 1}] ;# actual index instead of size
        # Next var helps optimize by avoiding an unneeded foreach loop.
        set haveOneRe [expr {[llength $userRes] == 1}]
        if {$haveOneRe} {
            set custRe [lindex $userRes 0]
        }
        ::progressIndicator::start $numBlocks $startBlock
        # Optimize this loop!
        while 1 {
            # Read in block
            set block [read $inFh $blockSz]
            incr blockNum
            
            set done [expr {$blockNum == $numBlocks}]
            
            # Process raw contents of block.
            if {$haveOneRe} {
                checkCustReBlock
            } else {
                foreach custRe $userRes {
                    checkCustReBlock
                    if {$matched} break
                }
            }

            # Display progress
            if {$blockNum % $progStep == 0 || $done} {
                # Note: Both checks are needed here in case only 1 block is being scanned.
                if {$blockNum != $startBlock || $done} {
                    if {$prNums} {
                        set prNums 0
                        puts {}
                    }
                    ::progressIndicator::display $blockNum
                }
                if {$done} break
            }
        }
    }
    
    close $inFh
    
    puts "\nFinished scanning filesystem data in [::progressIndicator::timeSince $startScanTs]."
    
    set ok [getParam "Inspect and assemble files? (\[y]es/\[q]uit)" y]
    if {$ok != {y}} { exit 0 }

} ;# if {$doScan}

# -------------------------------------------------------------------------
# Begin inspecting blocks and writing to files

# Open data file for reading
set inFh [open $file r]
fconfigure $inFh -translation binary

# Build list of block files to process
set datFiles [list]
foreach datFile [lsort [glob -nocomplain $tgtDir/*]] {
    set datFile [file tail $datFile]
    if {[regexp {^[0-9]+$} $datFile]} {
        lappend datFiles $datFile
    }
}
set numFiles [llength $datFiles]

# Process each block file
set fileNum 0
set testFileName {}
set newName {}
set opts [list]
foreach datFile $datFiles {
    incr fileNum
    
    # Make sure current block should be processed
    set blockNum $datFile; regsub {^0+} $blockNum {} blockNum
    if {$blockNum < $SkipTo} continue
    
    # Init for processing file for current block
    set excludeBlocks [list]
    set readNeeded 1
    set startNum $blockNum
    set datPos [calcByteOffset $blockNum]
    seek $inFh $datPos start
    
    # Add blocks to create new file
    while 1 {
        
        set numOptsQed [llength $opts]
        
        # Get current block and display it
        if {$readNeeded} {
            set block [read $inFh $blockSz]
            puts {}; nicePrint block
        }
        
        # Options
        puts "\nCurrent file: $datFile ($fileNum/$numFiles), Viewing block: $blockNum."
        puts "Excluded blocks: [list $excludeBlocks], Start block: $startNum"
        puts -nonewline {[?] help: }
        if {$numOptsQed == 0} {
            gets stdin opt
            set opts [split $opt \;]
        } else {
            puts [string trim [join $opts \;]]
        }
        
        set opt [string trim [lindex $opts 0]]
        set opts [lreplace $opts 0 0]
        
        if {[set i [lsearch -exact {e e! r ?} $opt]] >= 0} {
            if {$i == 0} {
                if {[set i [lsearch -exact $excludeBlocks $blockNum]] < 0} {
                    lappend excludeBlocks $blockNum
                } else {
                    set excludeBlocks [lreplace $excludeBlocks $i $i]
                }
            } elseif {$i == 1} {
                set excludeBlocks [list]
            } elseif {$i == 2} {
                set startNum $blockNum
            } elseif {$i == 3} {
                puts {}
                puts {Blocks: [n]ext, [p]revious, [(+|-)n] advance n (expr), [=n] go to n (expr),}
                puts {        [e]xclude, [e!] clear excludes, [r]eset start}
                puts {Files: [t]est write, [w]rite, [m]ark done, [s]kip,}
                puts {       [a]uto assemble (ext2/ext3 only; current must be first block)}
                puts {Other: [;] multiple command delimiter, [q]uit}
            }
            set readNeeded 0
            continue
        }
        
        set readNeeded 1 ;# default to viewing a new block (moving the seek position)
        
        if {$opt == {n}} {
            set opt {+1}
        } elseif {$opt == {p}} {
            set opt {-1}
        }
        
        if {[regexp {^[+-].+$} $opt cnt]} {
            set cnt [expr $cnt]
            incr blockNum $cnt
            seek $inFh [expr {$blockSz * ($cnt - 1)}] current
            continue
        } elseif {[regexp {^=(.+)$} $opt {} cnt]} {
            set blockNum [expr $cnt]
            seek $inFh [calcByteOffset $cnt] start
            continue
        } elseif {$opt == {s}} {
            break
        } elseif {$opt == {q}} {
            exit
        } elseif {[lsearch -exact {w m t a} $opt] < 0} {
            puts "\n- Option '$opt' ignored."
            set readNeeded 0
            continue
        }
        
        # If we get here, it's time to save and/or rename files
        if {[lsearch -exact {w t a} $opt] >= 0} {
            
            # Get target file's name
            if {$opt == {w}} {
                while 1 {
                    set newName [getParam "New file name (in $tgtDir/, last was '$newName')\n"]
                    if {! [file exists $tgtDir/$newName]} break
                    if {[string equal $newName $testFileName]} break
                    puts "\nThis file already exists. Please use a different name."
                }
                set outName $newName
            } else {
                set testFileName [getParam "Test file name (in $tgtDir/)" $testFileName]
                set outName $testFileName
            }
            
            # Write out the blocks
            if {$opt != {a}} {
                seek $inFh [calcByteOffset $startNum] start
                set outFh [open $tgtDir/$outName w]
                fconfigure $outFh -translation binary
                for {set i $startNum} {$i <= $blockNum} {incr i} {
                    set block [read $inFh $blockSz]
                    if {[lsearch -exact $excludeBlocks $i] >= 0} continue
                    puts -nonewline $outFh $block
                }
                close $outFh
            } else {
                autoAssemble
            }
            
            if {$opt == {t} || $opt == {a}} {
                set readNeeded 0
            }
            
            puts "\n- File saved successfully."
        }
        
        if {$opt != {t} && $opt != {a}} {
            file rename $tgtDir/$datFile $tgtDir/${datFile}.done
            puts "\n- Block file renamed successfully."
            break ;# moves on to next block file
        }
    
    } ;# while 1

} ;# foreach datFile

close $inFh

} errM]

if {$errC} {
    puts "\n$errM\n"
    exit $errC
}

}} ;# main

# -------------------------------------------------------------------------

proc checkCustReBlock {} {
    
    if {[set ::matched [regexp -- $::custRe [string range $::block $::checkByteOff $::checkByteSz]]]} {
        set ::tmpFh [open $::tgtDir/[::util::zpad $::blockNum $::maxBlockNumDigs] w]
        fconfigure $::tmpFh -translation binary
        puts -nonewline $::tmpFh $::block
        close $::tmpFh
        if {! $::prNums} {
            set ::prNums 1
            puts -nonewline "\nBlock found: $::blockNum"
        } else {
            puts -nonewline ", $::blockNum"
        }
    }
    
} ;# checkCustReBlock

# -------------------------------------------------------------------------
# Get a parameter from the user.

proc getParam {prompt {default {}} {help {}}} {
    
    set haveHelp [expr {$help != {}}]
    set txt "\n$prompt"
    if {$haveHelp} {
        if {! [regexp {\s$} $txt]} {
            append txt { }
        }
        append txt {([?] for help)}
    }
    append txt ": $default[string repeat "\b" [string length $default]]"
    while 1 {
        puts -nonewline $txt
        gets stdin param
        if {(! $haveHelp) || $param != {?}} break
        puts "\n$help"
    }
    if {$param == {}} { set param $default }

    set haveEsc [expr {[string first \\ $param] >= 0}]
    set param [subst -nocommands -novariables $param]
    if {$haveEsc} {
        puts -nonewline "\n- Translated to: \""
        printBin param
        puts \"
    }

    return $param
    
} ;# getParam

# -------------------------------------------------------------------------
# Nicely print a block of binary data with column indexes to the terminal;
# a final newline is not printed.

proc nicePrint {bin_n} {
    
    upvar $bin_n bin
    
    # Index rows
    for {set i 10} {$i <= $::ScreenWidth} {incr i 10} {
        puts -nonewline "         [expr {$i / 10 % 10}]"
    }
    if {$i != $::ScreenWidth} { puts {} }
    for {set i 1} {$i <= $::ScreenWidth} {incr i} {
        puts -nonewline [expr {$i % 10}]
    }
    puts -nonewline [string repeat - $::ScreenWidth]
    
    printBin bin
    
} ;# nicePrint

# -------------------------------------------------------------------------
# Nicely print a block of binary data to the terminal;
# a final newline is not printed.

proc printBin {bin_n} {
    
    upvar $bin_n bin
    
    set isRev 0
    binary scan $bin c* cs
    foreach c $cs {
        set c [expr {($c + 256) % 256}]
        if {$c < 32 && $::HaveTerm} {
            if {! $isRev} { set isRev 1; puts -nonewline $::vRev }
            puts -nonewline [binary format c [expr {$c + 64}]]
        } elseif {$c > 126 || $c < 32} {
            if {! $isRev} { set isRev 1; puts -nonewline $::vRev }
            puts -nonewline *
        } else {
            if {$isRev} { set isRev 0; puts -nonewline $::vNor }
            puts -nonewline [binary format c $c]
        }
    }
    if {$isRev} { puts -nonewline $::vNor }
    
} ;# printBin

# -------------------------------------------------------------------------

proc calcByteOffset {blockNum} {
    
    return [expr "(${::WideFunc}($blockNum) - 1) * $::blockSz"]
    
} ;# calcByteOffset

# -------------------------------------------------------------------------

# Calculate size of either a regular file or block device.

proc getSize {path} {
    
    set t [file type $path]
    if {$t == {file}} {
        return [file size $path]

    } elseif {$t == {blockSpecial}} {
        set fh [open $path r]
        seek $fh 0 end
        set sz [tell $fh]
        close $fh
        return $sz

    } else {
        error "Type of '$path' is not supported."
    }
    
} ;# getSize

# -------------------------------------------------------------------------

proc usage {msg} {
    
    puts stderr $msg
    puts stderr "Usage:"
    puts stderr "    [file tail $::argv0] \[-noscan] \[-width <width>] \[-skip <block>]"
    puts stderr "where:"
    puts stderr "    -noscan = don't perform scan of data, go immediately into file"
    puts stderr "        assembly mode."
    puts stderr "    <width> = width of terminal; default is 132."
    puts stderr "    <block> = starting block, whether scanning or assembling."
    
    exit 1
    
} ;# usage

# -------------------------------------------------------------------------

proc parseReParam {arg} {
    
    if {! [regexp {^<(.+)} $arg {} path]} {
        return [list $arg]
    }
    
    set path [string trim $path]
    set fh [open $path r]
    set lines [split [read $fh] "\r\n"]
    close $fh
    
    set lastRe {}
    set res [list]
    foreach re $lines {
        if {[string length $re] == 0} continue
        if {[string index $re 0] == "#"} continue
        if {[string match {*\\} $re]} {
            append lastRe [string range $re 0 end-1]
        } else {
            append lastRe $re
            lappend res [subst -novariables -nocommands $lastRe]
            set lastRe {}
        }
    }
    
    if {[set i [llength $res]] == 0} {
        return -code error "No regular expression lines were found."
    }
    
    puts "\n- Found $i regex[expr {($i == 1)? "" : "es"}] to use in '$path'."

    return $res
    
} ;# parseReParam

# -------------------------------------------------------------------------
# Try to automatically assemble an ext2/ext3 file by processing index
# blocks. This is useful if you don't have the file's original inode, only
# the start block of the file.

proc autoAssemble {} {
    
    puts "\n- Auto assemble of ext2/ext3 file starting at block ${::blockNum}..."
    
    set blocks [list]
    
    # Get first 12 blocks (smallest file size for this algo)
    for {set i 0} {$i < 12} {incr i} {
        lappend blocks [expr {$::blockNum + $i}]
    }
    
    # Try to get single-indirect block
    set doWarn 0
    seek $::inFh [calcByteOffset "$::blockNum + 12"] start
    set indBlks [parseIndBlk [read $::inFh $::blockSz]]
    set ok [isIndBlk indBlks]
    
    if {$ok} { # We have at least 13 blocks
        
        puts "- Single-indirect block found, adding [llength $indBlks] blocks."
        set blocks [concat $blocks $indBlks]

        if {[llength $indBlks] == ($::blockSz / 4)} {
            # We must have a double-indirect block; try to find it
            seek $::inFh [calcByteOffset "$::blockNum + 12 + ($::blockSz / 4) + 1"] start
            set indBlks [parseIndBlk [read $::inFh $::blockSz]]
            set ok [isIndBlk indBlks]
            
            if {$ok} { # We have the double-indirect block; read the index blocks it points to
                puts "- Double-indirect block found..."
                foreach i $indBlks {
                    seek $::inFh [calcByteOffset $i] start
                    set indBlks2 [parseIndBlk [read $::inFh $::blockSz]]
                    puts "  From block index at $i, adding [llength $indBlks2] blocks."
                    set blocks [concat $blocks $indBlks2]
                }
            } else {
                set doWarn 1
            }
        }
        
    } else {
        set doWarn 1
    }
    
    if {$doWarn} {
        puts "- WARNING: File size may be incorrect."
    }

    # Put the list of blocks together into a file
    set exBlks [list]
    set lastI $::blockNum
    set outFh [open $::tgtDir/$::outName w]
    fconfigure $outFh -translation binary
    foreach i $blocks {
        if {[lsearch -exact $::excludeBlocks $i] >= 0} {
            lappend exBlks $i
            continue
        }
        seek $::inFh [calcByteOffset $i] start
        set block [read $::inFh $::blockSz]
        puts -nonewline $outFh $block
        set lastI $i
    }
    close $outFh
    set nBlocks [expr {[llength $blocks] - [llength $exBlks]}]
    puts "- Total blocks assembled is $nBlocks ([expr {$nBlocks * $::blockSz}] bytes)."
    puts "- Excluded blocks were [list $exBlks]."
    puts "- Relevant block range is ${::blockNum}-${lastI}."
    
    # Done.
    seek $::inFh [calcByteOffset $::blockNum] start
    
} ;# autoAssemble

# -------------------------------------------------------------------------

proc parseIndBlk {blk} {
    
    # Convert 4-byte groups into little-endian int's
    binary scan $blk i* idxs
    
    set gotZ 0
    set blks [list]
    foreach blk $idxs {
        if {$gotZ} {
            # There was a 0 before, so if anything other than 0 comes up,
            # we know this is an invalid index block.
            if {$blk != 0} { return [list] }
            continue
        }
        if {$blk < 0} { # Try to convert to positive 32-bit int
            set blk [expr {$blk & 0xffffffff}]
            if {$blk < 0} { error "Failed processing block number > 2147483647." }
        }
        if {$blk != 0} {
            lappend blks [incr blk]
        } else {
            set gotZ 1
        }
    }
    return $blks
    
} ;# parseIndBlk

# -------------------------------------------------------------------------
# Try to make sure a list of block numbers come from an index block, by
# checking that the first 3 indexes don't appear "random";
# usually, ext2/3 will allocate up to 8 blocks together.

proc isIndBlk {bList_n} {
    
    upvar $bList_n bList
    set rDist [expr {$::blockSz * 8}]
    set len [llength $bList]
    
    set i1 [lindex $bList 0]
    set i2 [lindex $bList 1]
    set i3 [lindex $bList 2]
    if {[string length $i1] == 0} { set i1 0 }
    if {[string length $i2] == 0} { set i2 0 }
    if {[string length $i3] == 0} { set i3 0 }
    set d1 [expr {$i2 - $i1}]
    set d2 [expr {$i3 - $i2}]
    
    set ok [expr {($d1 == 1 && $d2 == 1)}] ;# best case, 3 consecutive blocks
    set ok [expr {$ok || ($d1 > 0 && $d1 < $rDist && $d2 > 0 && $d2 < $rDist)}] ;# sorted blocks within reasonable distance
    set ok [expr {$ok || ($len >= 1 && $len <= 3)}] ;# only 1, 2, or 3 blocks
    # Others here?
    
    return $ok
    
} ;# isIndBlk

# -------------------------------------------------------------------------

namespace eval ::progressIndicator {
    
    # ---------------------------------------------------------------------

    proc start {ntotal startPoint} {

        variable avg 0
        variable avgCount 0
        variable lastDone [expr {$startPoint - 1}]
        variable total $ntotal

        variable lastTs [clock clicks -milliseconds]

    } ;# start

    # ---------------------------------------------------------------------

    proc display {current} {
        
        variable avg
        variable avgCount
        variable lastDone
        variable lastTs
        variable total
        
        set ts [clock clicks -milliseconds]
        if {$ts == $lastTs && $current == $lastDone} return
        if {$ts == $lastTs} { set ts [expr {$ts + 0.1}] }
        set avg [expr {$avg + (double($current - $lastDone) / ($ts - $lastTs) * 1000 - $avg) / [incr avgCount]}]
        
        set s "$current, [format %#0.2f [expr {double($current) / $total * 100}]]%"
        append s ", [format %#0.1f $avg] per sec"
        append s ", [format %#0.1f [expr {(double($total) - $current) / $avg / 60}]] min rem... "
        
        puts -nonewline "$s[string repeat "\b" [string length $s]]"
    
        set lastTs $ts
        set lastDone $current
        
    } ;# display
    
    # ---------------------------------------------------------------------

    proc ts {} {
        
        return [clock clicks -milliseconds]
        
    } ;# ts

    # ---------------------------------------------------------------------

    proc secsSince {ts} {
        
        return [format %\#0.3f [expr {([clock clicks -milliseconds] - $ts) / 1000.0}]]
        
    } ;# secsSince

    # ---------------------------------------------------------------------

    proc minsSince {ts} {
        
        return [format %\#0.2f [expr {[secsSince $ts] / 60.0}]]
        
    } ;# minsSince

    # ---------------------------------------------------------------------

    proc timeSince {ts} {
        
        set tm [expr {round([secsSince $ts])}]
        set str [::util::zpad [expr {$tm % 60}] 2] ;# secs

        set tm [expr {$tm / 60}]
        set str "[::util::zpad [expr {$tm % 60}] 2]:$str" ;# mins

        set tm [expr {$tm / 60}]
        set str "$tm:$str" ;# hrs

        return $str
        
    } ;# timeSince

    # ---------------------------------------------------------------------

} ;# ::progressIndicator

# -------------------------------------------------------------------------

namespace eval ::util {

    # ---------------------------------------------------------------------
    # Left-pad a number with zeroes
    
    proc zpad {num len} {
        
        if {[set l [string length $num]] >= $len} { return $num }
        
        return "[string repeat 0 [expr {$len - $l}]]$num"
        
    } ;# zpad
    
    # ---------------------------------------------------------------------

} ;# ::util

# -------------------------------------------------------------------------
# Run.

main

# -------------------------------------------------------------------------
