bin/pax/tests/legacy_test.pl

   1 # $FreeBSD$
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 6;
   7 use File::Path qw(rmtree mkpath);
   8 use Cwd;
   9
  10 my $n = 0;
  11 sub create_file {
  12     my $fn = shift;
  13
  14     $n++;
  15     (my $dir = $fn) =~ s,/[^/]+$,,;
  16     mkpath $dir;
  17     open my $fd, ">", $fn or die "$fn: $!";
  18     print $fd "file $n\n";
  19 }
  20
  21
  22 ustar_pathnames: { SKIP: {
  23     # Prove that pax breaks up ustar pathnames properly
  24
  25     my $top = getcwd . "/ustar-pathnames-1";
  26     skip "Current path is too long", 6 if length $top > 92;
  27     rmtree $top;
  28     my $subdir = "x" . "x" x (92 - length $top);
  29     my $work94 = "$top/$subdir";
  30     mkpath $work94;             # $work is 94 characters long
  31
  32     my $x49 = "x" x 49;
  33     my $x50 = "x" x 50;
  34     my $x60 = "x" x 60;
  35     my $x95 = "x" x 95;
  36
  37     my @paths = (
  38         "$work94/x099",         # 99 chars
  39         "$work94/xx100",                # 100 chars
  40         "$work94/xxx101",               # 101 chars
  41         "$work94/$x49/${x50}x199",      # 199 chars
  42         "$work94/$x49/${x50}xx200",     # 200 chars
  43         "$work94/$x49/${x50}xxx201",    # 201 chars
  44         "$work94/$x60/${x95}254",       # 254 chars
  45         "$work94/$x60/${x95}x255",      # 255 chars
  46     );
  47
  48     my @l = map { length } @paths;
  49
  50     my $n = 0;
  51     create_file $_ for @paths;
  52     system "pax -wf ustar.ok $work94";
  53     ok($? == 0, "Wrote 'ustar.ok' containing files with lengths @l");
  54
  55     (my $orig = $top) =~ s,1$,2,;
  56     rmtree $orig;
  57     rename $top, $orig;
  58
  59     system "pax -rf ustar.ok";
  60     ok($? == 0, "Restored 'ustar.ok' containing files with lengths @l");
  61
  62     system "diff -ru $orig $top";
  63     ok($? == 0, "Restored files are identical");
  64
  65     rmtree $top;
  66     rename $orig, $top;
  67
  68     # 256 chars (with components < 100 chars) should not work
  69     push @paths, "$work94/x$x60/${x95}x256";    # 256 chars
  70     push @l, length $paths[-1];
  71     create_file $paths[-1];
  72     system "pax -wf ustar.fail1 $work94";
  73     ok($?, "Failed to write 'ustar.fail1' containing files with lengths @l");
  74
  75     # Components with 100 chars shouldn't work
  76     unlink $paths[-1];
  77     $paths[-1] = "$work94/${x95}xc100";         # 100 char filename
  78     $l[-1] = length $paths[-1];
  79     create_file $paths[-1];
  80     system "pax -wf ustar.fail2 $work94";
  81     ok($?, "Failed to write 'ustar.fail2' with a 100 char filename");
  82
  83     unlink $paths[-1];
  84     $paths[-1] = "$work94/${x95}xc100/x";       # 100 char component
  85     $l[-1] = length $paths[-1];
  86     create_file $paths[-1];
  87     system "pax -wf ustar.fail3 $work94";
  88     ok($?, "Failed to write 'ustar.fail3' with a 100 char component");
  89 }}