1 # Copyright (c) 2009, 2010 Zmanda, Inc. All Rights Reserved.
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.
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
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
16 # Contact information: Zmanda Inc, 465 S. Mathilda Ave., Suite 300
17 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
19 use Test::More tests => 201;
22 use POSIX qw( WIFEXITED );
26 use lib "@amperldir@";
29 use Amanda::Constants;
30 use Amanda::Util qw( slurp );
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
37 my $gnutar = $Amanda::Constants::GNUTAR;
38 $gnutar = $ENV{'GNUTAR'} if exists $ENV{'GNUTAR'};
42 my @filenames = (qw{A*A AxA B?B BxB C[C CC D]D E\E F'F G"G}, 'H H');
44 my $tarfile = "$Installcheck::TMP/gnutar-tests.tar";
45 my $datadir = "$Installcheck::TMP/gnutar-tests";
51 rmtree($datadir) if -e $datadir;
54 for my $fn (@filenames) {
55 open(my $fh, ">", "$datadir/$fn");
60 system($gnutar, "-C", $datadir, "-cf", $tarfile, @extra_args, '.');
61 die "could not run gnutar" unless $? == 0;
63 rmtree($datadir) if -e $datadir;
68 my ($v, $numeric_version);
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]+))?/);
76 $numeric_version += $maj * 10000 if $maj;
77 $numeric_version += $min * 100 if $min;
78 $numeric_version += $mic if $mic;
81 # see if the default for --wildcards during inclusion has been changed
82 my $wc_default_changed = 0;
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;
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!
97 '<1.23' => $numeric_version < 12300,
98 '>=1.23' => $numeric_version >= 12300,
100 '1.23' => ($numeric_version >= 12290 and $numeric_version <= 12300),
101 '!1.23' => ($numeric_version < 12290 || $numeric_version > 12300),
104 # include and exclude all use the same set of patterns and filenames
122 './E\\\\E' => 'E\\E',
123 './F\\\'F' => 'F\'F',
128 my $named_expectations = [
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',
158 sub get_expectation {
160 my @names = @{$named_expectations->[0]};
162 # get the index for that greek letter
165 if ($names[$_] eq $name) {
171 # then assemble the result
173 my @exps = @$named_expectations;
182 sub get_matching_type {
183 my ($expectations) = @_;
185 # find the type for the first matching version
186 for (keys %$expectations) {
187 if ($version_classes{$_}) {
188 return $expectations->{$_};
194 sub get_version_index {
195 my @versions = @{$_[0]};
198 for (0 .. $#versions) {
199 if ($version_classes{$versions[$_]}) {
208 my ($stderr, $stdout, $exit_code);
211 my @args = @{ $params{'args'} };
213 my $errtempfile = "$Installcheck::TMP/stderr$$.out";
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);
221 if ($params{'env'}) {
222 my %env = %{$params{'env'}};
228 my $pid = IPC::Open3::open3("INFH", "OUTFH", ">&ERRFH", $gnutar, @args);
229 my $cmdline = "$gnutar " . join(' ', @args);
231 # immediately close the child's stdin
234 # read from stdout until it's closed
235 $stdout = do { local $/; <OUTFH> };
238 # and wait for the kid to die
239 waitpid $pid, 0 or croak("Error waiting for gnutar die: $@");
243 # fetch stderr from the temporary file
244 $stderr = slurp($errtempfile);
245 unlink($errtempfile);
247 # get the exit status
248 $exit_code = WIFEXITED($status)? ($status >> 8) : 0xffff;
250 if ($exit_code != 0) {
257 ## inclusion tests (using -x and filenames on the command line)
259 sub test_gnutar_inclusion {
262 my $matching_type = get_matching_type($params{'expectations'});
264 # skip these tests if there's no matching version
265 if (!defined $matching_type) {
267 my $msg = (join " ", @{$params{'extra_args'}}) .
268 " not supported in version $v";
269 my $count = @$patterns / 2;
276 my @patterns = @$patterns;
277 my @expectations = get_expectation($matching_type);
279 my $pat = shift @patterns;
280 my $file = shift @patterns;
281 my $exp = shift @expectations;
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";
288 rmtree($datadir) if -e $datadir;
291 my $ok = run_gnutar(args => [ '-C', $datadir, '-x', '-f', $tarfile, @{$params{'extra_args'}}, $pat ]);
292 $ok = 0 unless -f "$datadir/$file";
295 diag(" unexpected success with version $v");
296 } elsif (!$ok and $exp) {
298 diag(" unexpected failure with version $v:\n$stderr");
303 rmtree($datadir) if -e $datadir;
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)
310 test_gnutar_inclusion(
314 '>=1.16-no-wc' => 'epsilon',
315 '>=1.16-wc' => 'beta', # acts like --wildcards
319 test_gnutar_inclusion(
320 extra_args => [ '--no-wildcards' ],
323 '>=1.16' => 'epsilon',
327 test_gnutar_inclusion(
328 extra_args => [ '--no-unquote' ],
331 '>=1.16-no-wc' => 'empty',
332 '>=1.16-wc' => 'gamma', # acts like --wildcards --no-unquote
336 test_gnutar_inclusion(
337 extra_args => [ '--no-wildcards', '--no-unquote' ],
344 test_gnutar_inclusion(
345 extra_args => [ '--wildcards' ],
352 test_gnutar_inclusion(
353 extra_args => [ '--wildcards', '--no-unquote' ],
360 ## exclusion tests (using -t and filenames on the command line)
362 sub test_gnutar_exclusion {
365 my $matching_type = get_matching_type($params{'expectations'});
367 # skip these tests if there's no matching version
368 if (!defined $matching_type) {
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
379 my @patterns = @$patterns;
380 my @expectations = get_expectation($matching_type);
382 my $pat = shift @patterns;
383 my $file = shift @patterns;
384 my $exp = shift @expectations;
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";
391 rmtree($datadir) if -e $datadir;
394 my $ok = run_gnutar(args => [ '-C', $datadir, '-x', '-f', $tarfile, @{$params{'extra_args'}}, "--exclude=$pat" ]);
396 # fail if the excluded file was extracted anyway..
398 my $excluded_ok = ! -f "$datadir/$file";
399 if ($excluded_ok and !$exp) {
401 diag(" exclusion unexpectedly worked with version $v");
402 } elsif (!$excluded_ok and $exp) {
404 diag(" exclusion unexpectedly failed with version $v");
410 diag(" unexpected error exit with version $v:\n$stderr");
414 # test again, but this time during a 'c'reate operation
415 @patterns = @$patterns;
416 @expectations = get_expectation($matching_type);
418 my $pat = shift @patterns;
419 my $file = shift @patterns;
420 my $exp = shift @expectations;
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";
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");
432 rmtree($datadir) if -e $datadir;
434 my $ok = run_gnutar(args => [ '-C', $datadir, '-x', '-f', $tarfile]);
436 # fail if the excluded file was extracted anyway..
438 my $excluded_ok = ! -f "$datadir/$file";
439 if ($excluded_ok and !$exp) {
441 diag(" exclusion unexpectedly worked with version $v");
442 } elsif (!$excluded_ok and $exp) {
444 diag(" exclusion unexpectedly failed with version $v");
450 diag(" unexpected error exit with version $v:\n$stderr");
454 rmtree($datadir) if -e $datadir;
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
462 test_gnutar_exclusion(
471 test_gnutar_exclusion(
472 extra_args => [ '--no-wildcards' ],
480 sub test_gnutar_toc {
483 my $vi = get_version_index($params{'versions'});
485 my @patterns = @{ $params{'patterns'} };
489 my $file = shift @patterns;
490 my $exp = shift @patterns;
493 push @filenames, $file;
494 push @expectations, $exp;
498 $eargs = ', ' . join(' ', @{$params{'extra_args'}}) if @{$params{'extra_args'}};
499 my $msg = "list$eargs, with lots of funny characters";
501 # make a tarfile containing the filenames, then run -t over it
502 rmtree($datadir) if -e $datadir;
505 for my $fn (@filenames) {
506 open(my $fh, ">", "$datadir/$fn")
507 or die("opening $datadir/$fn: $!");
512 system($gnutar, "-C", $datadir, "-cf", $tarfile, '.');
513 die "could not run gnutar" unless $? == 0;
515 rmtree($datadir) if -e $datadir;
517 if ($params{'env'}) {
518 %env = %{$params{'env'}};
520 my $ok = run_gnutar(args => [ '-t', '-f', $tarfile, @{$params{'extra_args'}}],
524 diag("gnutar exited with nonzero status for version $v");
527 my @toc_members = sort split(/\n/, $stdout);
528 shift @toc_members; # strip off './'
529 is_deeply([ @toc_members ], [ @expectations ], $msg);
532 # there are no extra_args that seem to affect this behavior
535 env => { LC_CTYPE => 'C' }, # avoid any funniness with ctypes
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\\\\\\\\' ],