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;
84 my $uname = `uname -a`;
85 if ($uname =~ /\.fc14\./) {
88 if ($uname =~ /\.fc15\./) {
91 if ($uname =~ /\.fc16\./) { #like fc15
96 # see if the default for --wildcards during inclusion has been changed
97 my $wc_default_changed = 0;
99 my $help_output = `$gnutar --help`;
100 # redhatty patches helpfully change the help message
101 if ($help_output =~ /--wildcards\s*use wildcards \(default\)$/m) {
102 $wc_default_changed = 1;
106 my %version_classes = (
107 '<1.16' => $numeric_version < 11591,
108 '>=1.16' => $numeric_version >= 11591,
109 '>=1.16-no-wc' => $numeric_version >= 11591 && !$wc_default_changed, # normal
110 '>=1.16-wc' => $numeric_version >= 11591 && $wc_default_changed, # stupid distros screw things up!
111 '1.16..<1.25' => $numeric_version >= 11591 && $numeric_version < 12500,
113 '<1.23' => $numeric_version < 12300,
114 '>=1.23' => $numeric_version >= 12300,
116 '1.23' => ($numeric_version >= 12290 and $numeric_version <= 12300),
117 '1.23fc14' => ($numeric_version == 12300 and $fc14),
118 '!1.23' => ($numeric_version < 12290 || ($numeric_version > 12300 && $numeric_version < 12500)),
119 '>=1.25' => $numeric_version >= 12500,
120 'fc15' => ($numeric_version >= 12500 and $fc15),
123 # include and exclude all use the same set of patterns and filenames
141 './E\\\\E' => 'E\\E',
142 './F\\\'F' => 'F\'F',
147 my $named_expectations = [
157 # al be ga de ep ze et io empty
158 [ 1, 1, 1, 1, 1, 1, 1, 1, 1, ], # './A*A' => 'A*A',
159 [ 1, 1, 1, 1, 0, 1, 1, 1, 0, ], # './A*A' => 'AxA',
160 [ 1, 1, 1, 1, 1, 1, 1, 1, 1, ], # './B?B' => 'B?B',
161 [ 1, 1, 1, 1, 0, 1, 1, 1, 0, ], # './B?B' => 'BxB',
162 [ 0, 0, 0, 0, 1, 1, 1, 1, 1, ], # './C[C' => 'C[C',
163 [ 1, 1, 1, 1, 1, 1, 1, 1, 1, ], # './D]D' => 'D]D',
164 [ 1, 0, 0, 1, 1, 0, 0, 1, 1, ], # './E\\E' => 'E\\E',
165 [ 1, 1, 1, 1, 1, 1, 1, 1, 1, ], # './F\'F' => 'F\'F',
166 [ 1, 1, 1, 1, 1, 1, 1, 1, 1, ], # './G"G' => 'G"G',
167 [ 1, 1, 1, 1, 1, 1, 1, 1, 1, ], # './H H' => 'H H',
168 [ 1, 1, 1, 0, 0, 1, 1, 0, 0, ], # './A\\*A' => 'A*A',
169 [ 0, 0, 0, 0, 0, 0, 0, 0, 0, ], # './A\\*A' => 'AxA',
170 [ 0, 0, 1, 0, 0, 0, 1, 0, 0, ], # './B\\?B' => 'B?B',
171 [ 0, 0, 0, 0, 0, 0, 0, 0, 0, ], # './B\\?B' => 'BxB',
172 [ 1, 1, 1, 0, 0, 1, 1, 0, 0, ], # './C\\[C' => 'C[C',
173 [ 0, 1, 1, 0, 0, 1, 1, 0, 0, ], # './D\\]D' => 'D]D',
174 [ 1, 0, 1, 0, 1, 0, 1, 0, 0, ], # './E\\\\E' => 'E\\E',
175 [ 0, 1, 1, 0, 0, 1, 1, 0, 0, ], # './F\\\'F' => 'F\'F',
176 [ 0, 1, 1, 0, 0, 1, 1, 0, 0, ], # './G\\"G' => 'G"G',
177 [ 0, 1, 1, 0, 0, 1, 1, 0, 0, ], # './H\\ H' => 'H H',
180 sub get_expectation {
182 my @names = @{$named_expectations->[0]};
184 # get the index for that greek letter
187 if ($names[$_] eq $name) {
193 # then assemble the result
195 my @exps = @$named_expectations;
204 sub get_matching_type {
205 my ($expectations) = @_;
207 # find the type for the first matching version
208 foreach my $exp (@$expectations) {
209 foreach (keys %$exp) {
210 if ($version_classes{$_}) {
218 sub get_version_index {
219 my @versions = @{$_[0]};
222 for (0 .. $#versions) {
223 if ($version_classes{$versions[$_]}) {
232 my ($stderr, $stdout, $exit_code);
235 my @args = @{ $params{'args'} };
237 my $errtempfile = "$Installcheck::TMP/stderr$$.out";
239 # use a temporary file for error output -- this eliminates synchronization
240 # problems between reading stderr and stdout
241 local (*INFH, *OUTFH, *ERRFH);
242 open(ERRFH, ">", $errtempfile);
245 if ($params{'env'}) {
246 my %env = %{$params{'env'}};
252 my $pid = IPC::Open3::open3("INFH", "OUTFH", ">&ERRFH", $gnutar, @args);
253 my $cmdline = "$gnutar " . join(' ', @args);
255 # immediately close the child's stdin
258 # read from stdout until it's closed
259 $stdout = do { local $/; <OUTFH> };
262 # and wait for the kid to die
263 waitpid $pid, 0 or croak("Error waiting for gnutar die: $@");
267 # fetch stderr from the temporary file
268 $stderr = slurp($errtempfile);
269 unlink($errtempfile);
271 # get the exit status
272 $exit_code = WIFEXITED($status)? ($status >> 8) : 0xffff;
274 if ($exit_code != 0) {
281 ## inclusion tests (using -x and filenames on the command line)
283 sub test_gnutar_inclusion {
286 my $matching_type = get_matching_type($params{'expectations'});
288 # skip these tests if there's no matching version
289 if (!defined $matching_type) {
291 my $msg = (join " ", @{$params{'extra_args'}}) .
292 " not supported in version $v";
293 my $count = @$patterns / 2;
300 my @patterns = @$patterns;
301 my @expectations = get_expectation($matching_type);
303 my $pat = shift @patterns;
304 my $file = shift @patterns;
305 my $exp = shift @expectations;
308 $eargs = ', ' . join(' ', @{$params{'extra_args'}}) if @{$params{'extra_args'}};
309 my $match = $exp? "matches" : "does not match";
310 my $msg = "inclusion$eargs, pattern $pat $match file $file";
312 rmtree($datadir) if -e $datadir;
315 my $ok = run_gnutar(args => [ '-C', $datadir, '-x', '-f', $tarfile, @{$params{'extra_args'}}, $pat ]);
316 $ok = 0 unless -f "$datadir/$file";
319 diag(" unexpected success with version $v");
320 } elsif (!$ok and $exp) {
322 diag(" unexpected failure with version $v:\n$stderr");
327 rmtree($datadir) if -e $datadir;
330 # We'll trust that the following logic is implemented correctly in GNU Tar
331 # --no-wildcards is the default (same as no args) (but not everywhere!!)
332 # --unquote is the default (same as no args) (this seems true universally)
334 test_gnutar_inclusion(
337 {'<1.16' => 'alpha'},
338 {'1.23fc14' => 'zeta'},
340 {'>=1.16-no-wc' => 'epsilon'},
341 {'>=1.16-wc' => 'beta'}, # acts like --wildcards
345 test_gnutar_inclusion(
346 extra_args => [ '--no-wildcards' ],
348 {'<1.16' => 'alpha'},
349 {'>=1.16' => 'epsilon'},
353 test_gnutar_inclusion(
354 extra_args => [ '--no-unquote' ],
357 {'1.23fc14' => 'eta'},
359 {'>=1.16-no-wc' => 'empty'},
360 {'>=1.16-wc' => 'gamma'}, # acts like --wildcards --no-unquote
364 test_gnutar_inclusion(
365 extra_args => [ '--no-wildcards', '--no-unquote' ],
368 {'>=1.16' => 'empty'},
372 test_gnutar_inclusion(
373 extra_args => [ '--wildcards' ],
375 {'<1.16' => 'alpha'},
376 {'1.23fc14' => 'zeta'},
377 {'1.16..<1.25' => 'beta'},
378 {'>=1.25' => 'zeta'},
382 test_gnutar_inclusion(
383 extra_args => [ '--wildcards', '--no-unquote' ],
386 {'1.23fc14' => 'eta'},
387 {'1.16..<1.25' => 'gamma'},
392 ## exclusion tests (using -t and filenames on the command line)
394 sub test_gnutar_exclusion {
397 my $matching_type = get_matching_type($params{'expectations'});
399 # skip these tests if there's no matching version
400 if (!defined $matching_type) {
402 my $msg = (join " ", @{$params{'extra_args'}}) .
403 " not supported in version $v";
404 my $count = @$patterns; # two elements per test, but we run each one twice
411 my @patterns = @$patterns;
412 my @expectations = get_expectation($matching_type);
414 my $pat = shift @patterns;
415 my $file = shift @patterns;
416 my $exp = shift @expectations;
419 $eargs = ', ' . join(' ', @{$params{'extra_args'}}) if @{$params{'extra_args'}};
420 my $match = $exp? "matches" : "does not match";
421 my $msg = "exclusion$eargs, extract, pattern $pat $match $file";
423 rmtree($datadir) if -e $datadir;
426 my $ok = run_gnutar(args => [ '-C', $datadir, '-x', '-f', $tarfile, @{$params{'extra_args'}}, "--exclude=$pat" ]);
428 # fail if the excluded file was extracted anyway..
430 my $excluded_ok = ! -f "$datadir/$file";
431 if ($excluded_ok and !$exp) {
433 diag(" exclusion unexpectedly worked with version $v");
434 } elsif (!$excluded_ok and $exp) {
436 diag(" exclusion unexpectedly failed with version $v");
442 diag(" unexpected error exit with version $v:\n$stderr");
446 # test again, but this time during a 'c'reate operation
447 @patterns = @$patterns;
448 @expectations = get_expectation($matching_type);
450 my $pat = shift @patterns;
451 my $file = shift @patterns;
452 my $exp = shift @expectations;
455 $eargs = ', ' . join(' ', @{$params{'extra_args'}}) if @{$params{'extra_args'}};
456 my $match = $exp? "matches" : "does not match";
457 my $msg = "exclusion$eargs, create, pattern $pat $match $file";
459 # this time around, we create the tarball with the exclude, then extract the whole
460 # thing. We extract rather than using 't' because 't' has a funny habit of backslashing
461 # its output that we don't want to deal with here.
462 make_tarfile(@{$params{'extra_args'}}, "--exclude=$pat");
464 rmtree($datadir) if -e $datadir;
466 my $ok = run_gnutar(args => [ '-C', $datadir, '-x', '-f', $tarfile]);
468 # fail if the excluded file was extracted anyway..
470 my $excluded_ok = ! -f "$datadir/$file";
471 if ($excluded_ok and !$exp) {
473 diag(" exclusion unexpectedly worked with version $v");
474 } elsif (!$excluded_ok and $exp) {
476 diag(" exclusion unexpectedly failed with version $v");
482 diag(" unexpected error exit with version $v:\n$stderr");
486 rmtree($datadir) if -e $datadir;
489 # We'll trust that the following logic is implemented correctly in GNU Tar
490 # --wildcards is the default (same as no args)
491 # --no-unquote / --unquote has no effect
494 test_gnutar_exclusion(
497 {'!1.23' => 'gamma'},
498 {'1.23fc14' => 'iota'},
505 test_gnutar_exclusion(
506 extra_args => [ '--no-wildcards' ],
514 sub test_gnutar_toc {
517 my $vi = get_version_index($params{'versions'});
519 my @patterns = @{ $params{'patterns'} };
523 my $file = shift @patterns;
524 my $exp = shift @patterns;
527 push @filenames, $file;
528 push @expectations, $exp;
532 $eargs = ', ' . join(' ', @{$params{'extra_args'}}) if @{$params{'extra_args'}};
533 my $msg = "list$eargs, with lots of funny characters";
535 # make a tarfile containing the filenames, then run -t over it
536 rmtree($datadir) if -e $datadir;
539 for my $fn (@filenames) {
540 open(my $fh, ">", "$datadir/$fn")
541 or die("opening $datadir/$fn: $!");
546 system($gnutar, "-C", $datadir, "-cf", $tarfile, '.');
547 die "could not run gnutar" unless $? == 0;
549 rmtree($datadir) if -e $datadir;
551 if ($params{'env'}) {
552 %env = %{$params{'env'}};
554 my $ok = run_gnutar(args => [ '-t', '-f', $tarfile, @{$params{'extra_args'}}],
558 diag("gnutar exited with nonzero status for version $v");
561 my @toc_members = sort split(/\n/, $stdout);
562 shift @toc_members; # strip off './'
563 is_deeply([ @toc_members ], [ @expectations ], $msg);
566 # there are no extra_args that seem to affect this behavior
569 env => { LC_CTYPE => 'C' }, # avoid any funniness with ctypes
572 "A\007", [ './A\a' ],
573 "B\010", [ './B\b' ],
574 "C\011", [ './C\t' ],
575 "D\012", [ './D\n' ],
576 "E\013", [ './E\v' ],
577 "F\014", [ './F\f' ],
578 "G\015", [ './G\r' ],
579 "H\\", [ './H\\\\' ], # H\ -> H\\
580 "I\177", [ './I\\177' ],
581 "J\317\264", [ './J\\317\\264' ], # use legitimate utf-8, for mac os fs
582 "K\\x", [ './K\\\\x' ],
583 "L\\\\", [ './L\\\\\\\\' ],