1 # Copyright (c) 2009-2012 Zmanda, Inc. All Rights Reserved.
3 # This program is free software; you can redistribute it and/or
4 # modify it under the terms of the GNU General Public License
5 # as published by the Free Software Foundation; either version 2
6 # of the License, or (at your option) any later version.
8 # This program is distributed in the hope that it will be useful, but
9 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
10 # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
13 # You should have received a copy of the GNU General Public License along
14 # with this program; if not, write to the Free Software Foundation, Inc.,
15 # 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
17 # Contact information: Zmanda Inc, 465 S. Mathilda Ave., Suite 300
18 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
20 use Test::More tests => 201;
23 use POSIX qw( WIFEXITED );
27 use lib "@amperldir@";
30 use Amanda::Constants;
31 use Amanda::Util qw( slurp );
33 ## this is an unusual installcheck, because it does not test anything about
34 ## Amanda itself. However, it validates the accuracy of our understanding of
35 ## GNU Tar's behavior, as recorded at
36 ## http://wiki.zmanda.com/index.php/GNU_Tar_Include_and_Exclude_Behavior
38 my $gnutar = $Amanda::Constants::GNUTAR;
39 $gnutar = $ENV{'GNUTAR'} if exists $ENV{'GNUTAR'};
43 my @filenames = (qw{A*A AxA B?B BxB C[C CC D]D E\E F'F G"G}, 'H H');
45 my $tarfile = "$Installcheck::TMP/gnutar-tests.tar";
46 my $datadir = "$Installcheck::TMP/gnutar-tests";
52 rmtree($datadir) if -e $datadir;
55 for my $fn (@filenames) {
56 open(my $fh, ">", "$datadir/$fn");
61 system($gnutar, "-C", $datadir, "-cf", $tarfile, @extra_args, '.');
62 die "could not run gnutar" unless $? == 0;
64 rmtree($datadir) if -e $datadir;
69 my ($v, $numeric_version);
71 my $verstring = `$gnutar --version`;
72 die "could not run gnutar" unless $? == 0;
73 ($v) = ($verstring =~ /tar \(GNU tar\) *([0-9.]+)/);
74 my ($maj, $min, $mic) = ($v =~ /([0-9]+)\.([0-9]+)(?:\.([0-9]+))?/);
77 $numeric_version += $maj * 10000 if $maj;
78 $numeric_version += $min * 100 if $min;
79 $numeric_version += $mic if $mic;
85 my $uname = `uname -a`;
86 if ($uname =~ /\.fc14\./) {
89 if ($uname =~ /\.fc15\./) {
92 if ($uname =~ /\.fc16\./) { #like fc15
95 if ($uname =~ /\.fc17\./) { #like fc15
100 # see if the default for --wildcards during inclusion has been changed
101 my $wc_default_changed = 0;
103 my $help_output = `$gnutar --help`;
104 # redhatty patches helpfully change the help message
105 if ($help_output =~ /--wildcards\s*use wildcards \(default\)$/m) {
106 $wc_default_changed = 1;
110 my %version_classes = (
111 '<1.16' => $numeric_version < 11591,
112 '>=1.16' => $numeric_version >= 11591,
113 '>=1.16-no-wc' => $numeric_version >= 11591 && !$wc_default_changed, # normal
114 '>=1.16-wc' => $numeric_version >= 11591 && $wc_default_changed, # stupid distros screw things up!
115 '1.16..<1.25' => $numeric_version >= 11591 && $numeric_version < 12500,
117 '<1.23' => $numeric_version < 12300,
118 '>=1.23' => $numeric_version >= 12300,
120 '1.23' => ($numeric_version >= 12290 and $numeric_version <= 12300),
121 '1.23fc14' => ($numeric_version == 12300 and $fc14),
122 '!1.23' => ($numeric_version < 12290 || ($numeric_version > 12300 && $numeric_version < 12500)),
123 '>=1.25' => $numeric_version >= 12500,
124 'fc15' => ($numeric_version >= 12500 and $fc15),
127 # include and exclude all use the same set of patterns and filenames
145 './E\\\\E' => 'E\\E',
146 './F\\\'F' => 'F\'F',
151 my $named_expectations = [
161 # al be ga de ep ze et io empty
162 [ 1, 1, 1, 1, 1, 1, 1, 1, 1, ], # './A*A' => 'A*A',
163 [ 1, 1, 1, 1, 0, 1, 1, 1, 0, ], # './A*A' => 'AxA',
164 [ 1, 1, 1, 1, 1, 1, 1, 1, 1, ], # './B?B' => 'B?B',
165 [ 1, 1, 1, 1, 0, 1, 1, 1, 0, ], # './B?B' => 'BxB',
166 [ 0, 0, 0, 0, 1, 1, 1, 1, 1, ], # './C[C' => 'C[C',
167 [ 1, 1, 1, 1, 1, 1, 1, 1, 1, ], # './D]D' => 'D]D',
168 [ 1, 0, 0, 1, 1, 0, 0, 1, 1, ], # './E\\E' => 'E\\E',
169 [ 1, 1, 1, 1, 1, 1, 1, 1, 1, ], # './F\'F' => 'F\'F',
170 [ 1, 1, 1, 1, 1, 1, 1, 1, 1, ], # './G"G' => 'G"G',
171 [ 1, 1, 1, 1, 1, 1, 1, 1, 1, ], # './H H' => 'H H',
172 [ 1, 1, 1, 0, 0, 1, 1, 0, 0, ], # './A\\*A' => 'A*A',
173 [ 0, 0, 0, 0, 0, 0, 0, 0, 0, ], # './A\\*A' => 'AxA',
174 [ 0, 0, 1, 0, 0, 0, 1, 0, 0, ], # './B\\?B' => 'B?B',
175 [ 0, 0, 0, 0, 0, 0, 0, 0, 0, ], # './B\\?B' => 'BxB',
176 [ 1, 1, 1, 0, 0, 1, 1, 0, 0, ], # './C\\[C' => 'C[C',
177 [ 0, 1, 1, 0, 0, 1, 1, 0, 0, ], # './D\\]D' => 'D]D',
178 [ 1, 0, 1, 0, 1, 0, 1, 0, 0, ], # './E\\\\E' => 'E\\E',
179 [ 0, 1, 1, 0, 0, 1, 1, 0, 0, ], # './F\\\'F' => 'F\'F',
180 [ 0, 1, 1, 0, 0, 1, 1, 0, 0, ], # './G\\"G' => 'G"G',
181 [ 0, 1, 1, 0, 0, 1, 1, 0, 0, ], # './H\\ H' => 'H H',
184 sub get_expectation {
186 my @names = @{$named_expectations->[0]};
188 # get the index for that greek letter
191 if ($names[$_] eq $name) {
197 # then assemble the result
199 my @exps = @$named_expectations;
208 sub get_matching_type {
209 my ($expectations) = @_;
211 # find the type for the first matching version
212 foreach my $exp (@$expectations) {
213 foreach (keys %$exp) {
214 if ($version_classes{$_}) {
222 sub get_version_index {
223 my @versions = @{$_[0]};
226 for (0 .. $#versions) {
227 if ($version_classes{$versions[$_]}) {
236 my ($stderr, $stdout, $exit_code);
239 my @args = @{ $params{'args'} };
241 my $errtempfile = "$Installcheck::TMP/stderr$$.out";
243 # use a temporary file for error output -- this eliminates synchronization
244 # problems between reading stderr and stdout
245 local (*INFH, *OUTFH, *ERRFH);
246 open(ERRFH, ">", $errtempfile);
249 if ($params{'env'}) {
250 my %env = %{$params{'env'}};
256 my $pid = IPC::Open3::open3("INFH", "OUTFH", ">&ERRFH", $gnutar, @args);
257 my $cmdline = "$gnutar " . join(' ', @args);
259 # immediately close the child's stdin
262 # read from stdout until it's closed
263 $stdout = do { local $/; <OUTFH> };
266 # and wait for the kid to die
267 waitpid $pid, 0 or croak("Error waiting for gnutar die: $@");
271 # fetch stderr from the temporary file
272 $stderr = slurp($errtempfile);
273 unlink($errtempfile);
275 # get the exit status
276 $exit_code = WIFEXITED($status)? ($status >> 8) : 0xffff;
278 if ($exit_code != 0) {
285 ## inclusion tests (using -x and filenames on the command line)
287 sub test_gnutar_inclusion {
290 my $matching_type = get_matching_type($params{'expectations'});
292 # skip these tests if there's no matching version
293 if (!defined $matching_type) {
295 my $msg = (join " ", @{$params{'extra_args'}}) .
296 " not supported in version $v";
297 my $count = @$patterns / 2;
304 my @patterns = @$patterns;
305 my @expectations = get_expectation($matching_type);
307 my $pat = shift @patterns;
308 my $file = shift @patterns;
309 my $exp = shift @expectations;
312 $eargs = ', ' . join(' ', @{$params{'extra_args'}}) if @{$params{'extra_args'}};
313 my $match = $exp? "matches" : "does not match";
314 my $msg = "inclusion$eargs, pattern $pat $match file $file";
316 rmtree($datadir) if -e $datadir;
319 my $ok = run_gnutar(args => [ '-C', $datadir, '-x', '-f', $tarfile, @{$params{'extra_args'}}, $pat ]);
320 $ok = 0 unless -f "$datadir/$file";
323 diag(" unexpected success with version $v");
324 } elsif (!$ok and $exp) {
326 diag(" unexpected failure with version $v:\n$stderr");
331 rmtree($datadir) if -e $datadir;
334 # We'll trust that the following logic is implemented correctly in GNU Tar
335 # --no-wildcards is the default (same as no args) (but not everywhere!!)
336 # --unquote is the default (same as no args) (this seems true universally)
338 test_gnutar_inclusion(
341 {'<1.16' => 'alpha'},
342 {'1.23fc14' => 'zeta'},
344 {'>=1.16-no-wc' => 'epsilon'},
345 {'>=1.16-wc' => 'beta'}, # acts like --wildcards
349 test_gnutar_inclusion(
350 extra_args => [ '--no-wildcards' ],
352 {'<1.16' => 'alpha'},
353 {'>=1.16' => 'epsilon'},
357 test_gnutar_inclusion(
358 extra_args => [ '--no-unquote' ],
361 {'1.23fc14' => 'eta'},
363 {'>=1.16-no-wc' => 'empty'},
364 {'>=1.16-wc' => 'gamma'}, # acts like --wildcards --no-unquote
368 test_gnutar_inclusion(
369 extra_args => [ '--no-wildcards', '--no-unquote' ],
372 {'>=1.16' => 'empty'},
376 test_gnutar_inclusion(
377 extra_args => [ '--wildcards' ],
379 {'<1.16' => 'alpha'},
380 {'1.23fc14' => 'zeta'},
381 {'1.16..<1.25' => 'beta'},
382 {'>=1.25' => 'zeta'},
386 test_gnutar_inclusion(
387 extra_args => [ '--wildcards', '--no-unquote' ],
390 {'1.23fc14' => 'eta'},
391 {'1.16..<1.25' => 'gamma'},
396 ## exclusion tests (using -t and filenames on the command line)
398 sub test_gnutar_exclusion {
401 my $matching_type = get_matching_type($params{'expectations'});
403 # skip these tests if there's no matching version
404 if (!defined $matching_type) {
406 my $msg = (join " ", @{$params{'extra_args'}}) .
407 " not supported in version $v";
408 my $count = @$patterns; # two elements per test, but we run each one twice
415 my @patterns = @$patterns;
416 my @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, extract, pattern $pat $match $file";
427 rmtree($datadir) if -e $datadir;
430 my $ok = run_gnutar(args => [ '-C', $datadir, '-x', '-f', $tarfile, @{$params{'extra_args'}}, "--exclude=$pat" ]);
432 # fail if the excluded file was extracted anyway..
434 my $excluded_ok = ! -f "$datadir/$file";
435 if ($excluded_ok and !$exp) {
437 diag(" exclusion unexpectedly worked with version $v");
438 } elsif (!$excluded_ok and $exp) {
440 diag(" exclusion unexpectedly failed with version $v");
446 diag(" unexpected error exit with version $v:\n$stderr");
450 # test again, but this time during a 'c'reate operation
451 @patterns = @$patterns;
452 @expectations = get_expectation($matching_type);
454 my $pat = shift @patterns;
455 my $file = shift @patterns;
456 my $exp = shift @expectations;
459 $eargs = ', ' . join(' ', @{$params{'extra_args'}}) if @{$params{'extra_args'}};
460 my $match = $exp? "matches" : "does not match";
461 my $msg = "exclusion$eargs, create, pattern $pat $match $file";
463 # this time around, we create the tarball with the exclude, then extract the whole
464 # thing. We extract rather than using 't' because 't' has a funny habit of backslashing
465 # its output that we don't want to deal with here.
466 make_tarfile(@{$params{'extra_args'}}, "--exclude=$pat");
468 rmtree($datadir) if -e $datadir;
470 my $ok = run_gnutar(args => [ '-C', $datadir, '-x', '-f', $tarfile]);
472 # fail if the excluded file was extracted anyway..
474 my $excluded_ok = ! -f "$datadir/$file";
475 if ($excluded_ok and !$exp) {
477 diag(" exclusion unexpectedly worked with version $v");
478 } elsif (!$excluded_ok and $exp) {
480 diag(" exclusion unexpectedly failed with version $v");
486 diag(" unexpected error exit with version $v:\n$stderr");
490 rmtree($datadir) if -e $datadir;
493 # We'll trust that the following logic is implemented correctly in GNU Tar
494 # --wildcards is the default (same as no args)
495 # --no-unquote / --unquote has no effect
498 test_gnutar_exclusion(
501 {'!1.23' => 'gamma'},
502 {'1.23fc14' => 'iota'},
509 test_gnutar_exclusion(
510 extra_args => [ '--no-wildcards' ],
518 sub test_gnutar_toc {
521 my $vi = get_version_index($params{'versions'});
523 my @patterns = @{ $params{'patterns'} };
527 my $file = shift @patterns;
528 my $exp = shift @patterns;
531 push @filenames, $file;
532 push @expectations, $exp;
536 $eargs = ', ' . join(' ', @{$params{'extra_args'}}) if @{$params{'extra_args'}};
537 my $msg = "list$eargs, with lots of funny characters";
539 # make a tarfile containing the filenames, then run -t over it
540 rmtree($datadir) if -e $datadir;
543 for my $fn (@filenames) {
544 open(my $fh, ">", "$datadir/$fn")
545 or die("opening $datadir/$fn: $!");
550 system($gnutar, "-C", $datadir, "-cf", $tarfile, '.');
551 die "could not run gnutar" unless $? == 0;
553 rmtree($datadir) if -e $datadir;
555 if ($params{'env'}) {
556 %env = %{$params{'env'}};
558 my $ok = run_gnutar(args => [ '-t', '-f', $tarfile, @{$params{'extra_args'}}],
562 diag("gnutar exited with nonzero status for version $v");
565 my @toc_members = sort split(/\n/, $stdout);
566 shift @toc_members; # strip off './'
567 is_deeply([ @toc_members ], [ @expectations ], $msg);
570 # there are no extra_args that seem to affect this behavior
573 env => { LC_CTYPE => 'C' }, # avoid any funniness with ctypes
576 "A\007", [ './A\a' ],
577 "B\010", [ './B\b' ],
578 "C\011", [ './C\t' ],
579 "D\012", [ './D\n' ],
580 "E\013", [ './E\v' ],
581 "F\014", [ './F\f' ],
582 "G\015", [ './G\r' ],
583 "H\\", [ './H\\\\' ], # H\ -> H\\
584 "I\177", [ './I\\177' ],
585 "J\317\264", [ './J\\317\\264' ], # use legitimate utf-8, for mac os fs
586 "K\\x", [ './K\\\\x' ],
587 "L\\\\", [ './L\\\\\\\\' ],