#!/usr/bin/perl
### blora-examine.perl  -*- Perl -*-
## Produce an mtree(8)-like range map file for given block device snapshots.

### Ivan Shmakov, 2022

## To the extent possible under law, the author(s) have dedicated
## all copyright and related and neighboring rights to this software
## to the public domain worldwide.  This software is distributed
## without any warranty.

## You should have received a copy of the CC0 Public Domain Dedication
## along with this software.  If not, see
## <http://creativecommons.org/publicdomain/zero/1.0/>.

### History:

## 0.4  2022-11-27 11:45Z
##      Support --compare=.

## 0.3  2022-11-17 13:27:30Z
##      (sfn.925qs1Veo8ISkoUTtGbYjuQPV2OTAACdBREo6WhyGdk.perl)
##      Support --only=.
##      (add_range): New function.
##      (bsearch_map): Likewise.

## 0.2  2022-11-15 19:15:34Z
##      (sfn.z83aeN3cln0YCCpyV7lS1bfmv69rGQl0a3z5uPcEna8.perl)
##      (may_be_print): Fixed: remove optional + offset and also .
##      non-negative decimal integer before it separately (was:
##      impossible match after a greedy regular expression.)

## 0.1  2022-11-15 14:35:11Z
##      (sfn.eQF92GK6LMx4CRiLTU1UYWLsoIUGbZ2qBigr6xeuh_I.perl)
##      Initial revision.

### Code:

use common::sense;
use English qw (-no_match_vars);

require Getopt::Long;

our @enc
    = split (//, "0123456789ABCDEFGHJKMNPQRSTVWXYZ");
sub encode
{
    my $v = ($_[0] =~ /^0/ ? oct ($_[0]) : $_[0]);
    local $_ = "0" . unpack ("B*", pack ("Q>", $v));
    s/(.{5})/${ \$enc[oct ("0b" . $1)] }/g;
    ## .
    $_;
}

sub safestr
{
    ## .
    ($_[0] =~ s/[^ -~]/${ \sprintf ("\\%03o", ord ($&)); }/rg);
}

sub add_range
{
    my ($arg_name, $arg) = @_;
    our ($debug_p, @range_map);
    while (($arg =~ /\G[\s,]*([0-9]+)[+]([0-9]+)\b/gc)) {
        my ($z, $o)
            = ($1, $2);
        warn ("D: adding ", $z, "+", $o, "\n") if ($debug_p);
        if (1 > @range_map) {
            @range_map
                = ($o, $z + $o);
            next;
        }
        my ($i, $j)
            = map { bsearch_map ($_); } ($o, $z + $o);
        warn ("D: adding at ", $i, ":", $j, "\n") if ($debug_p);
        if (0 == $i % 2) {
            $range_map[$i] = $o
                if ($range_map[$i] > $o);
            if ($i == $j) {
                ## do nothing
            } elsif (0 == $j % 2) {
                splice (@range_map, 1 + $i, $j - $i - 1);
            } else {
                splice (@range_map, 1 + $i, $j - $i, $z + $o);
            }
        } else {
            my @a
                = ($range_map[$i] == $o ? () : ($range_map[$i], $o));
            push (@a, $z + $o)
                if (0 != $j % 2);
            splice (@range_map, $i, 1 + $j - $i, @a);
        }
    } continue {
        warn ("D: map: ", join (" ", @range_map), "\n") if ($debug_p);
    }
    ## .
    die ("Cannot parse --only=: ", substr ($arg, pos ($arg)))
        unless (length ($arg) == pos ($arg));
}

sub bsearch_map
{
    my ($val, $from, $to) = @_;
    our (@range_map);
    $from
        //= 0;
    $to //= @range_map;
    while ($from < -1 + $to) {
        my $i = (1 + $from + $to) >> 1;
        my $c;
        if (($c = ($range_map[$i] <=> $val)) == 0) {
            ## .
            return $i;
        } elsif ($c < 0) {
            $from = $i;
        } else {
            $to = $i;
        }
    }
    ## .
    $from;
}

## main

Getopt::Long::Configure (qw (gnu_compat));

our ($debug_p)
    = (0);
our ($block_z, @range_map)
    = (2048);
our (@compare)
    = ();

my $parsable_p
    = Getopt::Long::GetOptions (q (compare=s)   => \@compare,
                                q (debug!)      => \$debug_p,
                                q (only=s)      => \&add_range,
                                q (block=i)     => \$block_z)
    or die ("Fatal: Cannot parse command line arguments");

die ($block_z, " not a multiple of 512\n")
    unless ($block_z > 0 && 0 == $block_z % 512);
our ($b_x) = ($block_z >> 9);

our ($ma_f, $pr_f, $pr_s)
    = ();
sub may_be_print
{
    $pr_s
        //= $NR
        if ($_[0]);
    ## .
    return
        unless (defined ($pr_s) && defined ($pr_f));
    warn ("D: ", join (", ", $pr_s // "undef", $NR, $pr_f), "\n")
        if ($debug_p);
    my ($dest)
        = ($ma_f =~ m {(?:.*/)?([^/]+)})
        or die ("XXX: ", $ma_f, " (", $pr_f, ")\n");
    my ($off)
        = ($dest =~ /(?:\.[0-9]+)?(?:\+([0-9]+))\b/);
    if (defined ($off)) {
        $dest =~ s///;
    } else {
        $off = 0;
    }
    my $z
        = ($NR - $pr_s) * $block_z;
    printf (("./%s/%s size=%d " . (! $z ? "\n" : "cut-out=+%d,%s \n")),
            $dest, encode ($pr_s * $b_x + $off),
            $z, $pr_s * $block_z, $pr_f);
    $pr_s = undef;
}

local $/
    = \$block_z;
my ($z, @com)
    = ("\0" x $block_z);
## FIXME: never read blocks outside of --only=
while (<<>>) {
    if ($ma_f ne $ARGV) {
        may_be_print (1);
        ($ma_f, $pr_f, $NR, $pr_s) = ($ARGV, $ARGV, 0);
    }

    my $ri
        = bsearch_map ($NR);
    warn ("D: block ", $NR, ", range map #", $ri, "\n") if ($debug_p);
    if (1 == $ri % 2 || $NR < $range_map[$ri]) {
        if ($ri >= $#range_map) {
            warn ("D: closing after ", $NR, "\n") if ($debug_p);
            may_be_print (1);
            $pr_f = undef;
            close (ARGV);
            next;
        }
        my $skip
            = -1 + $range_map[0 == $ri % 2 ? $ri : 1 + $ri] - $NR;
        warn ("D: skip ", $skip, " blocks from 1 + ", $NR, "\n")
            if ($debug_p);
        die ()
            unless ($skip > 0);
        seek (ARGV, $skip * $block_z, 1)
            or die (safestr ($ARGV), ": seek failed: ", $!);
        may_be_print ();
        $NR += $skip;
        next;
    }

    if ($z eq $_) {
        may_be_print ();
        next;
    }
    my $eq_f
        = $ma_f;
    for (my $i = 0; $i < @compare; ++$i) {
        my $f_n
            = $compare[$i];
        ## FIXME: excessive calls to seek?
        unless (defined ($com[$i])) {
            ## .
            open ($com[$i], "<", $compare[$i])
                or die (safestr ($f_n), ": Cannot open file: ", $!);
        }
        local $NR;
        $com[$i]->seek ($NR * $block_z, 0)
            or die (safestr ($f_n), ": seek failed: ", $!);
        my $b
            = $com[$i]->getline ();
        if ($b eq $_) {
            $eq_f
                = $f_n;
            last;
        }
    }
    unless (defined ($pr_s) && $eq_f eq $pr_f) {
        may_be_print ();
        ($pr_s, $pr_f)
            = ($NR, $eq_f);
    }
}
++$NR;
$pr_f
    = $ma_f;
may_be_print (1);

### blora-examine.perl ends here