#! /usr/bin/perl -w
# Display and edit the 'dev' field in tar's snapshots
# Copyright (C) 2007, 2011 Free Software Foundation, Inc.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3, or (at your option)
# any later version.
#
# This program 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 General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301, USA.
#
#
# tar-snapshot-edit
#
# This script is capable of replacing values in the 'dev' field of an
# incremental backup 'snapshot' file.  This is useful when the device
# used to store files in a tar archive changes, without the files
# themselves changing.  This may happen when, for example, a device
# driver changes major or minor numbers.
#
# It can also run a check on all the field values found in the
# snapshot file, printing out a detailed message when it finds values
# that would cause an "Unexpected field value in snapshot file" error
# if tar were run using that snapshot file as input.  (See the
# comments included in the definition of the check_field_values
# routine for more detailed information regarding these checks.)
#
#
#
# Author: Dustin J. Mitchell <dustin@zmanda.com>
#
# Modified Aug 25, 2011 by Nathan Stratton Treadway <nathanst AT ontko.com>:
#   * update Perl syntax to work correctly with more recent versions of
#     Perl.  (The original code worked with in the v5.8 timeframe but
#     not with Perl v5.10.1 and later.)
#   * added a "-c" option to check the snapshot file for invalid field values.
#   * handle NFS indicator character ("+") in version 0 and 1 files
#   * preserve the original header/version line when editing version 1
#     or 2 files.
#   * tweak output formatting
#
#

use Getopt::Std;

## reading

sub read_incr_db ($) {
    my $filename = shift;
    open(my $file, "<$filename") || die "Could not open '$filename' for reading";

    my $header_str = <$file>;
    my $file_version;
    if ($header_str =~ /^GNU tar-[^-]*-([0-9]+)\n$/) {
	$file_version = $1+0;
    } else {
	$file_version = 0;
    }

    print "\nFile: $filename\n";
    print "  Detected snapshot file version: $file_version\n\n";

    if ($file_version == 0) {
	return read_incr_db_0($file, $header_str);
    } elsif ($file_version == 1) {
	return read_incr_db_1($file, $header_str);
    } elsif ($file_version == 2) {
	return read_incr_db_2($file, $header_str);
    } else {
	die "Unrecognized snapshot version in header '$header_str'";
    }
}

sub read_incr_db_0 ($$) {
    my $file = shift;
    my $header_str = shift;

    my $hdr_timestamp_sec = $header_str;
    chop $hdr_timestamp_sec;
    my $hdr_timestamp_nsec = ''; # not present in file format 0

    my $nfs;
    my @dirs;

    while (<$file>) {
	/^(\+?)([0-9]*) ([0-9]*) (.*)\n$/ || die("Bad snapshot line $_");

	if ( $1 eq "+" ) {
	  $nfs="1";
	} else {
	  $nfs="0";
	}
	push @dirs, { nfs=>$nfs,
		      dev=>$2,
		      ino=>$3,
		      name=>$4 };
    }

    close($file);

    # file version, timestamp, timestamp, dir list, file header line
    return [ 0, $hdr_timestamp_sec, $hdr_timestamp_nsec, \@dirs, ""];
}

sub read_incr_db_1 ($$) {
    my $file = shift;
    my $header_str = shift;


    my $timestamp = <$file>; # "sec nsec"
    my ($hdr_timestamp_sec, $hdr_timestamp_nsec) = ($timestamp =~ /([0-9]*) ([0-9]*)/);

    my $nfs;
    my @dirs;

    while (<$file>) {
	/^(\+?)([0-9]*) ([0-9]*) ([0-9]*) ([0-9]*) (.*)\n$/ || die("Bad snapshot line $_");

	if ( $1 eq "+" ) {
	  $nfs="1";
	} else {
	  $nfs="0";
	}

	push @dirs, { nfs=>$nfs,
		      timestamp_sec=>$2,
		      timestamp_nsec=>$3,
		      dev=>$4,
		      ino=>$5,
		      name=>$6 };
    }

    close($file);

    # file version, timestamp, timestamp, dir list, file header line
    return [ 1, $hdr_timestamp_sec, $hdr_timestamp_nsec, \@dirs, $header_str ];
}

sub read_incr_db_2 ($$) {
    my $file = shift;
    my $header_str = shift;

    $/="\0"; # $INPUT_RECORD_SEPARATOR
    my $hdr_timestamp_sec = <$file>;
    chop $hdr_timestamp_sec;
    my $hdr_timestamp_nsec = <$file>;
    chop $hdr_timestamp_nsec;
    my @dirs;

    while (1) {
	last if eof($file);

	my $nfs = <$file>;
	my $timestamp_sec = <$file>;
	my $timestamp_nsec = <$file>;
	my $dev = <$file>;
	my $ino = <$file>;
	my $name = <$file>;

	# get rid of trailing NULs
	chop $nfs;
	chop $timestamp_sec;
	chop $timestamp_nsec;
	chop $dev;
	chop $ino;
	chop $name;

	my @dirents;
	while (my $dirent = <$file>) {
	    chop $dirent;
	    push @dirents, $dirent;
	    last if ($dirent eq "");
	}
	die "missing terminator" unless (<$file> eq "\0");

	push @dirs, { nfs=>$nfs,
		      timestamp_sec=>$timestamp_sec,
		      timestamp_nsec=>$timestamp_nsec,
		      dev=>$dev,
		      ino=>$ino,
		      name=>$name,
		      dirents=>\@dirents };
    }

    close($file);
    $/ = "\n"; # reset to normal

    # file version, timestamp, timestamp, dir list, file header line
    return [ 2, $hdr_timestamp_sec, $hdr_timestamp_nsec, \@dirs,  $header_str];
}

## display

sub show_device_counts ($) {
    my $info = shift;
    my %devices;
    foreach my $dir (@{$info->[3]}) {
	my $dev = $dir->{'dev'};
	$devices{$dev}++;
    }

    foreach $dev (sort {$a <=> $b} keys %devices) {
	printf "  Device 0x%04x occurs $devices{$dev} times.\n", $dev;
    }
}

## check field values

# returns a warning message if $field isn't a valid string representation
# of an integer, or if the resulting integer is out of the specified range
sub validate_integer_field ($$$$) {
    my $field = shift;
    my $field_name = shift;
    my $min = shift;
    my $max = shift;

    my $msg = "";

    if ( not $field =~ /^-?\d+$/ ) {
	$msg = "      $field_name value contains invalid characters: \"$field\"\n";
    } else {
	if ( $field < $min ) {
	    $msg = "      $field_name value too low: \"$field\" < $min \n";
	} elsif ( $field > $max ) {
	    $msg = "      $field_name value too high: \"$field\" > $max \n";
	}
    }
    return $msg;
}


# This routine loops through each directory entry in the $info data
# structure and prints a warning message if tar would abort with an
# "Unexpected field value in snapshot file" error upon reading this
# snapshot file.
#
# (Note that this specific error message was introduced along with the
# change to snapshot file format "2", starting with tar v1.16 [or,
# more precisely, v1.15.91].)
#
# The checks here are intended to match those found in the incremen.c
# source file (as of tar v1.16.1).
#
# In that code, the checks are done against pre-processor expressions,
# as defined in the C header files at compile time.   In the routine
# below, a Perl variable is created for each expression used as part of
# one of these checks, assigned the value of the related pre-processor
# expression as found on a Linux 2.6.8/i386 system.
#
# It seems likely that these settings will catch most invalid
# field values found in actual snapshot files on all systems.  However,
# if "tar" is erroring out on a snapshot file that this check routine
# does not complain about, that probably indicates that the values
# below need to be adjusted to match those used by "tar" in that
# particular environment.
#
# (Note: the checks here are taken from the code that processes
# version 2 snapshot files, but to keep things simple we apply those
# same checks to files having earlier versions -- but only for
# the fields that actually exist in those input files.)

sub check_field_values ($) {
    my $info = shift;

    # set up a variable with the value of each pre-processor
    # expression used for field-value checks in incremen.c
    # (these values here are from a Linux 2.6.8/i386 system)
    my $BILLION = 1000000000;        # BILLION
    my $MIN_TIME_T = -2147483648;    # TYPE_MINIMUM(time_t)
    my $MAX_TIME_T = 2147483647;     # TYPE_MAXIUMUM(time_t)
    my $MAX_DEV_T = 4294967295;      # TYPE_MAXIUMUM(dev_t)
    my $MAX_INO_T = 4294967295;      # TYPE_MAXIUMUM(ino_t)


    my $msg;
    my $error_found = 0;

    print "  Checking field values in snapshot file...\n";

    $snapver = $info->[0];

    $msg = "";
    $msg .= validate_integer_field($info->[1],
			   'timestamp_sec', $MIN_TIME_T, $MAX_TIME_T);
    if ($snapver >= 1) {
      $msg .= validate_integer_field($info->[2],
			   'timestamp_nsec', 0, $BILLION-1);
    }
    if ( $msg ne "" ) {
	$error_found = 1;
	print "\n    shapshot file header:\n";
	print $msg;
    }


    foreach my $dir (@{$info->[3]}) {

	$msg = "";

	$msg .= validate_integer_field($dir->{'nfs'}, 'nfs', 0, 1);
	if ($snapver >= 1) {
	  $msg .= validate_integer_field($dir->{'timestamp_sec'},
				'timestamp_sec', $MIN_TIME_T, $MAX_TIME_T);
	  $msg .= validate_integer_field($dir->{'timestamp_nsec'},
				'timestamp_nsec', 0, $BILLION-1);
	}
	$msg .= validate_integer_field($dir->{'dev'}, 'dev', 0, $MAX_DEV_T);
	$msg .= validate_integer_field($dir->{'ino'}, 'ino', 0, $MAX_INO_T);

	if ( $msg ne "" ) {
	  $error_found = 1;
	  print "\n    directory: $dir->{'name'}\n";
	  print $msg;
	}
    }

    print "\n  Snapshot field value check complete" ,
	   $error_found ?  "" : ", no errors found" ,
	   ".\n";
}

## editing

sub replace_device_number ($@) {
    my $info = shift(@_);
    my @repl = @_;

    my $count = 0;

    foreach my $dir (@{$info->[3]}) {
	foreach $x (@repl) {
	    if ($dir->{'dev'} eq $$x[0]) {
		$dir->{'dev'} = $$x[1];
		$count++;
		last;
	    }
	}
    }
    print "  Updated $count records.\n"
}

## writing

sub write_incr_db ($$) {
    my $info = shift;
    my $filename = shift;
    my $file_version = $$info[0];

    open($file, ">$filename") || die "Could not open '$filename' for writing";

    if ($file_version == 0) {
	write_incr_db_0($info, $file);
    } elsif ($file_version == 1) {
	write_incr_db_1($info, $file);
    } elsif ($file_version == 2) {
	write_incr_db_2($info, $file);
    } else {
	die "Unknown file version $file_version.";
    }

    close($file);
}

sub write_incr_db_0 ($$) {
    my $info = shift;
    my $file = shift;

    my $timestamp_sec = $info->[1];
    print $file "$timestamp_sec\n";

    foreach my $dir (@{$info->[3]}) {
	if ($dir->{'nfs'}) {
	  print $file '+'
	}
	print $file "$dir->{'dev'} ";
	print $file "$dir->{'ino'} ";
	print $file "$dir->{'name'}\n";
    }
}


sub write_incr_db_1 ($$) {
    my $info = shift;
    my $file = shift;

    print $file $info->[4];

    my $timestamp_sec = $info->[1];
    my $timestamp_nsec = $info->[2];
    print $file "$timestamp_sec $timestamp_nsec\n";

    foreach my $dir (@{$info->[3]}) {
	if ($dir->{'nfs'}) {
	  print $file '+'
	}
	print $file "$dir->{'timestamp_sec'} ";
	print $file "$dir->{'timestamp_nsec'} ";
	print $file "$dir->{'dev'} ";
	print $file "$dir->{'ino'} ";
	print $file "$dir->{'name'}\n";
    }
}


sub write_incr_db_2 ($$) {
    my $info = shift;
    my $file = shift;

    print $file $info->[4];

    my $timestamp_sec = $info->[1];
    my $timestamp_nsec = $info->[2];
    print $file $timestamp_sec . "\0";
    print $file $timestamp_nsec . "\0";

    foreach my $dir (@{$info->[3]}) {
	print $file $dir->{'nfs'} . "\0";
	print $file $dir->{'timestamp_sec'} . "\0";
	print $file $dir->{'timestamp_nsec'} . "\0";
	print $file $dir->{'dev'} . "\0";
	print $file $dir->{'ino'} . "\0";
	print $file $dir->{'name'} . "\0";
	foreach my $dirent (@{$dir->{'dirents'}}) {
	    print $file $dirent . "\0";
	}
	print $file "\0";
    }
}

## main

sub main {
    our ($opt_b, $opt_r, $opt_h, $opt_c);
    getopts('br:hc');
    HELP_MESSAGE() if ($opt_h || $#ARGV == -1 || ($opt_b && !$opt_r) ||
		       ($opt_r && $opt_c) );

    my @repl;
    if ($opt_r) {
	foreach my $spec (split(/,/, $opt_r)) {
	    ($spec =~ /^([^-]+)-([^-]+)/) || die "Invalid replacement specification '$opt_r'";
	    push @repl, [interpret_dev($1), interpret_dev($2)];
	}
    }

    foreach my $snapfile (@ARGV) {
	my $info = read_incr_db($snapfile);
	if ($opt_r ) {
	    if ($opt_b) {
		rename($snapfile, $snapfile . "~") || die "Could not rename '$snapfile' to backup";
	    }

	    replace_device_number($info, @repl);
	    write_incr_db($info, $snapfile);
	} elsif ($opt_c) {
	    check_field_values($info);
	} else {
	    show_device_counts($info);
	}
    }
}

sub HELP_MESSAGE {
    print <<EOF;

Usage:
  tar-snapshot-edit SNAPFILE [SNAPFILE [...]]
  tar-snapshot-edit -r 'DEV1-DEV2[,DEV3-DEV4...]' [-b] SNAPFILE [SNAPFILE [...]]
  tar-snapshot-edit -c SNAPFILE [SNAPFILE [...]]

     With no options specified: print a summary of the 'device' values
     found in each SNAPFILE.

     With -r: replace occurrences of DEV1 with DEV2 in each SNAPFILE.
     DEV1 and DEV2 may be specified in hex (e.g., 0xfe01), decimal (e.g.,
     65025), or MAJ:MIN (e.g., 254:1).  To replace multiple occurrences,
     separate them with commas.  If -b is also specified, backup files
     (ending with '~') will be created.

     With -c: Check the field values in each SNAPFILE and print warning
     messages if any invalid values are found.  (An invalid value is one
     that would cause \"tar\" to generate an
	 Unexpected field value in snapshot file
     error message as it processed the snapshot file.)

EOF
    exit 1;
}

sub interpret_dev ($) {
    my $dev = shift;

    if ($dev =~ /^([0-9]+):([0-9]+)$/) {
	return $1 * 256 + $2;
    } elsif ($dev =~ /^0x[0-9a-fA-F]+$/) {
	return oct $dev;
    } elsif ($dev =~ /^[0-9]+$/) {
	return $dev+0;
    } else {
	die "Invalid device specification '$dev'";
    }
}

main