git.gag.com Git - debian/amanda/blob - installcheck/gnutar.pl

   1 # Copyright (c) 2009, 2010 Zmanda, Inc.  All Rights Reserved.
   2 #
   3 # This program is free software; you can redistribute it and/or modify it
   4 # under the terms of the GNU General Public License version 2 as published
   5 # by the Free Software Foundation.
   6 #
   7 # This program is distributed in the hope that it will be useful, but
   8 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
   9 # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  10 # for more details.
  11 #
  12 # You should have received a copy of the GNU General Public License along
  13 # with this program; if not, write to the Free Software Foundation, Inc.,
  14 # 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
  15 #
  16 # Contact information: Zmanda Inc, 465 S. Mathilda Ave., Suite 300
  17 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
  18
  19 use Test::More tests => 201;
  20 use File::Path;
  21 use Data::Dumper;
  22 use POSIX qw( WIFEXITED );
  23 use warnings;
  24 use strict;
  25
  26 use lib "@amperldir@";
  27 use Installcheck;
  28 use IPC::Open3;
  29 use Amanda::Constants;
  30 use Amanda::Util qw( slurp );
  31
  32 ## this is an unusual installcheck, because it does not test anything about
  33 ## Amanda itself.  However, it validates the accuracy of our understanding of
  34 ## GNU Tar's behavior, as recorded at
  35 ##  http://wiki.zmanda.com/index.php/GNU_Tar_Include_and_Exclude_Behavior
  36
  37 my $gnutar = $Amanda::Constants::GNUTAR;
  38 $gnutar = $ENV{'GNUTAR'} if exists $ENV{'GNUTAR'};
  39
  40 ## get set up
  41
  42 my @filenames = (qw{A*A AxA B?B BxB C[C CC D]D E\E F'F G"G}, 'H H');
  43
  44 my $tarfile = "$Installcheck::TMP/gnutar-tests.tar";
  45 my $datadir = "$Installcheck::TMP/gnutar-tests";
  46
  47 sub make_tarfile
  48 {
  49     my @extra_args = @_;
  50
  51     rmtree($datadir) if -e $datadir;
  52     mkpath($datadir);
  53
  54     for my $fn (@filenames) {
  55         open(my $fh, ">", "$datadir/$fn");
  56         print $fh "data";
  57         close($fh);
  58     }
  59
  60     system($gnutar, "-C", $datadir, "-cf", $tarfile, @extra_args, '.');
  61     die "could not run gnutar" unless $? == 0;
  62
  63     rmtree($datadir) if -e $datadir;
  64 }
  65
  66 ## gnutar version
  67
  68 my ($v, $numeric_version);
  69 {
  70     my $verstring = `$gnutar --version`;
  71     die "could not run gnutar" unless $? == 0;
  72     ($v) = ($verstring =~ /tar \(GNU tar\) *([0-9.]+)/);
  73     my ($maj, $min, $mic) = ($v =~ /([0-9]+)\.([0-9]+)(?:\.([0-9]+))?/);
  74
  75     $numeric_version = 0;
  76     $numeric_version += $maj * 10000 if $maj;
  77     $numeric_version += $min * 100 if $min;
  78     $numeric_version += $mic if $mic;
  79 }
  80
  81 # see if the default for --wildcards during inclusion has been changed
  82 my $wc_default_changed = 0;
  83 {
  84     my $help_output = `$gnutar --help`;
  85     # redhatty patches helpfully change the help message
  86     if ($help_output =~ /--wildcards\s*use wildcards \(default\)$/m) {
  87         $wc_default_changed = 1;
  88     }
  89 }
  90
  91 my %version_classes = (
  92     '<1.16' => $numeric_version < 11591,
  93     '>=1.16' => $numeric_version >= 11591,
  94     '>=1.16-no-wc' => $numeric_version >= 11591 && !$wc_default_changed, # normal
  95     '>=1.16-wc' => $numeric_version >= 11591 && $wc_default_changed, # stupid distros screw things up!
  96
  97     '<1.23' => $numeric_version < 12300,
  98     '>=1.23' => $numeric_version >= 12300,
  99     '*' => 1,
 100     '1.23' => ($numeric_version >= 12290 and $numeric_version <= 12300),
 101     '!1.23' => ($numeric_version < 12290 || $numeric_version > 12300),
 102 );
 103
 104 # include and exclude all use the same set of patterns and filenames
 105 my $patterns = [
 106         './A*A' =>      'A*A',
 107         './A*A' =>      'AxA',
 108         './B?B' =>      'B?B',
 109         './B?B' =>      'BxB',
 110         './C[C' =>      'C[C',
 111         './D]D' =>      'D]D',
 112         './E\\E' =>     'E\\E',
 113         './F\'F' =>     'F\'F',
 114         './G"G' =>      'G"G',
 115         './H H' =>      'H H',
 116         './A\\*A' =>    'A*A',
 117         './A\\*A' =>    'AxA',
 118         './B\\?B' =>    'B?B',
 119         './B\\?B' =>    'BxB',
 120         './C\\[C' =>    'C[C',
 121         './D\\]D' =>    'D]D',
 122         './E\\\\E' =>   'E\\E',
 123         './F\\\'F' =>   'F\'F',
 124         './G\\"G' =>    'G"G',
 125         './H\\ H' =>    'H H',
 126 ];
 127
 128 my $named_expectations = [
 129     [ 'alpha',
 130          'beta',
 131             'gamma',
 132                'delta',
 133                   'epsilon',
 134                      'empty', ],
 135     #  al be ga de ep empty
 136     [  1, 1, 1, 1, 1, 1,     ], # './A*A' =>    'A*A',
 137     [  1, 1, 1, 1, 0, 0,     ], # './A*A' =>    'AxA',
 138     [  1, 1, 1, 1, 1, 1,     ], # './B?B' =>    'B?B',
 139     [  1, 1, 1, 1, 0, 0,     ], # './B?B' =>    'BxB',
 140     [  0, 0, 0, 0, 1, 1,     ], # './C[C' =>    'C[C',
 141     [  1, 1, 1, 1, 1, 1,     ], # './D]D' =>    'D]D',
 142     [  1, 0, 0, 1, 1, 1,     ], # './E\\E' =>   'E\\E',
 143     [  1, 1, 1, 1, 1, 1,     ], # './F\'F' =>   'F\'F',
 144     [  1, 1, 1, 1, 1, 1,     ], # './G"G' =>    'G"G',
 145     [  1, 1, 1, 1, 1, 1,     ], # './H H' =>    'H H',
 146     [  1, 1, 1, 0, 0, 0,     ], # './A\\*A' =>  'A*A',
 147     [  0, 0, 0, 0, 0, 0,     ], # './A\\*A' =>  'AxA',
 148     [  0, 0, 1, 0, 0, 0,     ], # './B\\?B' =>  'B?B',
 149     [  0, 0, 0, 0, 0, 0,     ], # './B\\?B' =>  'BxB',
 150     [  1, 1, 1, 0, 0, 0,     ], # './C\\[C' =>  'C[C',
 151     [  0, 1, 1, 0, 0, 0,     ], # './D\\]D' =>  'D]D',
 152     [  1, 0, 1, 0, 1, 0,     ], # './E\\\\E' => 'E\\E',
 153     [  0, 1, 1, 0, 0, 0,     ], # './F\\\'F' => 'F\'F',
 154     [  0, 1, 1, 0, 0, 0,     ], # './G\\"G' =>  'G"G',
 155     [  0, 1, 1, 0, 0, 0,     ], # './H\\ H' =>  'H H',
 156 ];
 157
 158 sub get_expectation {
 159     my ($name) = @_;
 160     my @names = @{$named_expectations->[0]};
 161
 162     # get the index for that greek letter
 163     my $i;
 164     for (0 .. $#names) {
 165         if ($names[$_] eq $name) {
 166             $i = $_;
 167             last;
 168         }
 169     }
 170
 171     # then assemble the result
 172     my @rv;
 173     my @exps = @$named_expectations;
 174     shift @exps;
 175     for (@exps) {
 176         push @rv, $_->[$i];
 177     }
 178
 179     return @rv;
 180 }
 181
 182 sub get_matching_type {
 183     my ($expectations) = @_;
 184
 185     # find the type for the first matching version
 186     for (keys %$expectations) {
 187         if ($version_classes{$_}) {
 188             return $expectations->{$_};
 189         }
 190     }
 191     return undef;
 192 }
 193
 194 sub get_version_index {
 195     my @versions = @{$_[0]};
 196
 197     my $vi;
 198     for (0 .. $#versions) {
 199         if ($version_classes{$versions[$_]}) {
 200             return $_;
 201         }
 202     }
 203     return undef;
 204 }
 205
 206 ## utils
 207
 208 my ($stderr, $stdout, $exit_code);
 209 sub run_gnutar {
 210     my %params = @_;
 211     my @args = @{ $params{'args'} };
 212
 213     my $errtempfile = "$Installcheck::TMP/stderr$$.out";
 214
 215     # use a temporary file for error output -- this eliminates synchronization
 216     # problems between reading stderr and stdout
 217     local (*INFH, *OUTFH, *ERRFH);
 218     open(ERRFH, ">", $errtempfile);
 219
 220     local %ENV;
 221     if ($params{'env'}) {
 222         my %env = %{$params{'env'}};
 223         for (keys %env) {
 224             $ENV{$_} = $env{$_};
 225         }
 226     }
 227
 228     my $pid = IPC::Open3::open3("INFH", "OUTFH", ">&ERRFH", $gnutar, @args);
 229     my $cmdline = "$gnutar " . join(' ', @args);
 230
 231     # immediately close the child's stdin
 232     close(INFH);
 233
 234     # read from stdout until it's closed
 235     $stdout = do { local $/; <OUTFH> };
 236     close(OUTFH);
 237
 238     # and wait for the kid to die
 239     waitpid $pid, 0 or croak("Error waiting for gnutar die: $@");
 240     my $status = $?;
 241     close(ERRFH);
 242
 243     # fetch stderr from the temporary file
 244     $stderr = slurp($errtempfile);
 245     unlink($errtempfile);
 246
 247     # get the exit status
 248     $exit_code = WIFEXITED($status)? ($status >> 8) : 0xffff;
 249
 250     if ($exit_code != 0) {
 251         return 0;
 252     } else {
 253         return 1;
 254     }
 255 }
 256
 257 ## inclusion tests (using -x and filenames on the command line)
 258
 259 sub test_gnutar_inclusion {
 260     my %params = @_;
 261
 262     my $matching_type = get_matching_type($params{'expectations'});
 263
 264     # skip these tests if there's no matching version
 265     if (!defined $matching_type) {
 266         SKIP: {
 267             my $msg = (join " ", @{$params{'extra_args'}}) .
 268                         " not supported in version $v";
 269             my $count = @$patterns / 2;
 270             skip $msg, $count;
 271         }
 272         return;
 273     }
 274
 275     make_tarfile();
 276     my @patterns = @$patterns;
 277     my @expectations = get_expectation($matching_type);
 278     while (@patterns) {
 279         my $pat = shift @patterns;
 280         my $file = shift @patterns;
 281         my $exp = shift @expectations;
 282
 283         my $eargs = '';
 284         $eargs = ', ' . join(' ', @{$params{'extra_args'}}) if @{$params{'extra_args'}};
 285         my $match = $exp? "matches" : "does not match";
 286         my $msg = "inclusion$eargs, pattern $pat $match file $file";
 287
 288         rmtree($datadir) if -e $datadir;
 289         mkpath($datadir);
 290
 291         my $ok = run_gnutar(args => [ '-C', $datadir, '-x', '-f', $tarfile, @{$params{'extra_args'}}, $pat ]);
 292         $ok = 0 unless -f "$datadir/$file";
 293         if ($ok and !$exp) {
 294             fail($msg);
 295             diag("  unexpected success with version $v");
 296         } elsif (!$ok and $exp) {
 297             fail($msg);
 298             diag("  unexpected failure with version $v:\n$stderr");
 299         } else {
 300             pass($msg);
 301         }
 302     }
 303     rmtree($datadir) if -e $datadir;
 304 }
 305
 306 # We'll trust that the following logic is implemented correctly in GNU Tar
 307 # --no-wildcards is the default (same as no args) (but not everywhere!!)
 308 # --unquote is the default (same as no args) (this seems true universally)
 309
 310 test_gnutar_inclusion(
 311     extra_args => [],
 312     expectations => {
 313         '<1.16' => 'alpha',
 314         '>=1.16-no-wc' => 'epsilon',
 315         '>=1.16-wc' => 'beta', # acts like --wildcards
 316     },
 317 );
 318
 319 test_gnutar_inclusion(
 320     extra_args => [ '--no-wildcards' ],
 321     expectations => {
 322         '<1.16' => 'alpha',
 323         '>=1.16' => 'epsilon',
 324     },
 325 );
 326
 327 test_gnutar_inclusion(
 328     extra_args => [ '--no-unquote' ],
 329     expectations => {
 330         '<1.16' => undef,
 331         '>=1.16-no-wc' => 'empty',
 332         '>=1.16-wc' => 'gamma', # acts like --wildcards --no-unquote
 333     },
 334 );
 335
 336 test_gnutar_inclusion(
 337     extra_args => [ '--no-wildcards', '--no-unquote' ],
 338     expectations => {
 339         '<1.16' => undef,
 340         '>=1.16' => 'empty',
 341     },
 342 );
 343
 344 test_gnutar_inclusion(
 345     extra_args => [ '--wildcards' ],
 346     expectations => {
 347         '<1.16' => 'alpha',
 348         '>=1.16' => 'beta',
 349     },
 350 );
 351
 352 test_gnutar_inclusion(
 353     extra_args => [ '--wildcards', '--no-unquote' ],
 354     expectations => {
 355         '<1.16' => undef,
 356         '>=1.16' => 'gamma',
 357     },
 358 );
 359
 360 ## exclusion tests (using -t and filenames on the command line)
 361
 362 sub test_gnutar_exclusion {
 363     my %params = @_;
 364
 365     my $matching_type = get_matching_type($params{'expectations'});
 366
 367     # skip these tests if there's no matching version
 368     if (!defined $matching_type) {
 369         SKIP: {
 370             my $msg = (join " ", @{$params{'extra_args'}}) .
 371                         " not supported in version $v";
 372             my $count = @$patterns; # two elements per test, but we run each one twice
 373             skip $msg, $count;
 374         }
 375         return;
 376     }
 377
 378     make_tarfile();
 379     my @patterns = @$patterns;
 380     my @expectations = get_expectation($matching_type);
 381     while (@patterns) {
 382         my $pat = shift @patterns;
 383         my $file = shift @patterns;
 384         my $exp = shift @expectations;
 385
 386         my $eargs = '';
 387         $eargs = ', ' . join(' ', @{$params{'extra_args'}}) if @{$params{'extra_args'}};
 388         my $match = $exp? "matches" : "does not match";
 389         my $msg = "exclusion$eargs, extract, pattern $pat $match $file";
 390
 391         rmtree($datadir) if -e $datadir;
 392         mkpath($datadir);
 393
 394         my $ok = run_gnutar(args => [ '-C', $datadir, '-x', '-f', $tarfile, @{$params{'extra_args'}}, "--exclude=$pat" ]);
 395
 396         # fail if the excluded file was extracted anyway..
 397         if ($ok) {
 398             my $excluded_ok = ! -f "$datadir/$file";
 399             if ($excluded_ok and !$exp) {
 400                 fail($msg);
 401                 diag("  exclusion unexpectedly worked with version $v");
 402             } elsif (!$excluded_ok and $exp) {
 403                 fail($msg);
 404                 diag("  exclusion unexpectedly failed with version $v");
 405             } else {
 406                 pass($msg);
 407             }
 408         } else {
 409             fail($msg);
 410             diag("  unexpected error exit with version $v:\n$stderr");
 411         }
 412     }
 413
 414     # test again, but this time during a 'c'reate operation
 415     @patterns = @$patterns;
 416     @expectations = get_expectation($matching_type);
 417     while (@patterns) {
 418         my $pat = shift @patterns;
 419         my $file = shift @patterns;
 420         my $exp = shift @expectations;
 421
 422         my $eargs = '';
 423         $eargs = ', ' . join(' ', @{$params{'extra_args'}}) if @{$params{'extra_args'}};
 424         my $match = $exp? "matches" : "does not match";
 425         my $msg = "exclusion$eargs, create, pattern $pat $match $file";
 426
 427         # this time around, we create the tarball with the exclude, then extract the whole
 428         # thing.  We extract rather than using 't' because 't' has a funny habit of backslashing
 429         # its output that we don't want to deal with here.
 430         make_tarfile(@{$params{'extra_args'}}, "--exclude=$pat");
 431
 432         rmtree($datadir) if -e $datadir;
 433         mkpath($datadir);
 434         my $ok = run_gnutar(args => [ '-C', $datadir, '-x', '-f', $tarfile]);
 435
 436         # fail if the excluded file was extracted anyway..
 437         if ($ok) {
 438             my $excluded_ok = ! -f "$datadir/$file";
 439             if ($excluded_ok and !$exp) {
 440                 fail($msg);
 441                 diag("  exclusion unexpectedly worked with version $v");
 442             } elsif (!$excluded_ok and $exp) {
 443                 fail($msg);
 444                 diag("  exclusion unexpectedly failed with version $v");
 445             } else {
 446                 pass($msg);
 447             }
 448         } else {
 449             fail($msg);
 450             diag("  unexpected error exit with version $v:\n$stderr");
 451         }
 452     }
 453
 454     rmtree($datadir) if -e $datadir;
 455 }
 456
 457 # We'll trust that the following logic is implemented correctly in GNU Tar
 458 # --wildcards is the default (same as no args)
 459 # --no-unquote / --unquote has no effect
 460
 461 # --wildcards
 462 test_gnutar_exclusion(
 463     extra_args => [],
 464     expectations => {
 465         '!1.23' => 'gamma',
 466         '1.23' => 'delta',
 467     },
 468 );
 469
 470 # --no-wildcards
 471 test_gnutar_exclusion(
 472     extra_args => [ '--no-wildcards' ],
 473     expectations => {
 474         '*' => 'empty',
 475     },
 476 );
 477
 478 ## list (-t)
 479
 480 sub test_gnutar_toc {
 481     my %params = @_;
 482
 483     my $vi = get_version_index($params{'versions'});
 484
 485     my @patterns = @{ $params{'patterns'} };
 486     my @filenames;
 487     my @expectations;
 488     while (@patterns) {
 489         my $file = shift @patterns;
 490         my $exp = shift @patterns;
 491         $exp = $exp->[$vi];
 492
 493         push @filenames, $file;
 494         push @expectations, $exp;
 495     }
 496
 497     my $eargs = '';
 498     $eargs = ', ' . join(' ', @{$params{'extra_args'}}) if @{$params{'extra_args'}};
 499     my $msg = "list$eargs, with lots of funny characters";
 500
 501     # make a tarfile containing the filenames, then run -t over it
 502     rmtree($datadir) if -e $datadir;
 503     mkpath($datadir);
 504
 505     for my $fn (@filenames) {
 506         open(my $fh, ">", "$datadir/$fn")
 507             or die("opening $datadir/$fn: $!");
 508         print $fh "data";
 509         close($fh);
 510     }
 511
 512     system($gnutar, "-C", $datadir, "-cf", $tarfile, '.');
 513     die "could not run gnutar" unless $? == 0;
 514
 515     rmtree($datadir) if -e $datadir;
 516     my %env;
 517     if ($params{'env'}) {
 518         %env = %{$params{'env'}};
 519     }
 520     my $ok = run_gnutar(args => [ '-t', '-f', $tarfile, @{$params{'extra_args'}}],
 521                         env => \%env);
 522     if (!$ok) {
 523         fail($msg);
 524         diag("gnutar exited with nonzero status for version $v");
 525     }
 526
 527     my @toc_members = sort split(/\n/, $stdout);
 528     shift @toc_members; # strip off './'
 529     is_deeply([ @toc_members ], [ @expectations ], $msg);
 530 }
 531
 532 # there are no extra_args that seem to affect this behavior
 533 test_gnutar_toc(
 534     extra_args => [],
 535     env => { LC_CTYPE => 'C' }, # avoid any funniness with ctypes
 536     versions =>  [ '*' ],
 537     patterns => [
 538         "A\007", [ './A\a' ],
 539         "B\010", [ './B\b' ],
 540         "C\011", [ './C\t' ],
 541         "D\012", [ './D\n' ],
 542         "E\013", [ './E\v' ],
 543         "F\014", [ './F\f' ],
 544         "G\015", [ './G\r' ],
 545         "H\\",   [ './H\\\\' ], # H\ -> H\\
 546         "I\177", [ './I\\177' ],
 547         "J\317\264", [ './J\\317\\264' ], # use legitimate utf-8, for mac os fs
 548         "K\\x",  [ './K\\\\x' ],
 549         "L\\\\", [ './L\\\\\\\\' ],
 550     ],
 551 );
 552
 553 unlink($tarfile);