mirror of
https://github.com/openbsd/src.git
synced 2026-06-18 07:13:36 +02:00
Upstream patches for Archive-Tar perl dist
* CVE-2026-42496
https://lists.security.metacpan.org/cve-announce/msg/40396459/
Archive::Tar versions before 3.08 for Perl extract symlinks with
attacker controlled targets outside the extraction directory
* CVE-2026-42497
https://lists.security.metacpan.org/cve-announce/msg/40396457/
Archive::Tar versions before 3.08 for Perl extract hardlinks to
attacker controlled paths outside the extraction directory
* CVE-2026-9538
https://lists.security.metacpan.org/cve-announce/msg/40396448/
Archive::Tar versions before 3.10 for Perl allow memory exhaustion
via attacker controlled entry size field in tar header
This commit is contained in:
@@ -24,7 +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
|
||||
$EXTRACT_BLOCK_SIZE $MAX_FILE_SIZE
|
||||
];
|
||||
|
||||
@ISA = qw[Exporter];
|
||||
@@ -42,6 +42,7 @@ $ZERO_PAD_NUMBERS = 0;
|
||||
$RESOLVE_SYMLINK = $ENV{'PERL5_AT_RESOLVE_SYMLINK'} || 'speed';
|
||||
$EXTRACT_BLOCK_SIZE = 1024 * 1024 * 1024;
|
||||
|
||||
$MAX_FILE_SIZE = 1024 * 1024 * 1024;
|
||||
BEGIN {
|
||||
use Config;
|
||||
$HAS_PERLIO = $Config::Config{useperlio};
|
||||
@@ -444,6 +445,14 @@ sub _read_tar {
|
||||
|
||||
my $block = BLOCK_SIZE->( $entry->size );
|
||||
|
||||
if ( $MAX_FILE_SIZE && $entry->size > $MAX_FILE_SIZE ) {
|
||||
$self->_error( qq[Entry '] . $entry->full_path .
|
||||
qq[' declared size ] . $entry->size .
|
||||
qq[ bytes exceeds \$Archive::Tar::MAX_FILE_SIZE ] .
|
||||
qq[($MAX_FILE_SIZE); refusing to allocate] );
|
||||
next LOOP;
|
||||
}
|
||||
|
||||
$data = $entry->get_content_by_ref;
|
||||
|
||||
my $skip = 0;
|
||||
@@ -954,6 +963,19 @@ sub _make_special_file {
|
||||
my $err;
|
||||
|
||||
if( $entry->is_symlink ) {
|
||||
if( !$INSECURE_EXTRACT_MODE ) {
|
||||
my $linkname = $entry->linkname;
|
||||
if( File::Spec->file_name_is_absolute($linkname) ) {
|
||||
$self->_error( qq[Symlink '] . $entry->full_path .
|
||||
qq[' has absolute target. Not extracting under SECURE EXTRACT MODE] );
|
||||
return;
|
||||
}
|
||||
if( grep { $_ eq '..' } File::Spec->splitdir($linkname) ) {
|
||||
$self->_error( qq[Symlink '] . $entry->full_path .
|
||||
qq[' target attempts traversal. Not extracting under SECURE EXTRACT MODE] );
|
||||
return;
|
||||
}
|
||||
}
|
||||
my $fail;
|
||||
if( ON_UNIX ) {
|
||||
symlink( $entry->linkname, $file ) or $fail++;
|
||||
@@ -967,6 +989,23 @@ sub _make_special_file {
|
||||
$entry->linkname .q[' failed] if $fail;
|
||||
|
||||
} elsif ( $entry->is_hardlink ) {
|
||||
if( !$INSECURE_EXTRACT_MODE ) {
|
||||
my $linkname = $entry->linkname;
|
||||
if( File::Spec->file_name_is_absolute($linkname) ) {
|
||||
$self->_error( qq[Hardlink '] . $entry->full_path .
|
||||
qq[' has absolute target '$linkname'. Not extracting ] .
|
||||
qq[under SECURE EXTRACT MODE: extraction itself chmods ] .
|
||||
qq[the shared inode.] );
|
||||
return;
|
||||
}
|
||||
if( grep { $_ eq '..' } File::Spec->splitdir($linkname) ) {
|
||||
$self->_error( qq[Hardlink '] . $entry->full_path .
|
||||
qq[' target '$linkname' attempts traversal. Not ] .
|
||||
qq[extracting under SECURE EXTRACT MODE: extraction ] .
|
||||
qq[itself chmods the shared inode.] );
|
||||
return;
|
||||
}
|
||||
}
|
||||
my $fail;
|
||||
if( ON_UNIX ) {
|
||||
link( $entry->linkname, $file ) or $fail++;
|
||||
@@ -2187,6 +2226,13 @@ cannot be arbitrarily large since some operating systems limit the number of
|
||||
bytes that can be written in one call to C<write(2)>, so if this is too large,
|
||||
extraction may fail with an error.
|
||||
|
||||
=head2 $Archive::Tar::MAX_FILE_SIZE
|
||||
|
||||
This variable holds an upper bound on the per-entry declared size that
|
||||
C<Archive::Tar> will accept when reading an archive. Entries whose header
|
||||
claims a larger size are refused with an error before any read allocation.
|
||||
Defaults to 1 GiB. Set to 0 to disable the cap.
|
||||
|
||||
=cut
|
||||
|
||||
=head1 FAQ
|
||||
|
||||
@@ -220,6 +220,7 @@ if ($^O ne 'msys') # symlink tests fail on Windows/msys2
|
||||
}
|
||||
|
||||
{ #use case 1 - in memory extraction
|
||||
local $Archive::Tar::INSECURE_EXTRACT_MODE=1;
|
||||
my $t=Archive::Tar->new;
|
||||
$t->read( $archname );
|
||||
my $r = eval{ $t->extract };
|
||||
@@ -231,6 +232,7 @@ if ($^O ne 'msys') # symlink tests fail on Windows/msys2
|
||||
|
||||
{ #use case 2 - iter extraction
|
||||
#$DB::single = 2;
|
||||
local $Archive::Tar::INSECURE_EXTRACT_MODE=1;
|
||||
my $next=Archive::Tar->iter( $archname, 1 );
|
||||
my $failed = 0;
|
||||
#use Data::Dumper;
|
||||
|
||||
Reference in New Issue
Block a user