| Subject: | Truncates symlink destinations even with GNU extensions on |
When building an archive with symbolic links containing long (>100 character) destinations, those destinations are truncated in the resulting tar archive.
I've attached a test script that demonstrates the issue; it uses Archive::Tar::Wrapper and the first binary named "gnutar", "gtar" or "tar" in one's path to extract the archive built by Archive::Tar::Builder.
| Subject: | Archive-Tar-Builder_longsymlink.t |
#!/usr/bin/env perl
use strict;
use warnings;
use English '-no_match_vars';
use Test::More tests => 4;
use Test::TempDir::Tiny;
use Archive::Tar::Builder;
use Archive::Tar::Wrapper;
use Const::Fast;
use File::Temp;
use IO::All;
use List::Util 'first';
# find a GNU tar executable in path with which to validate Archive::Tar::Builder
my @executable = grep { $_->is_executable }
map { $_->all_files }
map { io->dir($_) } io->path;
my $TAR_EXECUTABLE;
for my $executable (@executable) {
$TAR_EXECUTABLE = first {$executable->filename eq $_} qw(gnutar gtar tar)
and last;
}
const my $PATH_SEPARATOR => '/';
const my $NAME_LENGTH => 10;
const my $DIR_COUNT => 20;
# make some long paths out of x's and y's
my @paths = map { join $PATH_SEPARATOR => ( $_ x $NAME_LENGTH ) x $DIR_COUNT }
qw(x y);
# make and enter the source directory
my $temp_dir = tempdir($PROGRAM_NAME);
my $temp_io = io->dir($temp_dir);
$temp_io->chdir;
# create file and symlink from @paths, including all intervening dirs
my @file = ( sub { shift->assert->touch }, sub { shift->link->assert } );
$file[$_]
= $file[$_]->( io->catfile( $temp_dir, $paths[$_] ) )->relative($temp_io)
for 0 .. $#file;
# set the link target
my $link_target = $file[0]->pathname;
$link_target =~ s/^$temp_dir\///;
$file[1]->symlink('../' x ($DIR_COUNT - 1) . $link_target);
# get a list of all dirs and files to archive
my @file_io = map { $_->relative($temp_io) } $temp_io->deep->all;
# build tar file
my $tar_file = File::Temp->new;
my $tar_build = Archive::Tar::Builder->new(gnu_extensions => 1);
$tar_build->set_handle($tar_file);
ok( $tar_build->archive(map {"$_"} @file_io), 'built tar');
$tar_build->finish;
# test overall archive file
my $tar_wrap = Archive::Tar::Wrapper->new(tar => $TAR_EXECUTABLE, dirs => 1);
ok($tar_wrap->read($tar_file), 'read tar');
ok($tar_wrap->is_gnu(), 'is GNU tar');
# test symlink and destination
my $unarchived_symlink = (io->dir($tar_wrap->tardir)->deep->filter(
sub {$_->type eq 'link'}
)->all)[0];
is(
$unarchived_symlink->readlink->pathname,
$file[1]->readlink->pathname,
'symlink targets match',
);