1
0
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:
afresh1
2026-06-09 01:36:20 +00:00
parent 6ad0bf9083
commit 170dab4126
2 changed files with 49 additions and 1 deletions
@@ -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;