Archive-Tar-1.46
diff -urN perl-5.10.0.orig/MANIFEST perl-5.10.0/MANIFEST
--- perl-5.10.0.orig/MANIFEST 2009-02-20 18:22:32.000000000 +0100
+++ perl-5.10.0/MANIFEST 2009-03-11 17:11:27.000000000 +0100
@@ -1413,12 +1413,19 @@
lib/Archive/Tar/t/02_methods.t Archive::Tar tests
lib/Archive/Tar/t/03_file.t Archive::Tar tests
lib/Archive/Tar/t/04_resolved_issues.t Archive::Tar tests
+lib/Archive/Tar/t/05_iter.t Archive::Tar tests
+lib/Archive/Tar/t/90_symlink.t Archive::Tar tests
+lib/Archive/Tar/t/src/linktest/linktest_missing_dir.tar.packed Archive::Tar tests
+lib/Archive/Tar/t/src/linktest/linktest_with_dir.tar.packed Archive::Tar tests
lib/Archive/Tar/t/src/long/b Archive::Tar tests
lib/Archive/Tar/t/src/long/bar.tar.packed Archive::Tar tests
+lib/Archive/Tar/t/src/long/foo.tbz.packed Archive::Tar tests
lib/Archive/Tar/t/src/long/foo.tgz.packed Archive::Tar tests
lib/Archive/Tar/t/src/short/b Archive::Tar tests
lib/Archive/Tar/t/src/short/bar.tar.packed Archive::Tar tests
+lib/Archive/Tar/t/src/short/foo.tbz.packed Archive::Tar tests
lib/Archive/Tar/t/src/short/foo.tgz.packed Archive::Tar tests
+lib/Archive/Tar/t/src/header/signed.tar.packed Archive::Tar tests
lib/assert.pl assertion and panic with stack trace
lib/Attribute/Handlers/Changes Attribute::Handlers
lib/Attribute/Handlers/demo/demo2.pl Attribute::Handlers demo
diff -urN perl-5.10.0.orig/lib/Archive/Tar/Constant.pm perl-5.10.0/lib/Archive/Tar/Constant.pm
--- perl-5.10.0.orig/lib/Archive/Tar/Constant.pm 2009-02-20 11:21:14.000000000 +0100
+++ perl-5.10.0/lib/Archive/Tar/Constant.pm 2009-03-11 17:11:27.000000000 +0100
@@ -2,20 +2,16 @@
BEGIN {
require Exporter;
- $VERSION= '0.02';
- @ISA = qw[Exporter];
- @EXPORT = qw[
- FILE HARDLINK SYMLINK CHARDEV BLOCKDEV DIR FIFO SOCKET UNKNOWN
- BUFFER HEAD READ_ONLY WRITE_ONLY UNPACK PACK TIME_OFFSET ZLIB
- BLOCK_SIZE TAR_PAD TAR_END ON_UNIX BLOCK CAN_READLINK MAGIC
- TAR_VERSION UNAME GNAME CAN_CHOWN MODE CHECK_SUM UID GID
- GZIP_MAGIC_NUM MODE_READ LONGLINK LONGLINK_NAME PREFIX_LENGTH
- LABEL NAME_LENGTH STRIP_MODE ON_VMS
- ];
+
+ $VERSION = '0.02';
+ @ISA = qw[Exporter];
require Time::Local if $^O eq "MacOS";
}
+use Package::Constants;
+@EXPORT = Package::Constants->list( __PACKAGE__ );
+
use constant FILE => 0;
use constant HARDLINK => 1;
use constant SYMLINK => 2;
@@ -32,6 +28,9 @@
use constant HEAD => 512;
use constant BLOCK => 512;
+use constant COMPRESS_GZIP => 9;
+use constant COMPRESS_BZIP => 'bzip2';
+
use constant BLOCK_SIZE => sub { my $n = int($_[0]/BLOCK); $n++ if $_[0] % BLOCK; $n * BLOCK };
use constant TAR_PAD => sub { my $x = shift || return; return "\0" x (BLOCK - ($x % BLOCK) ) };
use constant TAR_END => "\0" x BLOCK;
@@ -61,16 +60,25 @@
use constant MAGIC => "ustar";
use constant TAR_VERSION => "00";
use constant LONGLINK_NAME => '././@LongLink';
+use constant PAX_HEADER => 'pax_global_header';
- ### allow ZLIB to be turned off using ENV
- ### DEBUG only
+ ### allow ZLIB to be turned off using ENV: DEBUG only
use constant ZLIB => do { !$ENV{'PERL5_AT_NO_ZLIB'} and
eval { require IO::Zlib };
- $ENV{'PERL5_AT_NO_ZLIB'} || $@ ? 0 : 1 };
-
+ $ENV{'PERL5_AT_NO_ZLIB'} || $@ ? 0 : 1
+ };
+
+ ### allow BZIP to be turned off using ENV: DEBUG only
+use constant BZIP => do { !$ENV{'PERL5_AT_NO_BZIP'} and
+ eval { require IO::Uncompress::Bunzip2;
+ require IO::Compress::Bzip2; };
+ $ENV{'PERL5_AT_NO_BZIP'} || $@ ? 0 : 1
+ };
+
use constant GZIP_MAGIC_NUM => qr/^(?:\037\213|\037\235)/;
+use constant BZIP_MAGIC_NUM => qr/^BZh\d/;
-use constant CAN_CHOWN => do { ($> == 0 and $^O ne "MacOS" and $^O ne "MSWin32") };
+use constant CAN_CHOWN => sub { ($> == 0 and $^O ne "MacOS" and $^O ne "MSWin32") };
use constant CAN_READLINK => ($^O ne 'MSWin32' and $^O !~ /RISC(?:[ _])?OS/i and $^O ne 'VMS');
use constant ON_UNIX => ($^O ne 'MSWin32' and $^O ne 'MacOS' and $^O ne 'VMS');
use constant ON_VMS => $^O eq 'VMS';
diff -urN perl-5.10.0.orig/lib/Archive/Tar/File.pm perl-5.10.0/lib/Archive/Tar/File.pm
--- perl-5.10.0.orig/lib/Archive/Tar/File.pm 2009-02-20 11:21:14.000000000 +0100
+++ perl-5.10.0/lib/Archive/Tar/File.pm 2009-03-11 17:12:58.000000000 +0100
@@ -1,15 +1,18 @@
package Archive::Tar::File;
use strict;
+use Carp ();
use IO::File;
use File::Spec::Unix ();
use File::Spec ();
use File::Basename ();
+### avoid circular use, so only require;
+require Archive::Tar;
use Archive::Tar::Constant;
use vars qw[@ISA $VERSION];
-@ISA = qw[Archive::Tar];
+#@ISA = qw[Archive::Tar];
$VERSION = '0.02';
### set value to 1 to oct() it during the unpack ###
@@ -154,13 +157,13 @@
=head1 Methods
-=head2 new( file => $path )
+=head2 Archive::Tar::File->new( file => $path )
Returns a new Archive::Tar::File object from an existing file.
Returns undef on failure.
-=head2 new( data => $path, $data, $opt )
+=head2 Archive::Tar::File->new( data => $path, $data, $opt )
Returns a new Archive::Tar::File object from data.
@@ -171,7 +174,7 @@
Returns undef on failure.
-=head2 new( chunk => $chunk )
+=head2 Archive::Tar::File->new( chunk => $chunk )
Returns a new Archive::Tar::File object from a raw 512-byte tar
archive chunk.
@@ -266,6 +269,29 @@
my @items = qw[mode uid gid size mtime];
my %hash = map { shift(@items), $_ } (lstat $path)[2,4,5,7,9];
+ if (ON_VMS) {
+ ### VMS has two UID modes, traditional and POSIX. Normally POSIX is
+ ### not used. We currently do not have an easy way to see if we are in
+ ### POSIX mode. In traditional mode, the UID is actually the VMS UIC.
+ ### The VMS UIC has the upper 16 bits is the GID, which in many cases
+ ### the VMS UIC will be larger than 209715, the largest that TAR can
+ ### handle. So for now, assume it is traditional if the UID is larger
+ ### than 0x10000.
+
+ if ($hash{uid} > 0x10000) {
+ $hash{uid} = $hash{uid} & 0xFFFF;
+ }
+
+ ### The file length from stat() is the physical length of the file
+ ### However the amount of data read in may be more for some file types.
+ ### Fixed length files are read past the logical EOF to end of the block
+ ### containing. Other file types get expanded on read because record
+ ### delimiters are added.
+
+ my $data_len = length $data;
+ $hash{size} = $data_len if $hash{size} < $data_len;
+
+ }
### you *must* set size == 0 on symlinks, or the next entry will be
### though of as the contents of the symlink, which is wrong.
### this fixes bug #7937
@@ -367,6 +393,9 @@
### if it's a directory, then $file might be empty
$file = pop @dirs if $self->is_dir and not length $file;
+ ### splitting ../ gives you the relative path in native syntax
+ map { $_ = '..' if $_ eq '-' } @dirs if ON_VMS;
+
my $prefix = File::Spec::Unix->catdir(
grep { length } $vol, @dirs
);
@@ -411,7 +440,25 @@
return 1;
}
-=head2 full_path
+=head2 $bool = $file->extract( [ $alternative_name ] )
+
+Extract this object, optionally to an alternative name.
+
+See C<< Archive::Tar->extract_file >> for details.
+
+Returns true on success and false on failure.
+
+=cut
+
+sub extract {
+ my $self = shift;
+
+ local $Carp::CarpLevel += 1;
+
+ return Archive::Tar->_extract_file( $self, @_ );
+}
+
+=head2 $path = $file->full_path
Returns the full path from the tar header; this is basically a
concatenation of the C<prefix> and C<name> fields.
@@ -429,7 +476,7 @@
}
-=head2 validate
+=head2 $bool = $file->validate
Done by Archive::Tar internally when reading the tar file:
validate the header against the checksum to ensure integer tar file.
@@ -445,10 +492,17 @@
### don't know why this one is different from the one we /write/ ###
substr ($raw, 148, 8) = " ";
- return unpack ("%16C*", $raw) == $self->chksum ? 1 : 0;
+
+ ### bug #43513: [PATCH] Accept wrong checksums from SunOS and HP-UX tar
+ ### like GNU tar does. See here for details:
+ ### http://www.gnu.org/software/tar/manual/tar.html#SEC139
+ ### so we do both a signed AND unsigned validate. if one succeeds, that's
+ ### good enough
+ return ( (unpack ("%16C*", $raw) == $self->chksum)
+ or (unpack ("%16c*", $raw) == $self->chksum)) ? 1 : 0;
}
-=head2 has_content
+=head2 $bool = $file->has_content
Returns a boolean to indicate whether the current object has content.
Some special files like directories and so on never will have any
@@ -462,7 +516,7 @@
return defined $self->data() && length $self->data() ? 1 : 0;
}
-=head2 get_content
+=head2 $content = $file->get_content
Returns the current content for the in-memory file
@@ -473,7 +527,7 @@
$self->data( );
}
-=head2 get_content_by_ref
+=head2 $cref = $file->get_content_by_ref
Returns the current content for the in-memory file as a scalar
reference. Normal users won't need this, but it will save memory if
@@ -489,7 +543,7 @@
return \$self->{data};
}
-=head2 replace_content( $content )
+=head2 $bool = $file->replace_content( $content )
Replace the current content of the file with the new content. This
only affects the in-memory archive, not the on-disk version until
@@ -508,7 +562,7 @@
return 1;
}
-=head2 rename( $new_name )
+=head2 $bool = $file->rename( $new_name )
Rename the current file to $new_name.
@@ -540,49 +594,49 @@
=over 4
-=item is_file
+=item $file->is_file
Returns true if the file is of type C<file>
-=item is_dir
+=item $file->is_dir
Returns true if the file is of type C<dir>
-=item is_hardlink
+=item $file->is_hardlink
Returns true if the file is of type C<hardlink>
-=item is_symlink
+=item $file->is_symlink
Returns true if the file is of type C<symlink>
-=item is_chardev
+=item $file->is_chardev
Returns true if the file is of type C<chardev>
-=item is_blockdev
+=item $file->is_blockdev
Returns true if the file is of type C<blockdev>
-=item is_fifo
+=item $file->is_fifo
Returns true if the file is of type C<fifo>
-=item is_socket
+=item $file->is_socket
Returns true if the file is of type C<socket>
-=item is_longlink
+=item $file->is_longlink
Returns true if the file is of type C<LongLink>.
Should not happen after a successful C<read>.
-=item is_label
+=item $file->is_label
Returns true if the file is of type C<Label>.
Should not happen after a successful C<read>.
-=item is_unknown
+=item $file->is_unknown
Returns true if the file type is C<unknown>
diff -urN perl-5.10.0.orig/lib/Archive/Tar/bin/ptar perl-5.10.0/lib/Archive/Tar/bin/ptar
--- perl-5.10.0.orig/lib/Archive/Tar/bin/ptar 2009-02-20 11:21:14.000000000 +0100
+++ perl-5.10.0/lib/Archive/Tar/bin/ptar 2009-03-11 17:11:27.000000000 +0100
@@ -1,12 +1,13 @@
#!/usr/bin/perl
use strict;
+use File::Find;
use Getopt::Std;
use Archive::Tar;
-use File::Find;
+use Data::Dumper;
my $opts = {};
-getopts('dcvzthxf:I', $opts) or die usage();
+getopts('Ddcvzthxf:I', $opts) or die usage();
### show the help message ###
die usage() if $opts->{h};
@@ -33,72 +34,63 @@
find( sub { push @files, $File::Find::name;
print $File::Find::name.$/ if $verbose }, @ARGV );
- Archive::Tar->create_archive( $file, $compress, @files );
- exit;
-}
-
-my $tar = Archive::Tar->new($file, $compress);
+ if ($file eq '-') {
+ use IO::Handle;
+ $file = IO::Handle->new();
+ $file->fdopen(fileno(STDOUT),"w");
+ }
-if( $opts->{t} ) {
- print map { $_->full_path . $/ } $tar->get_files;
+ Archive::Tar->create_archive( $file, $compress, @files );
-} elsif( $opts->{x} ) {
- print map { $_->full_path . $/ } $tar->get_files
- if $verbose;
- Archive::Tar->extract_archive($file, $compress);
+} else {
+ if ($file eq '-') {
+ use IO::Handle;
+ $file = IO::Handle->new();
+ $file->fdopen(fileno(STDIN),"r");
+ }
+
+ ### print the files we're finding?
+ my $print = $verbose || $opts->{'t'} || 0;
+
+ my $iter = Archive::Tar->iter( $file );
+
+ while( my $f = $iter->() ) {
+ print $f->full_path . $/ if $print;
+
+ ### data dumper output
+ print Dumper( $f ) if $opts->{'D'};
+
+ ### extract it
+ $f->extract if $opts->{'x'};
+ }
}
-
-
+### pod & usage in one
sub usage {
- qq[
-Usage: ptar -c [-v] [-z] [-f ARCHIVE_FILE] FILE FILE ...
- ptar -x [-v] [-z] [-f ARCHIVE_FILE]
- ptar -t [-z] [-f ARCHIVE_FILE]
- ptar -h
-
- ptar is a small, tar look-alike program that uses the perl module
- Archive::Tar to extract, create and list tar archives.
-
-Options:
- x Extract from ARCHIVE_FILE
- c Create ARCHIVE_FILE from FILE
- t List the contents of ARCHIVE_FILE
- f Name of the ARCHIVE_FILE to use. Default is './default.tar'
- z Read/Write zlib compressed ARCHIVE_FILE (not always available)
- v Print filenames as they are added or extraced from ARCHIVE_FILE
- h Prints this help message
- I Enable 'Insecure Extract Mode', which allows archives to extract
- files outside the current working directory. (Not advised).
-
-See Also:
- tar(1)
- Archive::Tar
-
- \n]
-}
+ my $usage .= << '=cut';
+=pod
=head1 NAME
-ptar - a tar-like program written in perl
+ ptar - a tar-like program written in perl
=head1 DESCRIPTION
-ptar is a small, tar look-alike program that uses the perl module
-Archive::Tar to extract, create and list tar archives.
+ ptar is a small, tar look-alike program that uses the perl module
+ Archive::Tar to extract, create and list tar archives.
=head1 SYNOPSIS
- ptar -c [-v] [-z] [-f ARCHIVE_FILE] FILE FILE ...
- ptar -x [-v] [-z] [-f ARCHIVE_FILE]
- ptar -t [-z] [-f ARCHIVE_FILE]
+ ptar -c [-v] [-z] [-f ARCHIVE_FILE | -] FILE FILE ...
+ ptar -x [-v] [-z] [-f ARCHIVE_FILE | -]
+ ptar -t [-z] [-f ARCHIVE_FILE | -]
ptar -h
=head1 OPTIONS
- x Extract from ARCHIVE_FILE
- c Create ARCHIVE_FILE from FILE
- t List the contents of ARCHIVE_FILE
+ c Create ARCHIVE_FILE or STDOUT (-) from FILE
+ x Extract from ARCHIVE_FILE or STDIN (-)
+ t List the contents of ARCHIVE_FILE or STDIN (-)
f Name of the ARCHIVE_FILE to use. Default is './default.tar'
z Read/Write zlib compressed ARCHIVE_FILE (not always available)
v Print filenames as they are added or extraced from ARCHIVE_FILE
@@ -106,6 +98,17 @@
=head1 SEE ALSO
-tar(1), L<Archive::Tar>.
+ tar(1), L<Archive::Tar>.
=cut
+
+ ### strip the pod directives
+ $usage =~ s/=pod\n//g;
+ $usage =~ s/=head1 //g;
+
+ ### add some newlines
+ $usage .= $/.$/;
+
+ return $usage;
+}
+
diff -urN perl-5.10.0.orig/lib/Archive/Tar/t/02_methods.t perl-5.10.0/lib/Archive/Tar/t/02_methods.t
--- perl-5.10.0.orig/lib/Archive/Tar/t/02_methods.t 2009-02-20 11:21:14.000000000 +0100
+++ perl-5.10.0/lib/Archive/Tar/t/02_methods.t 2009-03-11 17:11:27.000000000 +0100
@@ -1,7 +1,7 @@
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir '../lib/Archive/Tar' if -d '../lib/Archive/Tar';
- }
+ }
use lib '../../..';
}
@@ -21,9 +21,15 @@
use File::Basename ();
use Data::Dumper;
-use Archive::Tar;
+### need the constants at compile time;
use Archive::Tar::Constant;
+my $Class = 'Archive::Tar';
+my $FClass = $Class . '::File';
+use_ok( $Class );
+
+
+
### XXX TODO:
### * change to fullname
### * add tests for global variables
@@ -72,22 +78,23 @@
}
my @ROOT = grep { length } 'src', $TOO_LONG ? 'short' : 'long';
-
-my $ZLIB = eval { require IO::Zlib; 1 } ? 1 : 0;
my $NO_UNLINK = $ARGV[0] ? 1 : 0;
### enable debugging?
-$Archive::Tar::DEBUG = 1 if $ARGV[1];
+### pesky warnings
+$Archive::Tar::DEBUG = $Archive::Tar::DEBUG = 1 if $ARGV[1];
### tests for binary and x/x files
-my $TARBIN = Archive::Tar->new;
-my $TARX = Archive::Tar->new;
+my $TARBIN = $Class->new;
+my $TARX = $Class->new;
### paths to a .tar and .tgz file to use for tests
my $TAR_FILE = File::Spec->catfile( @ROOT, 'bar.tar' );
my $TGZ_FILE = File::Spec->catfile( @ROOT, 'foo.tgz' );
+my $TBZ_FILE = File::Spec->catfile( @ROOT, 'foo.tbz' );
my $OUT_TAR_FILE = File::Spec->catfile( @ROOT, 'out.tar' );
my $OUT_TGZ_FILE = File::Spec->catfile( @ROOT, 'out.tgz' );
+my $OUT_TBZ_FILE = File::Spec->catfile( @ROOT, 'out.tbz' );
my $COMPRESS_FILE = 'copy';
$^O eq 'VMS' and $COMPRESS_FILE .= '.';
@@ -96,18 +103,19 @@
### done setting up environment ###
-
-### did we probe IO::Zlib support ok? ###
-{ is( Archive::Tar->can_handle_compressed_files, $ZLIB,
- "Proper IO::Zlib support detected" );
+### check for zlib/bzip2 support
+{ for my $meth ( qw[has_zlib_support has_bzip2_support] ) {
+ can_ok( $Class, $meth );
+ }
}
+
### tar error tests
-{ my $tar = Archive::Tar->new;
+{ my $tar = $Class->new;
ok( $tar, "Object created" );
- isa_ok( $tar, 'Archive::Tar');
+ isa_ok( $tar, $Class );
local $Archive::Tar::WARN = 0;
@@ -133,151 +141,155 @@
### check if ->error eq $error
is( $tar->error, $Archive::Tar::error,
- '$error matches error() method' );
-
- ### check that 'contains_file' doesn't warn about missing files.
+ "Error '$Archive::Tar::error' matches $Class->error method" );
+
+ ### check that 'contains_file' doesn't warn about missing files.
{ ### turn on warnings in general!
local $Archive::Tar::WARN = 1;
my $warnings = '';
local $SIG{__WARN__} = sub { $warnings .= "@_" };
-
+
my $rv = $tar->contains_file( $$ );
ok( !$rv, "Does not contain file '$$'" );
is( $warnings, '', " No warnings issued during lookup" );
- }
+ }
}
### read tests ###
-{ ### normal tar + gz compressed file
- my $archive = $TAR_FILE;
- my $compressed = $TGZ_FILE;
- my $tar = Archive::Tar->new;
- my $gzip = 0;
+{ my @to_try = ($TAR_FILE);
+ push @to_try, $TGZ_FILE if $Class->has_zlib_support;
+ push @to_try, $TBZ_FILE if $Class->has_bzip2_support;
- ### check we got the object
- ok( $tar, "Object created" );
- isa_ok( $tar, 'Archive::Tar');
+ for my $type( @to_try ) {
- for my $type( $archive, $compressed ) {
- my $state = $gzip ? 'compressed' : 'uncompressed';
+ ### normal tar + gz compressed file
+ my $tar = $Class->new;
- SKIP: {
+ ### check we got the object
+ ok( $tar, "Object created" );
+ isa_ok( $tar, $Class );
- ### skip gz compressed archives wihtout IO::Zlib
- skip( "No IO::Zlib - cannot read compressed archives",
- 4 + 2 * (scalar @EXPECT_NORMAL)
- ) if( $gzip and !$ZLIB);
-
- ### ->read test
- { my @list = $tar->read( $type );
- my $cnt = scalar @list;
- my $expect = scalar __PACKAGE__->get_expect();
-
- ok( $cnt, "Reading $state file using 'read()'" );
- is( $cnt, $expect, " All files accounted for" );
-
- for my $file ( @list ) {
- ok( $file, "Got File object" );
- isa_ok( $file, "Archive::Tar::File" );
-
- ### whitebox test -- make sure find_entry gets the
- ### right files
- for my $test ( $file->full_path, $file ) {
- is( $tar->_find_entry( $test ), $file,
- " Found proper object" );
- }
-
- next unless $file->is_file;
-
- my $name = $file->full_path;
- my($expect_name, $expect_content) =
- get_expect_name_and_contents( $name, \@EXPECT_NORMAL );
+ ### ->read test
+ my @list = $tar->read( $type );
+ my $cnt = scalar @list;
+ my $expect = scalar __PACKAGE__->get_expect();
+
+ ok( $cnt, "Reading '$type' using 'read()'" );
+ is( $cnt, $expect, " All files accounted for" );
+
+ for my $file ( @list ) {
+ ok( $file, " Got File object" );
+ isa_ok( $file, $FClass );
+
+ ### whitebox test -- make sure find_entry gets the
+ ### right files
+ for my $test ( $file->full_path, $file ) {
+ is( $tar->_find_entry( $test ), $file,
+ " Found proper object" );
+ }
- ### ->fullname!
- ok($expect_name," Found expected file '$name'" );
+ next unless $file->is_file;
- like($tar->get_content($name), $expect_content,
- " Content OK" );
- }
- }
+ my $name = $file->full_path;
+ my($expect_name, $expect_content) =
+ get_expect_name_and_contents( $name, \@EXPECT_NORMAL );
+ ### ->fullname!
+ ok($expect_name, " Found expected file '$name'" );
- ### list_archive test
- { my @list = Archive::Tar->list_archive( $archive );
- my $cnt = scalar @list;
- my $expect = scalar __PACKAGE__->get_expect();
-
- ok( $cnt, "Reading $state file using 'list_archive'");
- is( $cnt, $expect, " All files accounted for" );
+ like($tar->get_content($name), $expect_content,
+ " Content OK" );
+ }
- for my $file ( @list ) {
- next if __PACKAGE__->is_dir( $file ); # directories
- my($expect_name, $expect_content) =
- get_expect_name_and_contents( $file, \@EXPECT_NORMAL );
+ ### list_archive test
+ { my @list = $Class->list_archive( $type );
+ my $cnt = scalar @list;
+ my $expect = scalar __PACKAGE__->get_expect();
+
+ ok( $cnt, "Reading '$type' using 'list_archive'");
+ is( $cnt, $expect, " All files accounted for" );
- ok( $expect_name,
- " Found expected file '$file'" );
- }
+ for my $file ( @list ) {
+ next if __PACKAGE__->is_dir( $file ); # directories
+
+ my($expect_name, $expect_content) =
+ get_expect_name_and_contents( $file, \@EXPECT_NORMAL );
+
+ ok( $expect_name,
+ " Found expected file '$file'" );
}
}
-
- ### now we try gz compressed archives
- $gzip++;
}
}
### add files tests ###
{ my @add = map { File::Spec->catfile( @ROOT, @$_ ) } ['b'];
my @addunix = map { File::Spec::Unix->catfile( @ROOT, @$_ ) } ['b'];
- my $tar = Archive::Tar->new;
+ my $tar = $Class->new;
### check we got the object
ok( $tar, "Object created" );
- isa_ok( $tar, 'Archive::Tar');
+ isa_ok( $tar, $Class );
### add the files
{ my @files = $tar->add_files( @add );
is( scalar @files, scalar @add,
- "Adding files");
- is( $files[0]->name, 'b', " Proper name" );
+ " Adding files");
+ is( $files[0]->name,'b', " Proper name" );
SKIP: {
skip( "You are building perl using symlinks", 1)
if ($ENV{PERL_CORE} and $Config{config_args} =~/Dmksymlinks/);
- is( $files[0]->is_file, 1,
- " Proper type" );
+ is( $files[0]->is_file, 1,
+ " Proper type" );
}
like( $files[0]->get_content, qr/^bbbbbbbbbbb\s*$/,
- " Content OK" );
+ " Content OK" );
### check if we have then in our tar object
for my $file ( @addunix ) {
ok( $tar->contains_file($file),
- " File found in archive" );
+ " File found in archive" );
}
}
### check adding files doesn't conflict with a secondary archive
### old A::T bug, we should keep testing for it
- { my $tar2 = Archive::Tar->new;
+ { my $tar2 = $Class->new;
my @added = $tar2->add_files( $COMPRESS_FILE );
my @count = $tar2->list_files;
- is( scalar @added, 1, "Added files to secondary archive" );
+ is( scalar @added, 1, " Added files to secondary archive" );
is( scalar @added, scalar @count,
- " Does not conflict with first archive" );
+ " No conflict with first archive" );
### check the adding of directories
my @add_dirs = File::Spec->catfile( @ROOT );
my @dirs = $tar2->add_files( @add_dirs );
is( scalar @dirs, scalar @add_dirs,
- "Adding dirs");
- ok( $dirs[0]->is_dir, " Proper type" );
+ " Adding dirs");
+ ok( $dirs[0]->is_dir, " Proper type" );
+ }
+
+ ### check if we can add a A::T::File object
+ { my $tar2 = $Class->new;
+ my($added) = $tar2->add_files( $add[0] );
+
+ ok( $added, " Added a file '$add[0]' to new object" );
+ isa_ok( $added, $FClass, " Object" );
+
+ my($added2) = $tar2->add_files( $added );
+ ok( $added2, " Added an $FClass object" );
+ isa_ok( $added2, $FClass, " Object" );
+
+ is_deeply( [$added, $added2], [$tar2->get_files],
+ " All files accounted for" );
+ isnt( $added, $added2, " Different memory allocations" );
}
}
@@ -285,20 +297,20 @@
{
{ ### standard data ###
my @to_add = ( 'a', 'aaaaa' );
- my $tar = Archive::Tar->new;
+ my $tar = $Class->new;
### check we got the object
ok( $tar, "Object created" );
- isa_ok( $tar, 'Archive::Tar');
+ isa_ok( $tar, $Class );
### add a new file item as data
my $obj = $tar->add_data( @to_add );
- ok( $obj, "Adding data" );
- is( $obj->name, $to_add[0], " Proper name" );
- is( $obj->is_file, 1, " Proper type" );
+ ok( $obj, " Adding data" );
+ is( $obj->name, $to_add[0], " Proper name" );
+ is( $obj->is_file, 1, " Proper type" );
like( $obj->get_content, qr/^$to_add[1]\s*$/,
- " Content OK" );
+ " Content OK" );
}
{ ### binary data +
@@ -318,19 +330,19 @@
my $obj = $tar->add_data( $path, $data );
- ok( $obj, "Adding data '$file'" );
+ ok( $obj, " Adding data '$file'" );
is( $obj->full_path, $path,
- " Proper name" );
- ok( $obj->is_file, " Proper type" );
+ " Proper name" );
+ ok( $obj->is_file, " Proper type" );
is( $obj->get_content, $data,
- " Content OK" );
+ " Content OK" );
}
}
}
}
### rename/replace_content tests ###
-{ my $tar = Archive::Tar->new;
+{ my $tar = $Class->new;
my $from = 'c';
my $to = 'e';
@@ -362,13 +374,13 @@
### remove tests ###
{ my $remove = 'c';
- my $tar = Archive::Tar->new;
+ my $tar = $Class->new;
ok( $tar->read( $TAR_FILE ), "Read in '$TAR_FILE'" );
### remove returns the files left, which should be equal to list_files
is( scalar($tar->remove($remove)), scalar($tar->list_files),
- "Removing file '$remove'" );
+ " Removing file '$remove'" );
### so what's left should be all expected files minus 1
is( scalar($tar->list_files), scalar(__PACKAGE__->get_expect) - 1,
@@ -376,12 +388,14 @@
}
### write + read + extract tests ###
-SKIP: {
- skip('no IO::String', 326) if !$Archive::Tar::HAS_PERLIO &&
+SKIP: { ### pesky warnings
+ skip('no IO::String', 326) if !$Archive::Tar::HAS_PERLIO &&
+ !$Archive::Tar::HAS_PERLIO &&
+ !$Archive::Tar::HAS_IO_STRING &&
!$Archive::Tar::HAS_IO_STRING;
-
- my $tar = Archive::Tar->new;
- my $new = Archive::Tar->new;
+
+ my $tar = $Class->new;
+ my $new = $Class->new;
ok( $tar->read( $TAR_FILE ), "Read in '$TAR_FILE'" );
for my $aref ( [$tar, \@EXPECT_NORMAL],
@@ -392,28 +406,33 @@
### check if we stringify it ok
{ my $string = $obj->write;
- ok( $string, "Stringified tar file has size" );
+ ok( $string, " Stringified tar file has size" );
cmp_ok( length($string) % BLOCK, '==', 0,
- "Tar archive stringified" );
+ " Tar archive stringified" );
}
### write tar tests
{ my $out = $OUT_TAR_FILE;
+ ### bug #41798: 'Nonempty $\ when writing a TAR file produces a
+ ### corrupt TAR file' shows that setting $\ breaks writing tar files
+ ### set it here purposely so we can verify NOTHING breaks
+ local $\ = 'FOOBAR';
+
{ ### write()
ok( $obj->write($out),
- "Wrote tarfile using 'write'" );
+ " Wrote tarfile using 'write'" );
check_tar_file( $out );
check_tar_object( $obj, $struct );
### now read it in again
ok( $new->read( $out ),
- "Read '$out' in again" );
+ " Read '$out' in again" );
check_tar_object( $new, $struct );
### now extract it again
- ok( $new->extract, "Extracted '$out' with 'extract'" );
+ ok( $new->extract, " Extracted '$out' with 'extract'" );
check_tar_extract( $new, $struct );
rm( $out ) unless $NO_UNLINK;
@@ -421,63 +440,54 @@
{ ### create_archive()
- ok( Archive::Tar->create_archive( $out, 0, $COMPRESS_FILE ),
- "Wrote tarfile using 'create_archive'" );
+ ok( $Class->create_archive( $out, 0, $COMPRESS_FILE ),
+ " Wrote tarfile using 'create_archive'" );
check_tar_file( $out );
### now extract it again
- ok( Archive::Tar->extract_archive( $out ),
- "Extracted file using 'extract_archive'");
+ ok( $Class->extract_archive( $out ),
+ " Extracted file using 'extract_archive'");
rm( $out ) unless $NO_UNLINK;
}
}
## write tgz tests
- { my $out = $OUT_TGZ_FILE;
-
- SKIP: {
+ { my @out;
+ push @out, [ $OUT_TGZ_FILE => 1 ] if $Class->has_zlib_support;
+ push @out, [ $OUT_TBZ_FILE => COMPRESS_BZIP ] if $Class->has_bzip2_support;
- ### weird errors from scalar(@x,@y,@z), dot it this way...
- my $file_cnt;
- map { $file_cnt += scalar @$_ } \@EXPECT_NORMAL, \@EXPECTBIN,
- \@EXPECTX;
-
- my $cnt = 5 + # the tests below
- (5*3*2) + # check_tgz_file
- # check_tar_object fixed tests
- (3 * 2 * (2 + $file_cnt)) +
- ((4*$file_cnt) + 1);# check_tar_extract tests
+ for my $entry ( @out ) {
- skip( "No IO::Zlib - cannot write compressed archives", $cnt )
- unless $ZLIB;
+ my( $out, $compression ) = @$entry;
{ ### write()
- ok($obj->write($out, 1),
- "Writing compressed file using 'write'" );
- check_tgz_file( $out );
+ ok($obj->write($out, $compression),
+ " Writing compressed file '$out' using 'write'" );
+ check_compressed_file( $out );
+
check_tar_object( $obj, $struct );
### now read it in again
ok( $new->read( $out ),
- "Read '$out' in again" );
+ " Read '$out' in again" );
check_tar_object( $new, $struct );
### now extract it again
ok( $new->extract,
- "Extracted '$out' again" );
+ " Extracted '$out' again" );
check_tar_extract( $new, $struct );
rm( $out ) unless $NO_UNLINK;
}
{ ### create_archive()
- ok( Archive::Tar->create_archive( $out, 1, $COMPRESS_FILE ),
- "Wrote gzip file using 'create_archive'" );
- check_tgz_file( $out );
+ ok( $Class->create_archive( $out, $compression, $COMPRESS_FILE ),
+ " Wrote '$out' using 'create_archive'" );
+ check_compressed_file( $out );
### now extract it again
- ok( Archive::Tar->extract_archive( $out, 1 ),
- "Extracted file using 'extract_archive'");
+ ok( $Class->extract_archive( $out, $compression ),
+ " Extracted file using 'extract_archive'");
rm( $out ) unless $NO_UNLINK;
}
}
@@ -487,7 +497,7 @@
### limited read + extract tests ###
-{ my $tar = Archive::Tar->new;
+{ my $tar = $Class->new;
my @files = $tar->read( $TAR_FILE, 0, { limit => 1 } );
my $obj = $files[0];
@@ -506,8 +516,8 @@
for my $arg ( $obj, $obj->full_path ) {
ok( $tar->$meth( $arg ),
- "Extracted '$name' to cwd() with $meth" );
- ok( -e $obj->full_path, " Extracted file exists" );
+ " Extract '$name' to cwd() with $meth" );
+ ok( -e $obj->full_path, " Extracted file exists" );
rm( $obj->full_path ) unless $NO_UNLINK;
}
}
@@ -519,8 +529,8 @@
my $outfile = File::Spec->catfile( $outpath, $$ ); #$obj->full_path );
ok( $tar->$meth( $obj->full_path, $outfile ),
- "Extracted file '$name' to $outpath with $meth" );
- ok( -e $outfile, " Extracted file '$outfile' exists" );
+ " Extract file '$name' to $outpath with $meth" );
+ ok( -e $outfile, " Extracted file '$outfile' exists" );
rm( $outfile ) unless $NO_UNLINK;
}
@@ -528,7 +538,7 @@
### clear tests ###
-{ my $tar = Archive::Tar->new;
+{ my $tar = $Class->new;
my @files = $tar->read( $TAR_FILE );
my $cnt = $tar->list_files();
@@ -540,7 +550,7 @@
}
### $DO_NOT_USE_PREFIX tests
-{ my $tar = Archive::Tar->new;
+{ my $tar = $Class->new;
### first write a tar file without prefix
@@ -549,14 +559,17 @@
my $file = File::Basename::basename( $COMPRESS_FILE );
ok( $obj, "File added" );
- isa_ok( $obj, "Archive::Tar::File" );
+ isa_ok( $obj, $FClass );
### internal storage ###
is( $obj->name, $file, " Name set to '$file'" );
is( $obj->prefix, $dir, " Prefix set to '$dir'" );
### write the tar file without a prefix in it
+ ### pesky warnings
local $Archive::Tar::DO_NOT_USE_PREFIX = 1;
+ local $Archive::Tar::DO_NOT_USE_PREFIX = 1;
+
ok( $tar->write( $OUT_TAR_FILE ),
" Tar file written" );
@@ -566,18 +579,18 @@
### now read it back in, there should be no prefix
{ ok( $tar->read( $OUT_TAR_FILE ),
- "Tar file read in again" );
+ " Tar file read in again" );
my ($obj) = $tar->get_files;
- ok( $obj, " File retrieved" );
- isa_ok( $obj, "Archive::Tar::File" );
+ ok( $obj, " File retrieved" );
+ isa_ok( $obj, $FClass, " Object" );
is( $obj->name, $COMPRESS_FILE,
- " Name now set to '$COMPRESS_FILE'" );
- is( $obj->prefix, '', " Prefix now empty" );
+ " Name now set to '$COMPRESS_FILE'" );
+ is( $obj->prefix, '', " Prefix now empty" );
my $re = quotemeta $COMPRESS_FILE;
- like( $obj->raw, qr/^$re/, " Prefix + name in name slot of header" );
+ like( $obj->raw, qr/^$re/, " Prefix + name in name slot of header" );
}
rm( $OUT_TAR_FILE ) unless $NO_UNLINK;
@@ -645,10 +658,10 @@
return $contents;
}
-sub check_tgz_file {
+sub check_compressed_file {
my $file = shift;
my $filesize = -s $file;
- my $contents = slurp_gzfile( $file );
+ my $contents = slurp_compressed_file( $file );
my $uncompressedsize = length $contents;
ok( defined( $contents ), " File read and uncompressed" );
@@ -724,22 +737,22 @@
close $fh;
$NO_UNLINK or 1 while unlink $path;
- ### alternate extract path tests
+ ### alternate extract path tests
### to abs and rel paths
{ for my $outpath ( File::Spec->catdir( @ROOT ),
- File::Spec->rel2abs(
+ File::Spec->rel2abs(
File::Spec->catdir( @ROOT )
)
) {
my $outfile = File::Spec->catfile( $outpath, $$ );
-
+
ok( $tar->extract_file( $file->full_path, $outfile ),
" Extracted file '$path' to $outfile" );
ok( -e $outfile," Extracted file '$outfile' exists" );
-
+
rm( $outfile ) unless $NO_UNLINK;
- }
+ }
}
}
@@ -762,18 +775,29 @@
return <$fh>;
}
-sub slurp_gzfile {
+sub slurp_compressed_file {
my $file = shift;
- my $str;
- my $buff;
+ my $fh;
- require IO::Zlib;
- my $fh = new IO::Zlib;
- $fh->open( $file, READ_ONLY->(1) )
- or warn( "Error opening '$file' with IO::Zlib" ), return undef;
+ ### bzip2
+ if( $file =~ /.tbz$/ ) {
+ require IO::Uncompress::Bunzip2;
+ $fh = IO::Uncompress::Bunzip2->new( $file )
+ or warn( "Error opening '$file' with IO::Uncompress::Bunzip2" ), return
+ ### gzip
+ } else {
+ require IO::Zlib;
+ $fh = new IO::Zlib;
+ $fh->open( $file, READ_ONLY->(1) )
+ or warn( "Error opening '$file' with IO::Zlib" ), return
+ }
+
+ my $str;
+ my $buff;
$str .= $buff while $fh->read( $buff, 4096 ) > 0;
$fh->close();
+
return $str;
}
diff -urN perl-5.10.0.orig/lib/Archive/Tar/t/04_resolved_issues.t perl-5.10.0/lib/Archive/Tar/t/04_resolved_issues.t
--- perl-5.10.0.orig/lib/Archive/Tar/t/04_resolved_issues.t 2009-02-20 11:21:14.000000000 +0100
+++ perl-5.10.0/lib/Archive/Tar/t/04_resolved_issues.t 2009-03-05 15:13:09.000000000 +0100
@@ -113,7 +113,7 @@
### absolute paths are already taken care of. Only relative paths
### matter
my $in_file = basename($0);
- my $out_file = '../' . $in_file . ".$$";
+ my $out_file = '../' . $in_file . "_$$";
ok( $tar->add_files( $in_file ),
" Added '$in_file'" );
@@ -121,7 +121,6 @@
" Renamed to '$out_file'" );
### first, test with strict extract permissions on
-TODO:
{ local $Archive::Tar::INSECURE_EXTRACT_MODE = 0;
### we quell the error on STDERR
@@ -135,20 +134,14 @@
ok( ! -e $out_file, " File '$out_file' does not exist" );
ok( $tar->error, " Error message stored" );
-
- local $TODO = 'Exposed unrelated filespec handling bugs on VMS' if $^O eq 'VMS';
-
like( $tar->error, qr/attempting to leave/,
" Proper violation detected" );
}
### now disable those
-TODO:
{ local $Archive::Tar::INSECURE_EXTRACT_MODE = 1;
ok( 1, " Extracting in insecure mode" );
- local $TODO = 'Exposed unrelated filespec handling bugs on VMS' if $^O eq 'VMS';
-
ok( $tar->extract_file( $out_file ),
" File extracted" );
ok( -e $out_file, " File '$out_file' exists" );
@@ -156,6 +149,21 @@
### and clean up
unless( $NO_UNLINK ) { 1 while unlink $out_file };
}
-
+}
+### bug #43513: [PATCH] Accept wrong checksums from SunOS and HP-UX tar
+### like GNU tar does. See here for details:
+### http://www.gnu.org/software/tar/manual/tar.html#SEC139
+{ ok( 1, "Testing bug 43513" );
+
+ my $src = File::Spec->catfile( qw[src header signed.tar] );
+ my $tar = $Class->new;
+
+ isa_ok( $tar, $Class, " Object" );
+ ok( $tar->read( $src ), " Read non-Posix file with signed Checksum" );
+
+ for my $file ( $tar->get_files ) {
+ ok( $file, " File object retrieved" );
+ ok( $file->validate, " File validates" );
+ }
}
diff -urN perl-5.10.0.orig/lib/Archive/Tar/t/05_iter.t perl-5.10.0/lib/Archive/Tar/t/05_iter.t
--- perl-5.10.0.orig/lib/Archive/Tar/t/05_iter.t 1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/lib/Archive/Tar/t/05_iter.t 2009-03-11 17:11:27.000000000 +0100
@@ -0,0 +1,65 @@
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir '../lib/Archive/Tar' if -d '../lib/Archive/Tar';
+ }
+ use lib '../../..';
+}
+
+BEGIN { chdir 't' if -d 't' }
+
+use Test::More 'no_plan';
+use strict;
+use lib '../lib';
+
+my $Class = 'Archive::Tar';
+my $FClass = 'Archive::Tar::File';
+my $File = 'src/long/bar.tar';
+my @Expect = (
+ qr|^c$|,
+ qr|^d$|,
+ qr|^directory/$|,
+ qr|^directory/really.*name/$|,
+ qr|^directory/.*/myfile$|,
+);
+
+use_ok( $Class );
+
+### crazy ref to special case 'all'
+for my $index ( \0, 0 .. $#Expect ) {
+
+ my %opts = ();
+ my @expect = ();
+
+ ### do a full test vs individual filters
+ if( not ref $index ) {
+ my $regex = $Expect[$index];
+ $opts{'filter'} = $regex;
+ @expect = ($regex);
+ } else {
+ @expect = @Expect;
+ }
+
+ my $next = $Class->iter( $File, 0, \%opts );
+
+ my $pp_opts = join " => ", %opts;
+ ok( $next, "Iterator created from $File ($pp_opts)" );
+ isa_ok( $next, "CODE", " Iterator" );
+
+ my @names;
+ while( my $f = $next->() ) {
+ ok( $f, " File object retrieved" );
+ isa_ok( $f, $FClass, " Object" );
+
+ push @names, $f->name;
+ }
+
+ is( scalar(@names), scalar(@expect),
+ " Found correct number of files" );
+
+ my $i = 0;
+ for my $name ( @names ) {
+ ok( 1, " Inspecting '$name' " );
+ like($name, $expect[$i]," Matches $Expect[$i]" );
+ $i++;
+ }
+}
diff -urN perl-5.10.0.orig/lib/Archive/Tar/t/90_symlink.t perl-5.10.0/lib/Archive/Tar/t/90_symlink.t
--- perl-5.10.0.orig/lib/Archive/Tar/t/90_symlink.t 1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/lib/Archive/Tar/t/90_symlink.t 2009-03-11 17:11:27.000000000 +0100
@@ -0,0 +1,62 @@
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir '../lib/Archive/Tar' if -d '../lib/Archive/Tar';
+ }
+ use lib '../../..';
+}
+
+BEGIN { chdir 't' if -d 't' }
+
+use lib '../lib';
+
+use strict;
+use File::Spec;
+use File::Path;
+use Test::More;
+
+### developer tests mostly, so enable them with an extra argument
+plan skip_all => "Skipping tests on this platform" unless @ARGV;
+plan 'no_plan';
+
+my $Class = 'Archive::Tar';
+my $Dir = File::Spec->catdir( qw[src linktest] );
+my %Map = (
+ File::Spec->catfile( $Dir, "linktest_with_dir.tar" ) => [
+ [ 0, qr/SECURE EXTRACT MODE/ ],
+ [ 1, qr/^$/ ]
+ ],
+ File::Spec->catfile( $Dir, "linktest_missing_dir.tar" ) => [
+ [ 0, qr/SECURE EXTRACT MODE/ ],
+ [ 0, qr/File exists/ ],
+ ],
+);
+
+use_ok( $Class );
+
+{ while( my($file, $aref) = each %Map ) {
+
+ for my $mode ( 0, 1 ) {
+ my $expect = $aref->[$mode]->[0];
+ my $regex = $aref->[$mode]->[1];
+
+ my $tar = $Class->new( $file );
+ ok( $tar, "Object created from $file" );
+
+ ### damn warnings
+ local $Archive::Tar::INSECURE_EXTRACT_MODE = $mode;
+ local $Archive::Tar::INSECURE_EXTRACT_MODE = $mode;
+
+ ok( 1, " Extracting with insecure mode: $mode" );
+
+ my $warning;
+ local $SIG{__WARN__} = sub { $warning .= "@_"; warn @_; };
+
+ my $rv = eval { $tar->extract } || 0;
+ ok( !$@, " No fatal error" );
+ is( !!$rv, !!$expect, " RV as expected" );
+ like( $warning, $regex, " Error matches $regex" );
+
+ rmtree( 'linktest' );
+ }
+ }
+}
diff -urN perl-5.10.0.orig/lib/Archive/Tar/t/src/header/signed.tar.packed perl-5.10.0/lib/Archive/Tar/t/src/header/signed.tar.packed
--- perl-5.10.0.orig/lib/Archive/Tar/t/src/header/signed.tar.packed 1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/lib/Archive/Tar/t/src/header/signed.tar.packed 2009-03-11 17:11:27.000000000 +0100
@@ -0,0 +1,243 @@
+#########################################################################
+This is a binary file that was packed with the 'uupacktool.pl' which
+is included in the Perl distribution.
+
+To unpack this file use the following command:
+
+ uupacktool.pl -u lib/Archive/Tar/t/src/header/signed.tar.packed lib/Archive/Tar/t/src/header/signed.tar
+
+To recreate it use the following command:
+
+ uupacktool.pl -p lib/Archive/Tar/t/src/header/signed.tar lib/Archive/Tar/t/src/header/signed.tar.packed
+
+Created at Fri Mar 6 17:03:40 2009
+#########################################################################
+__UU__
+MPZ3#I,.D````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M`````````````#`P,#8P,"``,3,S-#8W(``P,C,T,C`@`#`P,#`P,#`P,#`U
+M(#$Q,34P,S(V-#(R(#`Q,#0V,2``,```````````````````````````````
+M````````````````````````````````````````````````````````````
+M``````````````````````````````````````````!U<W1A<@`P,&YT>6YI
+M````````````````````````````````````871K;W,`````````````````
+M```````````````````P,#`P,#`@`#`P,#`P,"``````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M``````````````````````!T97-T"@``````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+9````````````````````````````````````
diff -urN perl-5.10.0.orig/lib/Archive/Tar/t/src/linktest/linktest_missing_dir.tar.packed perl-5.10.0/lib/Archive/Tar/t/src/linktest/linktest_missing_dir.tar.packed
--- perl-5.10.0.orig/lib/Archive/Tar/t/src/linktest/linktest_missing_dir.tar.packed 1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/lib/Archive/Tar/t/src/linktest/linktest_missing_dir.tar.packed 2009-03-11 17:11:27.000000000 +0100
@@ -0,0 +1,243 @@
+#########################################################################
+This is a binary file that was packed with the 'uupacktool.pl' which
+is included in the Perl distribution.
+
+To unpack this file use the following command:
+
+ uupacktool.pl -u lib/Archive/Tar/t/src/linktest/linktest_missing_dir.tar.packed lib/Archive/Tar/t/src/linktest/linktest_missing_dir.tar
+
+To recreate it use the following command:
+
+ uupacktool.pl -p lib/Archive/Tar/t/src/linktest/linktest_missing_dir.tar lib/Archive/Tar/t/src/linktest/linktest_missing_dir.tar.packed
+
+Created at Thu Feb 19 16:44:52 2009
+#########################################################################
+__UU__
+M;&EN:W1E<W0O;&EN:P``````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M`````````````#`P,#`W-34`,#`P,#<V-0`P,#`P,#`P`#`P,#`P,#`P,#`P
+M`#$Q,#4S-34T-S4P`#`Q,S(U,``@,F]R:6<`````````````````````````
+M````````````````````````````````````````````````````````````
+M``````````````````````````````````````````!U<W1A<B`@`&MA;F4`
+M````````````````````````````````````=VAE96P`````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M``````````````````````!L:6YK=&5S="]L:6YK+W@`````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````,#`P,#8T-``P,#`P-S8U`#`P
+M,#`P,#``,#`P,#`P,#`P,#``,3$P-3,U-30W,38`,#$R-C,S`"`P````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M`````'5S=&%R("``:V%N90````````````````````````````````````!W
+M:&5E;```````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+9````````````````````````````````````
diff -urN perl-5.10.0.orig/lib/Archive/Tar/t/src/linktest/linktest_with_dir.tar.packed perl-5.10.0/lib/Archive/Tar/t/src/linktest/linktest_with_dir.tar.packed
--- perl-5.10.0.orig/lib/Archive/Tar/t/src/linktest/linktest_with_dir.tar.packed 1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/lib/Archive/Tar/t/src/linktest/linktest_with_dir.tar.packed 2009-03-11 17:11:27.000000000 +0100
@@ -0,0 +1,232 @@
+#########################################################################
+This is a binary file that was packed with the 'uupacktool.pl' which
+is included in the Perl distribution.
+
+To unpack this file use the following command:
+
+ uupacktool.pl -u lib/Archive/Tar/t/src/linktest/linktest_with_dir.tar.packed lib/Archive/Tar/t/src/linktest/linktest_with_dir.tar
+
+To recreate it use the following command:
+
+ uupacktool.pl -p lib/Archive/Tar/t/src/linktest/linktest_with_dir.tar lib/Archive/Tar/t/src/linktest/linktest_with_dir.tar.packed
+
+Created at Thu Feb 19 16:44:52 2009
+#########################################################################
+__UU__
+M;&EN:W1E<W0O;W)I9R\`````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M`````````````#`P,#`W-34`,#`P,#<V-0`P,#`P,#`P`#`P,#`P,#`P,#`P
+M`#$Q,#4S-34T-S$V`#`Q,C0U-@`@-0``````````````````````````````
+M````````````````````````````````````````````````````````````
+M``````````````````````````````````````````!U<W1A<B`@`&MA;F4`
+M````````````````````````````````````=VAE96P`````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M``````````````````````!L:6YK=&5S="]L:6YK````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````,#`P,#<U-0`P,#`P-S8U`#`P
+M,#`P,#``,#`P,#`P,#`P,#``,3$P-3,U-30W-3``,#$S,C4P`"`R;W)I9P``
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M`````'5S=&%R("``:V%N90````````````````````````````````````!W
+M:&5E;```````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M`````````````````````````````````````````````&QI;FMT97-T+VQI
+M;FLO>```````````````````````````````````````````````````````
+M```````````````````````````````````````````````````````````P
+M,#`P-C0T`#`P,#`W-C4`,#`P,#`P,``P,#`P,#`P,#`P,``Q,3`U,S4U-#<Q
+M-@`P,3(V,S,`(#``````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````=7-T87(@(`!K86YE````````````````
+M`````````````````````'=H965L````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+)```````````*
diff -urN perl-5.10.0.orig/lib/Archive/Tar/t/src/long/foo.tbz.packed perl-5.10.0/lib/Archive/Tar/t/src/long/foo.tbz.packed
--- perl-5.10.0.orig/lib/Archive/Tar/t/src/long/foo.tbz.packed 1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/lib/Archive/Tar/t/src/long/foo.tbz.packed 2009-03-11 17:11:27.000000000 +0100
@@ -0,0 +1,23 @@
+#########################################################################
+This is a binary file that was packed with the 'uupacktool.pl' which
+is included in the Perl distribution.
+
+To unpack this file use the following command:
+
+ uupacktool.pl -u lib/Archive/Tar/t/src/long/foo.tbz.packed lib/Archive/Tar/t/src/long/foo.tbz
+
+To recreate it use the following command:
+
+ uupacktool.pl -p lib/Archive/Tar/t/src/long/foo.tbz lib/Archive/Tar/t/src/long/foo.tbz.packed
+
+Created at Thu Feb 19 16:05:47 2009
+#########################################################################
+__UU__
+M0EIH.3%!62936=873NT``9C_A._0`DA``_^`0`0)`._OGJ```40(,`%X9`8`
+M::-!IB```!D`)28FI````````(HE,F%3RF3R8FIM/5&F#33(>IZID>"="?4U
+M>/C^S:X'D<2&UOMUE`"-`(N%MQA29*3$)UC1X82:*B,-Q7FMI2DVI<#P6%65
+M/B$/:G=OYT0SKT65Y'T()B;2=WF$2%CLTJ.KTD0;Q.)"/81[2R\B9=]9)23.
+M1F@@IS0Q030J3;>[221,'HFJ3WH0M`Y#.TI(I@%<RH/$AH8>R26=14&*"&"L
+M1PD0,HZH$-!#H2`UEQL.14#Z)L$$^3U2B\,R_?,RZ<_X7)YXG^04Q+R/=,4\
+MK`R+N+%?P?2UFQ+S267E(`$I^B`!)-]"4Y!65-QU&U:BM<X`V$"L%BW%2XIS
+<63('[6F2P:JS\FD@5"$VW*O_%W)%.%"0UA=.[0``
diff -urN perl-5.10.0.orig/lib/Archive/Tar/t/src/short/foo.tbz.packed perl-5.10.0/lib/Archive/Tar/t/src/short/foo.tbz.packed
--- perl-5.10.0.orig/lib/Archive/Tar/t/src/short/foo.tbz.packed 1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/lib/Archive/Tar/t/src/short/foo.tbz.packed 2009-03-11 17:11:28.000000000 +0100
@@ -0,0 +1,19 @@
+#########################################################################
+This is a binary file that was packed with the 'uupacktool.pl' which
+is included in the Perl distribution.
+
+To unpack this file use the following command:
+
+ uupacktool.pl -u lib/Archive/Tar/t/src/short/foo.tbz.packed lib/Archive/Tar/t/src/short/foo.tbz
+
+To recreate it use the following command:
+
+ uupacktool.pl -p lib/Archive/Tar/t/src/short/foo.tbz lib/Archive/Tar/t/src/short/foo.tbz.packed
+
+Created at Thu Feb 19 16:05:52 2009
+#########################################################################
+__UU__
+M0EIH.3%!62936>GH,8X``)O[A.90`D!``'^```#O*1X```%`""``E(*JGDA#
+M1H#0Q&F@)%1J8C3$Q,T3`U)1(QL-#P5L`'2A)$,<1C&7N<@%XQ(2UAGTYV56
+MM$I>-BHHJN(9*$J286."<%>*U,.3%6B$*2E6R+DH-6B&?[5DZ(J7DG#H_$@<
+/AE%`D'\7<D4X4)#IZ#&.
diff -urN perl-5.10.0.orig/lib/Archive/Tar.pm perl-5.10.0/lib/Archive/Tar.pm
--- perl-5.10.0.orig/lib/Archive/Tar.pm 2009-02-20 11:21:14.000000000 +0100
+++ perl-5.10.0/lib/Archive/Tar.pm 2009-03-11 17:13:04.000000000 +0100
@@ -7,16 +7,31 @@
package Archive::Tar;
require 5.005_03;
+use Cwd;
+use IO::Zlib;
+use IO::File;
+use Carp qw(carp croak);
+use File::Spec ();
+use File::Spec::Unix ();
+use File::Path ();
+
+use Archive::Tar::File;
+use Archive::Tar::Constant;
+
+require Exporter;
+
use strict;
use vars qw[$DEBUG $error $VERSION $WARN $FOLLOW_SYMLINK $CHOWN $CHMOD
$DO_NOT_USE_PREFIX $HAS_PERLIO $HAS_IO_STRING
- $INSECURE_EXTRACT_MODE
+ $INSECURE_EXTRACT_MODE @ISA @EXPORT
];
+@ISA = qw[Exporter];
+@EXPORT = qw[ COMPRESS_GZIP COMPRESS_BZIP ];
$DEBUG = 0;
$WARN = 1;
$FOLLOW_SYMLINK = 0;
-$VERSION = "1.38";
+$VERSION = "1.46";
$CHOWN = 1;
$CHMOD = 1;
$DO_NOT_USE_PREFIX = 0;
@@ -28,24 +43,13 @@
### try and load IO::String anyway, so you can dynamically
### switch between perlio and IO::String
- eval {
+ $HAS_IO_STRING = eval {
require IO::String;
import IO::String;
- };
- $HAS_IO_STRING = $@ ? 0 : 1;
-
+ 1;
+ } || 0;
}
-use Cwd;
-use IO::File;
-use Carp qw(carp croak);
-use File::Spec ();
-use File::Spec::Unix ();
-use File::Path ();
-
-use Archive::Tar::File;
-use Archive::Tar::Constant;
-
=head1 NAME
Archive::Tar - module for manipulations of tar archives
@@ -55,7 +59,7 @@
use Archive::Tar;
my $tar = Archive::Tar->new;
- $tar->read('origin.tgz',1);
+ $tar->read('origin.tgz');
$tar->extract();
$tar->add_files('file/foo.pl', 'docs/README');
@@ -63,7 +67,9 @@
$tar->rename('oldname', 'new/file/name');
- $tar->write('files.tar');
+ $tar->write('files.tar'); # plain tar
+ $tar->write('files.tgz', COMPRESS_GZIP); # gzip compressed
+ $tar->write('files.tbz', COMPRESS_BZIP); # bzip2 compressed
=head1 DESCRIPTION
@@ -122,23 +128,25 @@
return $obj;
}
-=head2 $tar->read ( $filename|$handle, $compressed, {opt => 'val'} )
+=head2 $tar->read ( $filename|$handle, [$compressed, {opt => 'val'}] )
Read the given tar file into memory.
The first argument can either be the name of a file or a reference to
an already open filehandle (or an IO::Zlib object if it's compressed)
-The second argument indicates whether the file referenced by the first
-argument is compressed.
The C<read> will I<replace> any previous content in C<$tar>!
-The second argument may be considered optional if IO::Zlib is
-installed, since it will transparently Do The Right Thing.
-Archive::Tar will warn if you try to pass a compressed file if
-IO::Zlib is not available and simply return.
+The second argument may be considered optional, but remains for
+backwards compatibility. Archive::Tar now looks at the file
+magic to determine what class should be used to open the file
+and will transparently Do The Right Thing.
+
+Archive::Tar will warn if you try to pass a bzip2 compressed file and the
+IO::Zlib / IO::Uncompress::Bunzip2 modules are not available and simply return.
Note that you can currently B<not> pass a C<gzip> compressed
-filehandle, which is not opened with C<IO::Zlib>, nor a string
+filehandle, which is not opened with C<IO::Zlib>, a C<bzip2> compressed
+filehandle, which is not opened with C<IO::Uncompress::Bunzip2>, nor a string
containing the full archive information (either compressed or
uncompressed). These are worth while features, but not currently
implemented. See the C<TODO> section.
@@ -153,12 +161,18 @@
Do not read more than C<limit> files. This is useful if you have
very big archives, and are only interested in the first few files.
+=item filter
+
+Can be set to a regular expression. Only files with names that match
+the expression will be read.
+
=item extract
If set to true, immediately extract entries when reading them. This
gives you the same memory break as the C<extract_archive> function.
Note however that entries will not be read into memory, but written
-straight to disk.
+straight to disk. This means no C<Archive::Tar::File> objects are
+created for you to inspect.
=back
@@ -194,49 +208,97 @@
}
sub _get_handle {
- my $self = shift;
- my $file = shift; return unless defined $file;
- return $file if ref $file;
+ my $self = shift;
+ my $file = shift; return unless defined $file;
+ return $file if ref $file;
+ my $compress = shift || 0;
+ my $mode = shift || READ_ONLY->( ZLIB ); # default to read only
- my $gzip = shift || 0;
- my $mode = shift || READ_ONLY->( ZLIB ); # default to read only
- my $fh; my $bin;
+ ### get a FH opened to the right class, so we can use it transparently
+ ### throughout the program
+ my $fh;
+ { ### reading magic only makes sense if we're opening a file for
+ ### reading. otherwise, just use what the user requested.
+ my $magic = '';
+ if( MODE_READ->($mode) ) {
+ open my $tmp, $file or do {
+ $self->_error( qq[Could not open '$file' for reading: $!] );
+ return;
+ };
- ### only default to ZLIB if we're not trying to /write/ to a handle ###
- if( ZLIB and $gzip || MODE_READ->( $mode ) ) {
+ ### read the first 4 bites of the file to figure out which class to
+ ### use to open the file.
+ sysread( $tmp, $magic, 4 );
+ close $tmp;
+ }
- ### IO::Zlib will Do The Right Thing, even when passed
- ### a plain file ###
- $fh = new IO::Zlib;
+ ### is it bzip?
+ ### if you asked specifically for bzip compression, or if we're in
+ ### read mode and the magic numbers add up, use bzip
+ if( BZIP and (
+ ($compress eq COMPRESS_BZIP) or
+ ( MODE_READ->($mode) and $magic =~ BZIP_MAGIC_NUM )
+ )
+ ) {
- } else {
- if( $gzip ) {
- $self->_error(qq[Compression not available - Install IO::Zlib!]);
- return;
+ ### different reader/writer modules, different error vars... sigh
+ if( MODE_READ->($mode) ) {
+ $fh = IO::Uncompress::Bunzip2->new( $file ) or do {
+ $self->_error( qq[Could not read '$file': ] .
+ $IO::Uncompress::Bunzip2::Bunzip2Error
+ );
+ return;
+ };
+
+ } else {
+ $fh = IO::Compress::Bzip2->new( $file ) or do {
+ $self->_error( qq[Could not write to '$file': ] .
+ $IO::Compress::Bzip2::Bzip2Error
+ );
+ return;
+ };
+ }
+ ### is it gzip?
+ ### if you asked for compression, if you wanted to read or the gzip
+ ### magic number is present (redundant with read)
+ } elsif( ZLIB and (
+ $compress or MODE_READ->($mode) or $magic =~ GZIP_MAGIC_NUM
+ )
+ ) {
+ $fh = IO::Zlib->new;
+
+ unless( $fh->open( $file, $mode ) ) {
+ $self->_error(qq[Could not create filehandle for '$file': $!]);
+ return;
+ }
+
+ ### is it plain tar?
} else {
- $fh = new IO::File;
- $bin++;
- }
- }
+ $fh = IO::File->new;
- unless( $fh->open( $file, $mode ) ) {
- $self->_error( qq[Could not create filehandle for '$file': $!!] );
- return;
- }
+ unless( $fh->open( $file, $mode ) ) {
+ $self->_error(qq[Could not create filehandle for '$file': $!]);
+ return;
+ }
- binmode $fh if $bin;
+ ### enable bin mode on tar archives
+ binmode $fh;
+ }
+ }
return $fh;
}
+
sub _read_tar {
my $self = shift;
my $handle = shift or return;
my $opts = shift || {};
my $count = $opts->{limit} || 0;
+ my $filter = $opts->{filter};
my $extract = $opts->{extract} || 0;
### set a cap on the amount of files to extract ###
@@ -289,9 +351,9 @@
my $entry;
{ my %extra_args = ();
$extra_args{'name'} = $$real_name if defined $real_name;
-
- unless( $entry = Archive::Tar::File->new( chunk => $chunk,
- %extra_args )
+
+ unless( $entry = Archive::Tar::File->new( chunk => $chunk,
+ %extra_args )
) {
$self->_error( qq[Couldn't read chunk at offset $offset] );
next LOOP;
@@ -372,6 +434,17 @@
undef $real_name;
}
+ ### skip this entry if we're filtering
+ if ($filter && $entry->name !~ $filter) {
+ next LOOP;
+
+ ### skip this entry if it's a pax header. This is a special file added
+ ### by, among others, git-generated tarballs. It holds comments and is
+ ### not meant for extracting. See #38932: pax_global_header extracted
+ } elsif ( $entry->name eq PAX_HEADER ) {
+ next LOOP;
+ }
+
$self->_extract_file( $entry ) if $extract
&& !$entry->is_longlink
&& !$entry->is_unknown
@@ -410,7 +483,7 @@
sub contains_file {
my $self = shift;
my $full = shift;
-
+
return unless defined $full;
### don't warn if the entry isn't there.. that's what this function
@@ -449,7 +522,7 @@
### you requested the extraction of only certian files
if( @args ) {
for my $file ( @args ) {
-
+
### it's already an object?
if( UNIVERSAL::isa( $file, 'Archive::Tar::File' ) ) {
push @files, $file;
@@ -457,18 +530,18 @@
### go find it then
} else {
-
+
my $found;
for my $entry ( @{$self->_data} ) {
next unless $file eq $entry->full_path;
-
+
### we found the file you're looking for
push @files, $entry;
$found++;
}
-
+
unless( $found ) {
- return $self->_error(
+ return $self->_error(
qq[Could not find '$file' in archive] );
}
}
@@ -544,56 +617,92 @@
my $dir;
### is $name an absolute path? ###
- if( File::Spec->file_name_is_absolute( $dirs ) ) {
+ if( $vol || File::Spec->file_name_is_absolute( $dirs ) ) {
### absolute names are not allowed to be in tarballs under
### strict mode, so only allow it if a user tells us to do it
if( not defined $alt and not $INSECURE_EXTRACT_MODE ) {
- $self->_error(
+ $self->_error(
q[Entry ']. $entry->full_path .q[' is an absolute path. ].
q[Not extracting absolute paths under SECURE EXTRACT MODE]
- );
+ );
return;
}
-
+
### user asked us to, it's fine.
- $dir = $dirs;
+ $dir = File::Spec->catpath( $vol, $dirs, "" );
### it's a relative path ###
} else {
- my $cwd = (defined $self->{cwd} ? $self->{cwd} : cwd());
+ my $cwd = (ref $self and defined $self->{cwd})
+ ? $self->{cwd}
+ : cwd();
my @dirs = defined $alt
? File::Spec->splitdir( $dirs ) # It's a local-OS path
: File::Spec::Unix->splitdir( $dirs ); # it's UNIX-style, likely
# straight from the tarball
- ### paths that leave the current directory are not allowed under
- ### strict mode, so only allow it if a user tells us to do this.
- if( not defined $alt and
- not $INSECURE_EXTRACT_MODE and
- grep { $_ eq '..' } @dirs
+ if( not defined $alt and
+ not $INSECURE_EXTRACT_MODE
) {
- $self->_error(
- q[Entry ']. $entry->full_path .q[' is attempting to leave the ].
- q[current working directory. Not extracting under SECURE ].
- q[EXTRACT MODE]
- );
- return;
- }
-
- ### '.' is the directory delimiter, of which the first one has to
- ### be escaped/changed.
- map tr/\./_/, @dirs if ON_VMS;
- my ($cwd_vol,$cwd_dir,$cwd_file)
+ ### paths that leave the current directory are not allowed under
+ ### strict mode, so only allow it if a user tells us to do this.
+ if( grep { $_ eq '..' } @dirs ) {
+
+ $self->_error(
+ q[Entry ']. $entry->full_path .q[' is attempting to leave ].
+ q[the current working directory. Not extracting under ].
+ q[SECURE EXTRACT MODE]
+ );
+ return;
+ }
+
+ ### the archive may be asking us to extract into a symlink. This
+ ### is not sane and a possible security issue, as outlined here:
+ ### https://rt.cpan.org/Ticket/Display.html?id=30380
+ ### https://bugzilla.redhat.com/show_bug.cgi?id=295021
+ ### https://issues.rpath.com/browse/RPL-1716
+ my $full_path = $cwd;
+ for my $d ( @dirs ) {
+ $full_path = File::Spec->catdir( $full_path, $d );
+
+ ### we've already checked this one, and it's safe. Move on.
+ next if ref $self and $self->{_link_cache}->{$full_path};
+
+ if( -l $full_path ) {
+ my $to = readlink $full_path;
+ my $diag = "symlinked directory ($full_path => $to)";
+
+ $self->_error(
+ q[Entry ']. $entry->full_path .q[' is attempting to ].
+ qq[extract to a $diag. This is considered a security ].
+ q[vulnerability and not allowed under SECURE EXTRACT ].
+ q[MODE]
+ );
+ return;
+ }
+
+ ### XXX keep a cache if possible, so the stats become cheaper:
+ $self->{_link_cache}->{$full_path} = 1 if ref $self;
+ }
+ }
+
+ ### '.' is the directory delimiter on VMS, which has to be escaped
+ ### or changed to '_' on vms. vmsify is used, because older versions
+ ### of vmspath do not handle this properly.
+ ### Must not add a '/' to an empty directory though.
+ map { length() ? VMS::Filespec::vmsify($_.'/') : $_ } @dirs if ON_VMS;
+
+ my ($cwd_vol,$cwd_dir,$cwd_file)
= File::Spec->splitpath( $cwd );
my @cwd = File::Spec->splitdir( $cwd_dir );
push @cwd, $cwd_file if length $cwd_file;
### We need to pass '' as the last elemant to catpath. Craig Berry
### explains why (msgid <p0624083dc311ae541393@[172.16.52.1]>):
- ### The root problem is that splitpath on UNIX always returns the
+ ### The root problem is that splitpath on UNIX always returns the
### final path element as a file even if it is a directory, and of
### course there is no way it can know the difference without checking
### against the filesystem, which it is documented as not doing. When
@@ -602,11 +711,12 @@
### know the result should be a directory. I had thought you could omit
### the file argument to catpath in such a case, but apparently on UNIX
### you can't.
- $dir = File::Spec->catpath(
- $cwd_vol, File::Spec->catdir( @cwd, @dirs ), ''
+ $dir = File::Spec->catpath(
+ $cwd_vol, File::Spec->catdir( @cwd, @dirs ), ''
);
- ### catdir() returns undef if the path is longer than 255 chars on VMS
+ ### catdir() returns undef if the path is longer than 255 chars on
+ ### older VMS systems.
unless ( defined $dir ) {
$^W && $self->_error( qq[Could not compose a path for '$dirs'\n] );
return;
@@ -622,10 +732,11 @@
unless ( -d _ ) {
eval { File::Path::mkpath( $dir, 0, 0777 ) };
if( $@ ) {
- $self->_error( qq[Could not create directory '$dir': $@] );
+ my $fp = $entry->full_path;
+ $self->_error(qq[Could not create directory '$dir' for '$fp': $@]);
return;
}
-
+
### XXX chown here? that might not be the same as in the archive
### as we're only chown'ing to the owner of the file we're extracting
### not to the owner of the directory itself, which may or may not
@@ -672,10 +783,15 @@
$self->_make_special_file( $entry, $full ) or return;
}
- utime time, $entry->mtime - TIME_OFFSET, $full or
- $self->_error( qq[Could not update timestamp] );
+ ### only update the timestamp if it's not a symlink; that will change the
+ ### timestamp of the original. This addresses bug #33669: Could not update
+ ### timestamp warning on symlinks
+ if( not -l $full ) {
+ utime time, $entry->mtime - TIME_OFFSET, $full or
+ $self->_error( qq[Could not update timestamp] );
+ }
- if( $CHOWN && CAN_CHOWN ) {
+ if( $CHOWN && CAN_CHOWN->() ) {
chown $entry->uid, $entry->gid, $full or
$self->_error( qq[Could not set uid/gid on '$full'] );
}
@@ -707,8 +823,8 @@
or $fail++;
}
- $err = qq[Making symbolink link from '] . $entry->linkname .
- qq[' to '$file' failed] if $fail;
+ $err = qq[Making symbolic link '$file' to '] .
+ $entry->linkname .q[' failed] if $fail;
} elsif ( $entry->is_hardlink ) {
my $fail;
@@ -949,17 +1065,23 @@
Write the in-memory archive to disk. The first argument can either
be the name of a file or a reference to an already open filehandle (a
-GLOB reference). If the second argument is true, the module will use
-IO::Zlib to write the file in a compressed format. If IO::Zlib is
-not available, the C<write> method will fail and return.
+GLOB reference).
+
+The second argument is used to indicate compression. You can either
+compress using C<gzip> or C<bzip2>. If you pass a digit, it's assumed
+to be the C<gzip> compression level (between 1 and 9), but the use of
+constants is prefered:
+
+ # write a gzip compressed file
+ $tar->write( 'out.tgz', COMPRESS_GZIP );
+
+ # write a bzip compressed file
+ $tar->write( 'out.tbz', COMPRESS_BZIP );
Note that when you pass in a filehandle, the compression argument
is ignored, as all files are printed verbatim to your filehandle.
If you wish to enable compression with filehandles, use an
-C<IO::Zlib> filehandle instead.
-
-Specific levels of compression can be chosen by passing the values 2
-through 9 as the second parameter.
+C<IO::Zlib> or C<IO::Compress::Bzip2> filehandle instead.
The third argument is an optional prefix. All files will be tucked
away in the directory you specify as prefix. So if you have files
@@ -970,6 +1092,7 @@
archive as a string, which could be useful if you'd like to stuff the
archive into a socket or a pipe to gzip or something.
+
=cut
sub write {
@@ -978,16 +1101,19 @@
my $gzip = shift || 0;
my $ext_prefix = shift; $ext_prefix = '' unless defined $ext_prefix;
my $dummy = '';
-
+
### only need a handle if we have a file to print to ###
my $handle = length($file)
? ( $self->_get_handle($file, $gzip, WRITE_ONLY->($gzip) )
or return )
: $HAS_PERLIO ? do { open my $h, '>', \$dummy; $h }
- : $HAS_IO_STRING ? IO::String->new
+ : $HAS_IO_STRING ? IO::String->new
: __PACKAGE__->no_string_support();
-
+ ### Addresses: #41798: Nonempty $\ when writing a TAR file produces a
+ ### corrupt TAR file. Must clear out $\ to make sure no garbage is
+ ### printed to the archive
+ local $\;
for my $entry ( @{$self->_data} ) {
### entries to be written to the tarfile ###
@@ -999,7 +1125,7 @@
my $clone = $entry->clone;
- ### so, if you don't want use to use the prefix, we'll stuff
+ ### so, if you don't want use to use the prefix, we'll stuff
### everything in the name field instead
if( $DO_NOT_USE_PREFIX ) {
@@ -1106,7 +1232,7 @@
### make sure to close the handle;
close $handle;
-
+
return $rv;
}
@@ -1177,6 +1303,10 @@
Be aware that the file's type/creator and resource fork will be lost,
which is usually what you want in cross-platform archives.
+Instead of a filename, you can also pass it an existing C<Archive::Tar::File>
+object from, for example, another archive. The object will be clone, and
+effectively be a copy of the original, not an alias.
+
Returns a list of C<Archive::Tar::File> objects that were just added.
=cut
@@ -1187,6 +1317,15 @@
my @rv;
for my $file ( @files ) {
+
+ ### you passed an Archive::Tar::File object
+ ### clone it so we don't accidentally have a reference to
+ ### an object from another archive
+ if( UNIVERSAL::isa( $file,'Archive::Tar::File' ) ) {
+ push @rv, $file->clone;
+ next;
+ }
+
unless( -e $file || -l $file ) {
$self->_error( qq[No such file: '$file'] );
next;
@@ -1313,9 +1452,9 @@
=head2 $tar->setcwd( $cwd );
C<Archive::Tar> needs to know the current directory, and it will run
-C<Cwd::cwd()> I<every> time it extracts a I<relative> entry from the
+C<Cwd::cwd()> I<every> time it extracts a I<relative> entry from the
tarfile and saves it in the file system. (As of version 1.30, however,
-C<Archive::Tar> will use the speed optimization described below
+C<Archive::Tar> will use the speed optimization described below
automatically, so it's only relevant if you're using C<extract_file()>).
Since C<Archive::Tar> doesn't change the current directory internally
@@ -1330,7 +1469,7 @@
once before calling a function like C<extract_file> and
C<Archive::Tar> will use the current directory setting from then on
-and won't call C<Cwd::cwd()> internally.
+and won't call C<Cwd::cwd()> internally.
To switch back to the default behaviour, use
@@ -1341,7 +1480,7 @@
If you're using C<Archive::Tar>'s C<exract()> method, C<setcwd()> will
be called for you.
-=cut
+=cut
sub setcwd {
my $self = shift;
@@ -1350,56 +1489,29 @@
$self->{cwd} = $cwd;
}
-=head2 $bool = $tar->has_io_string
-
-Returns true if we currently have C<IO::String> support loaded.
-
-Either C<IO::String> or C<perlio> support is needed to support writing
-stringified archives. Currently, C<perlio> is the preferred method, if
-available.
-
-See the C<GLOBAL VARIABLES> section to see how to change this preference.
-
-=cut
-
-sub has_io_string { return $HAS_IO_STRING; }
-
-=head2 $bool = $tar->has_perlio
-
-Returns true if we currently have C<perlio> support loaded.
-
-This requires C<perl-5.8> or higher, compiled with C<perlio>
-
-Either C<IO::String> or C<perlio> support is needed to support writing
-stringified archives. Currently, C<perlio> is the preferred method, if
-available.
-
-See the C<GLOBAL VARIABLES> section to see how to change this preference.
-
-=cut
-
-sub has_perlio { return $HAS_PERLIO; }
-
-
=head1 Class Methods
-=head2 Archive::Tar->create_archive($file, $compression, @filelist)
+=head2 Archive::Tar->create_archive($file, $compressed, @filelist)
Creates a tar file from the list of files provided. The first
argument can either be the name of the tar file to create or a
reference to an open file handle (e.g. a GLOB reference).
-The second argument specifies the level of compression to be used, if
-any. Compression of tar files requires the installation of the
-IO::Zlib module. Specific levels of compression may be
-requested by passing a value between 2 and 9 as the second argument.
-Any other value evaluating as true will result in the default
-compression level being used.
+The second argument is used to indicate compression. You can either
+compress using C<gzip> or C<bzip2>. If you pass a digit, it's assumed
+to be the C<gzip> compression level (between 1 and 9), but the use of
+constants is prefered:
+
+ # write a gzip compressed file
+ Archive::Tar->create_archive( 'out.tgz', COMPRESS_GZIP, @filelist );
+
+ # write a bzip compressed file
+ Archive::Tar->create_archive( 'out.tbz', COMPRESS_BZIP, @filelist );
Note that when you pass in a filehandle, the compression argument
is ignored, as all files are printed verbatim to your filehandle.
If you wish to enable compression with filehandles, use an
-C<IO::Zlib> filehandle instead.
+C<IO::Zlib> or C<IO::Compress::Bzip2> filehandle instead.
The remaining arguments list the files to be included in the tar file.
These files must all exist. Any files which don't exist or can't be
@@ -1431,7 +1543,63 @@
return $tar->write( $file, $gzip );
}
-=head2 Archive::Tar->list_archive ($file, $compressed, [\@properties])
+=head2 Archive::Tar->iter( $filename, [ $compressed, {opt => $val} ] )
+
+Returns an iterator function that reads the tar file without loading
+it all in memory. Each time the function is called it will return the
+next file in the tarball. The files are returned as
+C<Archive::Tar::File> objects. The iterator function returns the
+empty list once it has exhausted the the files contained.
+
+The second argument can be a hash reference with options, which are
+identical to the arguments passed to C<read()>.
+
+Example usage:
+
+ my $next = Archive::Tar->iter( "example.tar.gz", 1, {filter => qr/\.pm$/} );
+
+ while( my $f = $next->() ) {
+ print $f->name, "\n";
+
+ $f->extract or warn "Extraction failed";
+
+ # ....
+ }
+
+=cut
+
+
+sub iter {
+ my $class = shift;
+ my $filename = shift or return;
+ my $compressed = shift or 0;
+ my $opts = shift || {};
+
+ ### get a handle to read from.
+ my $handle = $class->_get_handle(
+ $filename,
+ $compressed,
+ READ_ONLY->( ZLIB )
+ ) or return;
+
+ my @data;
+ return sub {
+ return shift(@data) if @data; # more than one file returned?
+ return unless $handle; # handle exhausted?
+
+ ### read data, should only return file
+ @data = @{ $class->_read_tar($handle, { %$opts, limit => 1 }) };
+
+ ### return one piece of data
+ return shift(@data) if @data;
+
+ ### data is exhausted, free the filehandle
+ undef $handle;
+ return;
+ };
+}
+
+=head2 Archive::Tar->list_archive($file, $compressed, [\@properties])
Returns a list of the names of all the files in the archive. The
first argument can either be the name of the tar file to list or a
@@ -1440,7 +1608,7 @@
If C<list_archive()> is passed an array reference as its third
argument it returns a list of hash references containing the requested
properties of each file. The following list of properties is
-supported: full_path, name, size, mtime (last modified date), mode,
+supported: full_path, name, size, mtime (last modified date), mode,
uid, gid, linkname, uname, gname, devmajor, devminor, prefix.
See C<Archive::Tar::File> for details about supported properties.
@@ -1462,7 +1630,7 @@
return $tar->list_files( @_ );
}
-=head2 Archive::Tar->extract_archive ($file, $gzip)
+=head2 Archive::Tar->extract_archive($file, $compressed)
Extracts the contents of the tar file. The first argument can either
be the name of the tar file to create or a reference to an open file
@@ -1486,11 +1654,57 @@
return $tar->read( $file, $gzip, { extract => 1 } );
}
+=head2 $bool = Archive::Tar->has_io_string
+
+Returns true if we currently have C<IO::String> support loaded.
+
+Either C<IO::String> or C<perlio> support is needed to support writing
+stringified archives. Currently, C<perlio> is the preferred method, if
+available.
+
+See the C<GLOBAL VARIABLES> section to see how to change this preference.
+
+=cut
+
+sub has_io_string { return $HAS_IO_STRING; }
+
+=head2 $bool = Archive::Tar->has_perlio
+
+Returns true if we currently have C<perlio> support loaded.
+
+This requires C<perl-5.8> or higher, compiled with C<perlio>
+
+Either C<IO::String> or C<perlio> support is needed to support writing
+stringified archives. Currently, C<perlio> is the preferred method, if
+available.
+
+See the C<GLOBAL VARIABLES> section to see how to change this preference.
+
+=cut
+
+sub has_perlio { return $HAS_PERLIO; }
+
+=head2 $bool = Archive::Tar->has_zlib_support
+
+Returns true if C<Archive::Tar> can extract C<zlib> compressed archives
+
+=cut
+
+sub has_zlib_support { return ZLIB }
+
+=head2 $bool = Archive::Tar->has_bzip2_support
+
+Returns true if C<Archive::Tar> can extract C<bzip2> compressed archives
+
+=cut
+
+sub has_bzip2_support { return BZIP }
+
=head2 Archive::Tar->can_handle_compressed_files
A simple checking routine, which will return true if C<Archive::Tar>
-is able to uncompress compressed archives on the fly with C<IO::Zlib>,
-or false if C<IO::Zlib> is not installed.
+is able to uncompress compressed archives on the fly with C<IO::Zlib>
+and C<IO::Compress::Bzip2> or false if not both are installed.
You can use this as a shortcut to determine whether C<Archive::Tar>
will do what you think before passing compressed archives to its
@@ -1498,7 +1712,7 @@
=cut
-sub can_handle_compressed_files { return ZLIB ? 1 : 0 }
+sub can_handle_compressed_files { return ZLIB && BZIP ? 1 : 0 }
sub no_string_support {
croak("You have to install IO::String to support writing archives to strings");
@@ -1542,13 +1756,13 @@
=head2 $Archive::Tar::DO_NOT_USE_PREFIX
-By default, C<Archive::Tar> will try to put paths that are over
+By default, C<Archive::Tar> will try to put paths that are over
100 characters in the C<prefix> field of your tar header, as
-defined per POSIX-standard. However, some (older) tar programs
-do not implement this spec. To retain compatibility with these older
-or non-POSIX compliant versions, you can set the C<$DO_NOT_USE_PREFIX>
-variable to a true value, and C<Archive::Tar> will use an alternate
-way of dealing with paths over 100 characters by using the
+defined per POSIX-standard. However, some (older) tar programs
+do not implement this spec. To retain compatibility with these older
+or non-POSIX compliant versions, you can set the C<$DO_NOT_USE_PREFIX>
+variable to a true value, and C<Archive::Tar> will use an alternate
+way of dealing with paths over 100 characters by using the
C<GNU Extended Header> feature.
Note that clients who do not support the C<GNU Extended Header>
@@ -1589,11 +1803,11 @@
Allowing this could have security implications, as a malicious
tar archive could alter or replace any file the extracting user
-has permissions to. Therefor, the default is to not allow
-insecure extractions.
+has permissions to. Therefor, the default is to not allow
+insecure extractions.
-If you trust the archive, or have other reasons to allow the
-archive to write files outside your current working directory,
+If you trust the archive, or have other reasons to allow the
+archive to write files outside your current working directory,
set this variable to C<true>.
Note that this is a backwards incompatible change from version
@@ -1601,9 +1815,9 @@
=head2 $Archive::Tar::HAS_PERLIO
-This variable holds a boolean indicating if we currently have
+This variable holds a boolean indicating if we currently have
C<perlio> support loaded. This will be enabled for any perl
-greater than C<5.8> compiled with C<perlio>.
+greater than C<5.8> compiled with C<perlio>.
If you feel strongly about disabling it, set this variable to
C<false>. Note that you will then need C<IO::String> installed
@@ -1614,7 +1828,7 @@
=head2 $Archive::Tar::HAS_IO_STRING
-This variable holds a boolean indicating if we currently have
+This variable holds a boolean indicating if we currently have
C<IO::String> support loaded. This will be enabled for any perl
that has a loadable C<IO::String> module.
@@ -1645,18 +1859,24 @@
C<IO::Zlib> doesn't support C<seek> on their filehandles, there is little
choice but to read the archive into memory.
This is ok if you want to do in-memory manipulation of the archive.
+
If you just want to extract, use the C<extract_archive> class method
instead. It will optimize and write to disk immediately.
-=item Can't you lazy-load data instead?
+Another option is to use the C<iter> class method to iterate over
+the files in the tarball without reading them all in memory at once.
+
+=item Can you lazy-load data instead?
-No, not easily. See previous question.
+In some cases, yes. You can use the C<iter> class method to iterate
+over the files in the tarball without reading them all in memory at once.
=item How much memory will an X kb tar file need?
Probably more than X kb, since it will all be read into memory. If
this is a problem, and you don't need to do in memory manipulation
-of the archive, consider using C</bin/tar> instead.
+of the archive, consider using the C<iter> class method, or C</bin/tar>
+instead.
=item What do you do with unsupported filetypes in an archive?
@@ -1666,8 +1886,9 @@
This does require you to read the entire archive in to memory first,
since otherwise we wouldn't know what data to fill the copy with.
-(This means that you cannot use the class methods on archives that
-have incompatible filetypes and still expect things to work).
+(This means that you cannot use the class methods, including C<iter>
+on archives that have incompatible filetypes and still expect things
+to work).
For other filetypes, like C<chardevs> and C<blockdevs> we'll warn that
the extraction of this particular item didn't work.
@@ -1680,7 +1901,7 @@
C<POSIX header prefix>. Non-POSIX-compatible clients may not support
this part of the specification, and may only support the C<GNU Extended
Header> functionality. To facilitate those clients, you can set the
-C<$Archive::Tar::DO_NOT_USE_PREFIX> variable to C<true>. See the
+C<$Archive::Tar::DO_NOT_USE_PREFIX> variable to C<true>. See the
C<GLOBAL VARIABLES> section for details on this variable.
Note that GNU tar earlier than version 1.14 does not cope well with
@@ -1696,9 +1917,9 @@
based on your criteria. For example, to extract only files that have
the string C<foo> in their title, you would use:
- $tar->extract(
+ $tar->extract(
grep { $_->full_path =~ /foo/ } $tar->get_files
- );
+ );
This way, you can filter on any attribute of the files in the archive.
Consult the C<Archive::Tar::File> documentation on how to use these
@@ -1775,22 +1996,22 @@
$tar->add_data('file.txt', $data);
-A opposite problem occurs if you extract a UTF8-encoded file from a
+A opposite problem occurs if you extract a UTF8-encoded file from a
tarball. Using C<get_content()> on the C<Archive::Tar::File> object
will return its content as a bytestring, not as a Unicode string.
If you want it to be a Unicode string (because you want character
semantics with operations like regular expression matching), you need
-to decode the UTF8-encoded content and have Perl convert it into
+to decode the UTF8-encoded content and have Perl convert it into
a Unicode string:
use Encode;
my $data = $tar->get_content();
-
+
# Make it a Unicode string
$data = decode('utf8', $data);
-There is no easy way to provide this functionality in C<Archive::Tar>,
+There is no easy way to provide this functionality in C<Archive::Tar>,
because a tarball can contain many files, and each of which could be
encoded in a different way.
@@ -1852,15 +2073,15 @@
=head1 ACKNOWLEDGEMENTS
-Thanks to Sean Burke, Chris Nandor, Chip Salzenberg, Tim Heaney and
-especially Andrew Savige for their help and suggestions.
+Thanks to Sean Burke, Chris Nandor, Chip Salzenberg, Tim Heaney, Gisle Aas
+and especially Andrew Savige for their help and suggestions.
=head1 COPYRIGHT
-This module is copyright (c) 2002 - 2007 Jos Boumans
+This module is copyright (c) 2002 - 2008 Jos Boumans
E<lt>kane@cpan.orgE<gt>. All rights reserved.
-This library is free software; you may redistribute and/or modify
+This library is free software; you may redistribute and/or modify
it under the same terms as Perl itself.
=cut