diff --git a/MANIFEST b/MANIFEST index 86e84f4a1dbd..23b549f5007b 100644 --- a/MANIFEST +++ b/MANIFEST @@ -230,9 +230,8 @@ cpan/Archive-Tar/t/03_file.t Archive::Tar tests cpan/Archive-Tar/t/04_resolved_issues.t Archive::Tar tests cpan/Archive-Tar/t/05_iter.t Archive::Tar tests cpan/Archive-Tar/t/06_error.t Archive::Tar tests -cpan/Archive-Tar/t/08_ptargrep.t -cpan/Archive-Tar/t/09_roundtrip.t -cpan/Archive-Tar/t/90_symlink.t Archive::Tar tests +cpan/Archive-Tar/t/08_ptargrep.t Test file related to Archive::Tar +cpan/Archive-Tar/t/09_roundtrip.t Test file related to Archive::Tar cpan/Archive-Tar/t/99_pod.t Archive::Tar tests cpan/Archive-Tar/t/src/header/signed.tar Archive::Tar tests cpan/Archive-Tar/t/src/linktest/linktest_missing_dir.tar Archive::Tar tests @@ -241,6 +240,7 @@ cpan/Archive-Tar/t/src/long/b Archive::Tar tests cpan/Archive-Tar/t/src/long/bar.tar Archive::Tar tests cpan/Archive-Tar/t/src/long/foo.tbz Archive::Tar tests cpan/Archive-Tar/t/src/long/foo.tgz Archive::Tar tests +cpan/Archive-Tar/t/src/long/prefix-directory-concat.tar Archive-Tar cpan/Archive-Tar/t/src/short/b Archive::Tar tests cpan/Archive-Tar/t/src/short/bar.tar Archive::Tar tests cpan/Archive-Tar/t/src/short/foo.tbz Archive::Tar tests diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 881d908d74fe..3518712b42ad 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -129,12 +129,14 @@ package Maintainers; our %Modules = ( 'Archive::Tar' => { - 'DISTRIBUTION' => 'BINGOS/Archive-Tar-2.40.tar.gz', + 'DISTRIBUTION' => 'BINGOS/Archive-Tar-3.02_001.tar.gz', + 'SYNCINFO' => 'jkeenan on Tue Dec 5 07:32:24 2023', 'FILES' => q[cpan/Archive-Tar], 'BUGS' => 'bug-archive-tar@rt.cpan.org', 'EXCLUDED' => [ qw(t/07_ptardiff.t), qr{t/src/(long|short)/foo.txz}, + qw(t/90_symlink.t), ], }, diff --git a/cpan/Archive-Tar/lib/Archive/Tar.pm b/cpan/Archive-Tar/lib/Archive/Tar.pm index 476e646e44d4..665b04af200c 100644 --- a/cpan/Archive-Tar/lib/Archive/Tar.pm +++ b/cpan/Archive-Tar/lib/Archive/Tar.pm @@ -1,8 +1,8 @@ ### the gnu tar specification: -### http://www.gnu.org/software/tar/manual/tar.html +### https://www.gnu.org/software/tar/manual/tar.html ### ### and the pax format spec, which tar derives from: -### http://www.opengroup.org/onlinepubs/007904975/utilities/pax.html +### https://www.opengroup.org/onlinepubs/007904975/utilities/pax.html package Archive::Tar; require 5.005_03; @@ -24,6 +24,7 @@ use strict; use vars qw[$DEBUG $error $VERSION $WARN $FOLLOW_SYMLINK $CHOWN $CHMOD $DO_NOT_USE_PREFIX $HAS_PERLIO $HAS_IO_STRING $SAME_PERMISSIONS $INSECURE_EXTRACT_MODE $ZERO_PAD_NUMBERS @ISA @EXPORT $RESOLVE_SYMLINK + $EXTRACT_BLOCK_SIZE ]; @ISA = qw[Exporter]; @@ -31,7 +32,7 @@ use vars qw[$DEBUG $error $VERSION $WARN $FOLLOW_SYMLINK $CHOWN $CHMOD $DEBUG = 0; $WARN = 1; $FOLLOW_SYMLINK = 0; -$VERSION = "2.40"; +$VERSION = "3.02_001"; $CHOWN = 1; $CHMOD = 1; $SAME_PERMISSIONS = $> == 0 ? 1 : 0; @@ -39,6 +40,7 @@ $DO_NOT_USE_PREFIX = 0; $INSECURE_EXTRACT_MODE = 0; $ZERO_PAD_NUMBERS = 0; $RESOLVE_SYMLINK = $ENV{'PERL5_AT_RESOLVE_SYMLINK'} || 'speed'; +$EXTRACT_BLOCK_SIZE = 1024 * 1024 * 1024; BEGIN { use Config; @@ -423,7 +425,7 @@ sub _read_tar { } ### ignore labels: - ### http://www.gnu.org/software/tar/manual/html_chapter/Media.html#SEC159 + ### https://www.gnu.org/software/tar/manual/html_chapter/Media.html#SEC159 next if $entry->is_label; if( length $entry->type and ($entry->is_file || $entry->is_longlink) ) { @@ -894,10 +896,18 @@ sub _extract_file { if( $entry->size ) { binmode $fh; - syswrite $fh, $entry->data or ( - $self->_error( qq[Could not write data to '$full'] ), - return - ); + my $offset = 0; + my $content = $entry->get_content_by_ref(); + while ($offset < $entry->size) { + my $written + = syswrite $fh, $$content, $EXTRACT_BLOCK_SIZE, $offset; + if (defined $written) { + $offset += $written; + } else { + $self->_error( qq[Could not write data to '$full': $!] ); + return; + } + } } close $fh or ( @@ -2143,25 +2153,39 @@ numbers. Added for compatibility with C implementations. =head2 Tuning the way RESOLVE_SYMLINK will works - You can tune the behaviour by setting the $Archive::Tar::RESOLVE_SYMLINK variable, - or $ENV{PERL5_AT_RESOLVE_SYMLINK} before loading the module Archive::Tar. +You can tune the behaviour by setting the $Archive::Tar::RESOLVE_SYMLINK variable, +or $ENV{PERL5_AT_RESOLVE_SYMLINK} before loading the module Archive::Tar. + +Values can be one of the following: + +=over 4 + +=item none - Values can be one of the following: +Disable this mechanism and failed as it was in previous version (<1.88) - none - Disable this mechanism and failed as it was in previous version (<1.88) +=item speed (default) - speed (default) - If you prefer speed - this will read again the whole archive using read() so all entries - will be available +If you prefer speed +this will read again the whole archive using read() so all entries +will be available - memory - If you prefer memory +=item memory - Limitation +If you prefer memory - It won't work for terminal, pipe or sockets or every non seekable source. +=back + +Limitation: It won't work for terminal, pipe or sockets or every non seekable +source. + +=head2 $Archive::Tar::EXTRACT_BLOCK_SIZE + +This variable holds an integer with the block size that should be used when +writing files during extraction. It defaults to 1 GiB. Please note that this +cannot be arbitrarily large since some operating systems limit the number of +bytes that can be written in one call to C, so if this is too large, +extraction may fail with an error. =cut @@ -2396,22 +2420,11 @@ to an uploaded file, which might be a compressed archive. =item The GNU tar specification -C +L =item The PAX format specification -The specification which tar derives from; C< http://www.opengroup.org/onlinepubs/007904975/utilities/pax.html> - -=item A comparison of GNU and POSIX tar standards; C - -=item GNU tar intends to switch to POSIX compatibility - -GNU Tar authors have expressed their intention to become completely -POSIX-compatible; C - -=item A Comparison between various tar implementations - -Lists known issues and incompatibilities; C +The specification which tar derives from; L =back diff --git a/cpan/Archive-Tar/lib/Archive/Tar/Constant.pm b/cpan/Archive-Tar/lib/Archive/Tar/Constant.pm index 6f293a2f4980..f1df47519b48 100644 --- a/cpan/Archive-Tar/lib/Archive/Tar/Constant.pm +++ b/cpan/Archive-Tar/lib/Archive/Tar/Constant.pm @@ -8,7 +8,7 @@ use vars qw[$VERSION @ISA @EXPORT]; BEGIN { require Exporter; - $VERSION = '2.40'; + $VERSION = '3.02_001'; @ISA = qw[Exporter]; require Time::Local if $^O eq "MacOS"; diff --git a/cpan/Archive-Tar/lib/Archive/Tar/File.pm b/cpan/Archive-Tar/lib/Archive/Tar/File.pm index c361f046d7ae..bc9d665a7189 100644 --- a/cpan/Archive-Tar/lib/Archive/Tar/File.pm +++ b/cpan/Archive-Tar/lib/Archive/Tar/File.pm @@ -11,7 +11,7 @@ use Archive::Tar::Constant; use vars qw[@ISA $VERSION]; #@ISA = qw[Archive::Tar]; -$VERSION = '2.40'; +$VERSION = '3.02_001'; ### set value to 1 to oct() it during the unpack ### @@ -71,7 +71,7 @@ Archive::Tar::File - a subclass for in-memory extracted file from Archive::Tar =head1 DESCRIPTION -Archive::Tar::Files provides a neat little object layer for in-memory +Archive::Tar::File provides a neat little object layer for in-memory extracted files. It's mostly used internally in Archive::Tar to tidy up the code, but there's no reason users shouldn't use this API as well. @@ -486,7 +486,9 @@ sub full_path { return $self->name unless defined $self->prefix and length $self->prefix; ### or otherwise, catfile'd - return File::Spec::Unix->catfile( $self->prefix, $self->name ); + my $path = File::Spec::Unix->catfile( $self->prefix, $self->name ); + $path .= "/" if $self->name =~ m{/$}; # Re-add trailing slash if necessary, as catfile() strips them off. + return $path; } @@ -601,7 +603,7 @@ sub rename { return 1; } -=head2 $bool = $file->chmod $mode) +=head2 $bool = $file->chmod( $mode ) Change mode of $file to $mode. The mode can be a string or a number which is interpreted as octal whether or not a leading 0 is given. diff --git a/cpan/Archive-Tar/t/02_methods.t b/cpan/Archive-Tar/t/02_methods.t index 19d921242203..519535e8f5db 100644 --- a/cpan/Archive-Tar/t/02_methods.t +++ b/cpan/Archive-Tar/t/02_methods.t @@ -570,6 +570,34 @@ SKIP: { ### pesky warnings } +### extract tests with different $EXTRACT_BLOCK_SIZE values ### +SKIP: { ### pesky warnings + skip $ebcdic_skip_msg, 431 if ord "A" != 65; + + skip('no IO::String', 431) if !$Archive::Tar::HAS_PERLIO && + !$Archive::Tar::HAS_PERLIO && + !$Archive::Tar::HAS_IO_STRING && + !$Archive::Tar::HAS_IO_STRING; + + my $tar = $Class->new; + ok( $tar->read( $TAR_FILE ), "Read in '$TAR_FILE'" ); + + for my $aref ( [$tar, \@EXPECT_NORMAL], + [$TARBIN, \@EXPECTBIN], + [$TARX, \@EXPECTX] + ) { + my($obj, $struct) = @$aref; + + for my $block_size ((1, BLOCK, 1024 * 1024, 2**31 - 4096, 2**31 - 1)) { + local $Archive::Tar::EXTRACT_BLOCK_SIZE = $block_size; + + ok( $obj->extract, " Extracted with 'extract'" ); + check_tar_extract( $obj, $struct ); + } + } +} + + ### clear tests ### SKIP: { ### pesky warnings skip $ebcdic_skip_msg, 3 if ord "A" != 65; diff --git a/cpan/Archive-Tar/t/04_resolved_issues.t b/cpan/Archive-Tar/t/04_resolved_issues.t index fc713cd0a047..b7e7860fe247 100644 --- a/cpan/Archive-Tar/t/04_resolved_issues.t +++ b/cpan/Archive-Tar/t/04_resolved_issues.t @@ -200,6 +200,7 @@ SKIP: { ### bug #78030 ### tests for symlinks with relative paths ### seen on MSWin32 +if ($^O ne 'msys') # symlink tests fail on Windows/msys2 { ok( 1, "Testing bug 78030" ); my $archname = 'tmp-symlink.tar.gz'; { #build archive diff --git a/cpan/Archive-Tar/t/09_roundtrip.t b/cpan/Archive-Tar/t/09_roundtrip.t index a82cd5b8eb63..c84f055d72f8 100644 --- a/cpan/Archive-Tar/t/09_roundtrip.t +++ b/cpan/Archive-Tar/t/09_roundtrip.t @@ -53,6 +53,7 @@ push @file_only_archives, [qw( src short foo.txz )] my @file_and_directory_archives = ( [qw( src long bar.tar )], + [qw( src long prefix-directory-concat.tar )], [qw( src linktest linktest_with_dir.tar )], ); push @file_and_directory_archives, [qw( src long foo.tgz )] diff --git a/cpan/Archive-Tar/t/90_symlink.t b/cpan/Archive-Tar/t/90_symlink.t deleted file mode 100644 index 3d7b40686067..000000000000 --- a/cpan/Archive-Tar/t/90_symlink.t +++ /dev/null @@ -1,55 +0,0 @@ -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 --git a/cpan/Archive-Tar/t/src/long/prefix-directory-concat.tar b/cpan/Archive-Tar/t/src/long/prefix-directory-concat.tar new file mode 100644 index 000000000000..a34abbcfe89a Binary files /dev/null and b/cpan/Archive-Tar/t/src/long/prefix-directory-concat.tar differ