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 and C 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 -=item is_dir +=item $file->is_dir Returns true if the file is of type C -=item is_hardlink +=item $file->is_hardlink Returns true if the file is of type C -=item is_symlink +=item $file->is_symlink Returns true if the file is of type C -=item is_chardev +=item $file->is_chardev Returns true if the file is of type C -=item is_blockdev +=item $file->is_blockdev Returns true if the file is of type C -=item is_fifo +=item $file->is_fifo Returns true if the file is of type C -=item is_socket +=item $file->is_socket Returns true if the file is of type C -=item is_longlink +=item $file->is_longlink Returns true if the file is of type C. Should not happen after a successful C. -=item is_label +=item $file->is_label Returns true if the file is of type C