git.gag.com Git - debian/tar/blob - scripts/tar-snapshot-edit

   1 #! /usr/bin/perl -w
   2 # Display and edit the 'dev' field in tar's snapshots
   3 # Copyright 2007, 2011, 2013 Free Software Foundation, Inc.
   4
   5 # This file is part of GNU tar.
   6
   7 # GNU tar is free software; you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11
  12 # GNU tar is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 # GNU General Public License for more details.
  16
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19
  20
  21 # tar-snapshot-edit
  22 #
  23 # This script is capable of replacing values in the 'dev' field of an
  24 # incremental backup 'snapshot' file.  This is useful when the device
  25 # used to store files in a tar archive changes, without the files
  26 # themselves changing.  This may happen when, for example, a device
  27 # driver changes major or minor numbers.
  28 #
  29 # It can also run a check on all the field values found in the
  30 # snapshot file, printing out a detailed message when it finds values
  31 # that would cause an "Unexpected field value in snapshot file" error
  32 # if tar were run using that snapshot file as input.  (See the
  33 # comments included in the definition of the check_field_values
  34 # routine for more detailed information regarding these checks.)
  35 #
  36 #
  37 #
  38 # Author: Dustin J. Mitchell <dustin@zmanda.com>
  39 #
  40 # Modified Aug 25, 2011 by Nathan Stratton Treadway <nathanst AT ontko.com>:
  41 #   * update Perl syntax to work correctly with more recent versions of
  42 #     Perl.  (The original code worked with in the v5.8 timeframe but
  43 #     not with Perl v5.10.1 and later.)
  44 #   * added a "-c" option to check the snapshot file for invalid field values.
  45 #   * handle NFS indicator character ("+") in version 0 and 1 files
  46 #   * preserve the original header/version line when editing version 1
  47 #     or 2 files.
  48 #   * tweak output formatting
  49 #
  50 #
  51
  52 use Getopt::Std;
  53
  54 ## reading
  55
  56 sub read_incr_db ($) {
  57     my $filename = shift;
  58     open(my $file, "<$filename") || die "Could not open '$filename' for reading";
  59
  60     my $header_str = <$file>;
  61     my $file_version;
  62     if ($header_str =~ /^GNU tar-[^-]*-([0-9]+)\n$/) {
  63         $file_version = $1+0;
  64     } else {
  65         $file_version = 0;
  66     }
  67
  68     print "\nFile: $filename\n";
  69     print "  Detected snapshot file version: $file_version\n\n";
  70
  71     if ($file_version == 0) {
  72         return read_incr_db_0($file, $header_str);
  73     } elsif ($file_version == 1) {
  74         return read_incr_db_1($file, $header_str);
  75     } elsif ($file_version == 2) {
  76         return read_incr_db_2($file, $header_str);
  77     } else {
  78         die "Unrecognized snapshot version in header '$header_str'";
  79     }
  80 }
  81
  82 sub read_incr_db_0 ($$) {
  83     my $file = shift;
  84     my $header_str = shift;
  85
  86     my $hdr_timestamp_sec = $header_str;
  87     chop $hdr_timestamp_sec;
  88     my $hdr_timestamp_nsec = ''; # not present in file format 0
  89
  90     my $nfs;
  91     my @dirs;
  92
  93     while (<$file>) {
  94         /^(\+?)([0-9]*) ([0-9]*) (.*)\n$/ || die("Bad snapshot line $_");
  95
  96         if ( $1 eq "+" ) {
  97           $nfs="1";
  98         } else {
  99           $nfs="0";
 100         }
 101         push @dirs, { nfs=>$nfs,
 102                       dev=>$2,
 103                       ino=>$3,
 104                       name=>$4 };
 105     }
 106
 107     close($file);
 108
 109     # file version, timestamp, timestamp, dir list, file header line
 110     return [ 0, $hdr_timestamp_sec, $hdr_timestamp_nsec, \@dirs, ""];
 111 }
 112
 113 sub read_incr_db_1 ($$) {
 114     my $file = shift;
 115     my $header_str = shift;
 116
 117
 118     my $timestamp = <$file>; # "sec nsec"
 119     my ($hdr_timestamp_sec, $hdr_timestamp_nsec) = ($timestamp =~ /([0-9]*) ([0-9]*)/);
 120
 121     my $nfs;
 122     my @dirs;
 123
 124     while (<$file>) {
 125         /^(\+?)([0-9]*) ([0-9]*) ([0-9]*) ([0-9]*) (.*)\n$/ || die("Bad snapshot line $_");
 126
 127         if ( $1 eq "+" ) {
 128           $nfs="1";
 129         } else {
 130           $nfs="0";
 131         }
 132
 133         push @dirs, { nfs=>$nfs,
 134                       timestamp_sec=>$2,
 135                       timestamp_nsec=>$3,
 136                       dev=>$4,
 137                       ino=>$5,
 138                       name=>$6 };
 139     }
 140
 141     close($file);
 142
 143     # file version, timestamp, timestamp, dir list, file header line
 144     return [ 1, $hdr_timestamp_sec, $hdr_timestamp_nsec, \@dirs, $header_str ];
 145 }
 146
 147 sub read_incr_db_2 ($$) {
 148     my $file = shift;
 149     my $header_str = shift;
 150
 151     $/="\0"; # $INPUT_RECORD_SEPARATOR
 152     my $hdr_timestamp_sec = <$file>;
 153     chop $hdr_timestamp_sec;
 154     my $hdr_timestamp_nsec = <$file>;
 155     chop $hdr_timestamp_nsec;
 156     my @dirs;
 157
 158     while (1) {
 159         last if eof($file);
 160
 161         my $nfs = <$file>;
 162         my $timestamp_sec = <$file>;
 163         my $timestamp_nsec = <$file>;
 164         my $dev = <$file>;
 165         my $ino = <$file>;
 166         my $name = <$file>;
 167
 168         # get rid of trailing NULs
 169         chop $nfs;
 170         chop $timestamp_sec;
 171         chop $timestamp_nsec;
 172         chop $dev;
 173         chop $ino;
 174         chop $name;
 175
 176         my @dirents;
 177         while (my $dirent = <$file>) {
 178             chop $dirent;
 179             push @dirents, $dirent;
 180             last if ($dirent eq "");
 181         }
 182         die "missing terminator" unless (<$file> eq "\0");
 183
 184         push @dirs, { nfs=>$nfs,
 185                       timestamp_sec=>$timestamp_sec,
 186                       timestamp_nsec=>$timestamp_nsec,
 187                       dev=>$dev,
 188                       ino=>$ino,
 189                       name=>$name,
 190                       dirents=>\@dirents };
 191     }
 192
 193     close($file);
 194     $/ = "\n"; # reset to normal
 195
 196     # file version, timestamp, timestamp, dir list, file header line
 197     return [ 2, $hdr_timestamp_sec, $hdr_timestamp_nsec, \@dirs,  $header_str];
 198 }
 199
 200 ## display
 201
 202 sub show_device_counts ($) {
 203     my $info = shift;
 204     my %devices;
 205     foreach my $dir (@{$info->[3]}) {
 206         my $dev = $dir->{'dev'};
 207         $devices{$dev}++;
 208     }
 209
 210     foreach $dev (sort {$a <=> $b} keys %devices) {
 211         printf "  Device 0x%04x occurs $devices{$dev} times.\n", $dev;
 212     }
 213 }
 214
 215 ## check field values
 216
 217 # returns a warning message if $field isn't a valid string representation
 218 # of an integer, or if the resulting integer is out of the specified range
 219 sub validate_integer_field ($$$$) {
 220     my $field = shift;
 221     my $field_name = shift;
 222     my $min = shift;
 223     my $max = shift;
 224
 225     my $msg = "";
 226
 227     if ( not $field =~ /^-?\d+$/ ) {
 228         $msg = "      $field_name value contains invalid characters: \"$field\"\n";
 229     } else {
 230         if ( $field < $min ) {
 231             $msg = "      $field_name value too low: \"$field\" < $min \n";
 232         } elsif ( $field > $max ) {
 233             $msg = "      $field_name value too high: \"$field\" > $max \n";
 234         }
 235     }
 236     return $msg;
 237 }
 238
 239
 240 # This routine loops through each directory entry in the $info data
 241 # structure and prints a warning message if tar would abort with an
 242 # "Unexpected field value in snapshot file" error upon reading this
 243 # snapshot file.
 244 #
 245 # (Note that this specific error message was introduced along with the
 246 # change to snapshot file format "2", starting with tar v1.16 [or,
 247 # more precisely, v1.15.91].)
 248 #
 249 # The checks here are intended to match those found in the incremen.c
 250 # source file (as of tar v1.16.1).
 251 #
 252 # In that code, the checks are done against pre-processor expressions,
 253 # as defined in the C header files at compile time.   In the routine
 254 # below, a Perl variable is created for each expression used as part of
 255 # one of these checks, assigned the value of the related pre-processor
 256 # expression as found on a Linux 2.6.8/i386 system.
 257 #
 258 # It seems likely that these settings will catch most invalid
 259 # field values found in actual snapshot files on all systems.  However,
 260 # if "tar" is erroring out on a snapshot file that this check routine
 261 # does not complain about, that probably indicates that the values
 262 # below need to be adjusted to match those used by "tar" in that
 263 # particular environment.
 264 #
 265 # (Note: the checks here are taken from the code that processes
 266 # version 2 snapshot files, but to keep things simple we apply those
 267 # same checks to files having earlier versions -- but only for
 268 # the fields that actually exist in those input files.)
 269
 270 sub check_field_values ($) {
 271     my $info = shift;
 272
 273     # set up a variable with the value of each pre-processor
 274     # expression used for field-value checks in incremen.c
 275     # (these values here are from a Linux 2.6.8/i386 system)
 276     my $BILLION = 1000000000;        # BILLION
 277     my $MIN_TIME_T = -2147483648;    # TYPE_MINIMUM(time_t)
 278     my $MAX_TIME_T = 2147483647;     # TYPE_MAXIUMUM(time_t)
 279     my $MAX_DEV_T = 4294967295;      # TYPE_MAXIUMUM(dev_t)
 280     my $MAX_INO_T = 4294967295;      # TYPE_MAXIUMUM(ino_t)
 281
 282
 283     my $msg;
 284     my $error_found = 0;
 285
 286     print "  Checking field values in snapshot file...\n";
 287
 288     $snapver = $info->[0];
 289
 290     $msg = "";
 291     $msg .= validate_integer_field($info->[1],
 292                            'timestamp_sec', $MIN_TIME_T, $MAX_TIME_T);
 293     if ($snapver >= 1) {
 294       $msg .= validate_integer_field($info->[2],
 295                            'timestamp_nsec', 0, $BILLION-1);
 296     }
 297     if ( $msg ne "" ) {
 298         $error_found = 1;
 299         print "\n    shapshot file header:\n";
 300         print $msg;
 301     }
 302
 303
 304     foreach my $dir (@{$info->[3]}) {
 305
 306         $msg = "";
 307
 308         $msg .= validate_integer_field($dir->{'nfs'}, 'nfs', 0, 1);
 309         if ($snapver >= 1) {
 310           $msg .= validate_integer_field($dir->{'timestamp_sec'},
 311                                 'timestamp_sec', $MIN_TIME_T, $MAX_TIME_T);
 312           $msg .= validate_integer_field($dir->{'timestamp_nsec'},
 313                                 'timestamp_nsec', 0, $BILLION-1);
 314         }
 315         $msg .= validate_integer_field($dir->{'dev'}, 'dev', 0, $MAX_DEV_T);
 316         $msg .= validate_integer_field($dir->{'ino'}, 'ino', 0, $MAX_INO_T);
 317
 318         if ( $msg ne "" ) {
 319           $error_found = 1;
 320           print "\n    directory: $dir->{'name'}\n";
 321           print $msg;
 322         }
 323     }
 324
 325     print "\n  Snapshot field value check complete" ,
 326            $error_found ?  "" : ", no errors found" ,
 327            ".\n";
 328 }
 329
 330 ## editing
 331
 332 sub replace_device_number ($@) {
 333     my $info = shift(@_);
 334     my @repl = @_;
 335
 336     my $count = 0;
 337
 338     foreach my $dir (@{$info->[3]}) {
 339         foreach $x (@repl) {
 340             if ($dir->{'dev'} eq $$x[0]) {
 341                 $dir->{'dev'} = $$x[1];
 342                 $count++;
 343                 last;
 344             }
 345         }
 346     }
 347     print "  Updated $count records.\n"
 348 }
 349
 350 ## writing
 351
 352 sub write_incr_db ($$) {
 353     my $info = shift;
 354     my $filename = shift;
 355     my $file_version = $$info[0];
 356
 357     open($file, ">$filename") || die "Could not open '$filename' for writing";
 358
 359     if ($file_version == 0) {
 360         write_incr_db_0($info, $file);
 361     } elsif ($file_version == 1) {
 362         write_incr_db_1($info, $file);
 363     } elsif ($file_version == 2) {
 364         write_incr_db_2($info, $file);
 365     } else {
 366         die "Unknown file version $file_version.";
 367     }
 368
 369     close($file);
 370 }
 371
 372 sub write_incr_db_0 ($$) {
 373     my $info = shift;
 374     my $file = shift;
 375
 376     my $timestamp_sec = $info->[1];
 377     print $file "$timestamp_sec\n";
 378
 379     foreach my $dir (@{$info->[3]}) {
 380         if ($dir->{'nfs'}) {
 381           print $file '+'
 382         }
 383         print $file "$dir->{'dev'} ";
 384         print $file "$dir->{'ino'} ";
 385         print $file "$dir->{'name'}\n";
 386     }
 387 }
 388
 389
 390 sub write_incr_db_1 ($$) {
 391     my $info = shift;
 392     my $file = shift;
 393
 394     print $file $info->[4];
 395
 396     my $timestamp_sec = $info->[1];
 397     my $timestamp_nsec = $info->[2];
 398     print $file "$timestamp_sec $timestamp_nsec\n";
 399
 400     foreach my $dir (@{$info->[3]}) {
 401         if ($dir->{'nfs'}) {
 402           print $file '+'
 403         }
 404         print $file "$dir->{'timestamp_sec'} ";
 405         print $file "$dir->{'timestamp_nsec'} ";
 406         print $file "$dir->{'dev'} ";
 407         print $file "$dir->{'ino'} ";
 408         print $file "$dir->{'name'}\n";
 409     }
 410 }
 411
 412
 413 sub write_incr_db_2 ($$) {
 414     my $info = shift;
 415     my $file = shift;
 416
 417     print $file $info->[4];
 418
 419     my $timestamp_sec = $info->[1];
 420     my $timestamp_nsec = $info->[2];
 421     print $file $timestamp_sec . "\0";
 422     print $file $timestamp_nsec . "\0";
 423
 424     foreach my $dir (@{$info->[3]}) {
 425         print $file $dir->{'nfs'} . "\0";
 426         print $file $dir->{'timestamp_sec'} . "\0";
 427         print $file $dir->{'timestamp_nsec'} . "\0";
 428         print $file $dir->{'dev'} . "\0";
 429         print $file $dir->{'ino'} . "\0";
 430         print $file $dir->{'name'} . "\0";
 431         foreach my $dirent (@{$dir->{'dirents'}}) {
 432             print $file $dirent . "\0";
 433         }
 434         print $file "\0";
 435     }
 436 }
 437
 438 ## main
 439
 440 sub main {
 441     our ($opt_b, $opt_r, $opt_h, $opt_c);
 442     getopts('br:hc');
 443     HELP_MESSAGE() if ($opt_h || $#ARGV == -1 || ($opt_b && !$opt_r) ||
 444                        ($opt_r && $opt_c) );
 445
 446     my @repl;
 447     if ($opt_r) {
 448         foreach my $spec (split(/,/, $opt_r)) {
 449             ($spec =~ /^([^-]+)-([^-]+)/) || die "Invalid replacement specification '$opt_r'";
 450             push @repl, [interpret_dev($1), interpret_dev($2)];
 451         }
 452     }
 453
 454     foreach my $snapfile (@ARGV) {
 455         my $info = read_incr_db($snapfile);
 456         if ($opt_r ) {
 457             if ($opt_b) {
 458                 rename($snapfile, $snapfile . "~") || die "Could not rename '$snapfile' to backup";
 459             }
 460
 461             replace_device_number($info, @repl);
 462             write_incr_db($info, $snapfile);
 463         } elsif ($opt_c) {
 464             check_field_values($info);
 465         } else {
 466             show_device_counts($info);
 467         }
 468     }
 469 }
 470
 471 sub HELP_MESSAGE {
 472     print <<EOF;
 473
 474 Usage:
 475   tar-snapshot-edit SNAPFILE [SNAPFILE [...]]
 476   tar-snapshot-edit -r 'DEV1-DEV2[,DEV3-DEV4...]' [-b] SNAPFILE [SNAPFILE [...]]
 477   tar-snapshot-edit -c SNAPFILE [SNAPFILE [...]]
 478
 479      With no options specified: print a summary of the 'device' values
 480      found in each SNAPFILE.
 481
 482      With -r: replace occurrences of DEV1 with DEV2 in each SNAPFILE.
 483      DEV1 and DEV2 may be specified in hex (e.g., 0xfe01), decimal (e.g.,
 484      65025), or MAJ:MIN (e.g., 254:1).  To replace multiple occurrences,
 485      separate them with commas.  If -b is also specified, backup files
 486      (ending with '~') will be created.
 487
 488      With -c: Check the field values in each SNAPFILE and print warning
 489      messages if any invalid values are found.  (An invalid value is one
 490      that would cause \"tar\" to generate an
 491          Unexpected field value in snapshot file
 492      error message as it processed the snapshot file.)
 493
 494 EOF
 495     exit 1;
 496 }
 497
 498 sub interpret_dev ($) {
 499     my $dev = shift;
 500
 501     if ($dev =~ /^([0-9]+):([0-9]+)$/) {
 502         return $1 * 256 + $2;
 503     } elsif ($dev =~ /^0x[0-9a-fA-F]+$/) {
 504         return oct $dev;
 505     } elsif ($dev =~ /^[0-9]+$/) {
 506         return $dev+0;
 507     } else {
 508         die "Invalid device specification '$dev'";
 509     }
 510 }
 511
 512 main