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