diff --git a/dev/import-perl5/config.yaml b/dev/import-perl5/config.yaml
index 0180aa4cb..662eeace9 100644
--- a/dev/import-perl5/config.yaml
+++ b/dev/import-perl5/config.yaml
@@ -588,6 +588,7 @@ imports:
# From core distribution (has built-in pure Perl fallback when XS unavailable)
- source: perl5/dist/Data-Dumper/Dumper.pm
target: src/main/perl/lib/Data/Dumper.pm
+ patch: Data-Dumper.pm.patch
# Tests for distribution
- source: perl5/dist/Data-Dumper/t
diff --git a/dev/import-perl5/patches/Data-Dumper.pm.patch b/dev/import-perl5/patches/Data-Dumper.pm.patch
new file mode 100644
index 000000000..b23e64794
--- /dev/null
+++ b/dev/import-perl5/patches/Data-Dumper.pm.patch
@@ -0,0 +1,13 @@
+--- perl5/dist/Data-Dumper/Dumper.pm
++++ src/main/perl/lib/Data/Dumper.pm
+@@ -580,6 +580,10 @@
+ $out .= sprintf "v%vd", $val;
+ }
+ # \d here would treat "1\x{660}" as a safe decimal number
++ elsif (defined &Data::Dumper::_perlonjava_numified_safe_decimal
++ and Data::Dumper::_perlonjava_numified_safe_decimal($val)) {
++ $out .= $val;
++ }
+ elsif ($val =~ /^(?:0|-?[1-9][0-9]{0,8})\z/) { # safe decimal number
+ $out .= $val;
+ }
diff --git a/gradle/libs.versions.toml b/gradle/libs.versions.toml
index 9156544f3..b61ad8a6e 100644
--- a/gradle/libs.versions.toml
+++ b/gradle/libs.versions.toml
@@ -1,21 +1,21 @@
[versions]
-asm = "9.9.1"
-bouncycastle = "1.78.1"
+asm = "9.10.1"
+bouncycastle = "1.84"
+commons-compress = "1.28.0"
commons-csv = "1.14.1"
-commons-compress = "1.27.1"
icu4j = "78.3"
-junit-jupiter = "6.1.0-M1"
+junit-jupiter = "6.1.1"
snakeyaml-engine = "3.0.1"
-sqlite-jdbc = "3.51.3.0"
+sqlite-jdbc = "3.53.2.0"
tomlj = "1.1.1"
[libraries]
asm = { module = "org.ow2.asm:asm", version.ref = "asm" }
asm-util = { module = "org.ow2.asm:asm-util", version.ref = "asm" }
-bcprov = { module = "org.bouncycastle:bcprov-jdk18on", version.ref = "bouncycastle" }
bcpkix = { module = "org.bouncycastle:bcpkix-jdk18on", version.ref = "bouncycastle" }
-commons-csv = { module = "org.apache.commons:commons-csv", version.ref = "commons-csv" }
+bcprov = { module = "org.bouncycastle:bcprov-jdk18on", version.ref = "bouncycastle" }
commons-compress = { module = "org.apache.commons:commons-compress", version.ref = "commons-compress" }
+commons-csv = { module = "org.apache.commons:commons-csv", version.ref = "commons-csv" }
icu4j = { module = "com.ibm.icu:icu4j", version.ref = "icu4j" }
junit-jupiter-api = { module = "org.junit.jupiter:junit-jupiter-api", version.ref = "junit-jupiter" }
junit-jupiter-engine = { module = "org.junit.jupiter:junit-jupiter-engine", version.ref = "junit-jupiter" }
diff --git a/pom.xml b/pom.xml
index 50cf4c442..a7615aede 100644
--- a/pom.xml
+++ b/pom.xml
@@ -20,29 +20,29 @@
org.ow2.asm
asm
- 9.9.1
+ 9.10.1
org.ow2.asm
asm-util
- 9.9.1
+ 9.10.1
org.junit.jupiter
junit-jupiter-api
- 6.1.0-M1
+ 6.1.1
test
org.junit.jupiter
junit-jupiter-engine
- 6.1.0-M1
+ 6.1.1
test
org.junit.jupiter
junit-jupiter-params
- 6.1.0-M1
+ 6.1.1
test
@@ -68,27 +68,27 @@
org.apache.commons
commons-compress
- 1.27.1
+ 1.28.0
org.xerial
sqlite-jdbc
- 3.51.3.0
+ 3.53.2.0
org.bouncycastle
bcprov-jdk18on
- 1.78.1
+ 1.84
org.bouncycastle
bcpkix-jdk18on
- 1.78.1
+ 1.84
io.netty
netty-codec-http
- 4.1.115.Final
+ 4.2.16.Final
diff --git a/src/main/perl/lib/Archive/Tar.pm b/src/main/perl/lib/Archive/Tar.pm
index 38e93712c..4b955b1d5 100644
--- a/src/main/perl/lib/Archive/Tar.pm
+++ b/src/main/perl/lib/Archive/Tar.pm
@@ -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 $EXTRACT_HARDLINK $MAX_FILE_SIZE
];
@ISA = qw[Exporter];
@@ -32,7 +32,7 @@ use vars qw[$DEBUG $error $VERSION $WARN $FOLLOW_SYMLINK $CHOWN $CHMOD
$DEBUG = 0;
$WARN = 1;
$FOLLOW_SYMLINK = 0;
-$VERSION = "3.04";
+$VERSION = "3.12";
$CHOWN = 1;
$CHMOD = 1;
$SAME_PERMISSIONS = $> == 0 ? 1 : 0;
@@ -41,6 +41,8 @@ $INSECURE_EXTRACT_MODE = 0;
$ZERO_PAD_NUMBERS = 0;
$RESOLVE_SYMLINK = $ENV{'PERL5_AT_RESOLVE_SYMLINK'} || 'speed';
$EXTRACT_BLOCK_SIZE = 1024 * 1024 * 1024;
+$EXTRACT_HARDLINK = 0;
+$MAX_FILE_SIZE = 1024 * 1024 * 1024;
BEGIN {
use Config;
@@ -444,6 +446,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;
@@ -922,19 +932,19 @@ sub _extract_file {
### 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 ) {
+ if( not -l $full and not ( $entry->is_hardlink and ON_UNIX and $EXTRACT_HARDLINK ) ) {
utime time, $entry->mtime - TIME_OFFSET, $full or
$self->_error( qq[Could not update timestamp] );
}
- if( $CHOWN && CAN_CHOWN->() and not -l $full ) {
+ if( $CHOWN && CAN_CHOWN->() and not -l $full and not ( $entry->is_hardlink and ON_UNIX and $EXTRACT_HARDLINK ) ) {
CORE::chown( $entry->uid, $entry->gid, $full ) or
$self->_error( qq[Could not set uid/gid on '$full'] );
}
### only chmod if we're allowed to, but never chmod symlinks, since they'll
### change the perms on the file they're linking too...
- if( $CHMOD and not -l $full ) {
+ if( $CHMOD and not -l $full and not ( $entry->is_hardlink and ON_UNIX and $EXTRACT_HARDLINK ) ) {
my $mode = $entry->mode;
unless ($SAME_PERMISSIONS) {
$mode &= ~(oct(7000) | umask);
@@ -954,6 +964,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( !defined _symlinks_resolver( $entry->full_path, $linkname, 1 ) ) {
+ $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,8 +990,25 @@ 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( !defined _symlinks_resolver( $entry->full_path, $linkname, 1 ) ) {
+ $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 ) {
+ if( ON_UNIX && $EXTRACT_HARDLINK ) {
link( $entry->linkname, $file ) or $fail++;
} else {
@@ -1984,7 +2024,7 @@ sub no_string_support {
}
sub _symlinks_resolver{
- my ($src, $trg) = @_;
+ my ($src, $trg, $strict) = @_;
my @src = split /[\/\\]/, $src;
my @trg = split /[\/\\]/, $trg;
pop @src; #strip out current object name
@@ -1997,6 +2037,7 @@ sub _symlinks_resolver{
next if $part eq '.'; #ignore current
if($part eq '..'){
#got to parent
+ return if $strict && !@src;
pop @src;
}
else{
@@ -2118,6 +2159,12 @@ set this variable to C.
Note that this is a backwards incompatible change from version
C<1.36> and before.
+=head2 $Archive::Tar::EXTRACT_HARDLINK
+
+Prior to version C<3.06> Archive::Tar would honour hardlinks in
+archives. Version C<3.06> and onwards will skip hardlinks unless
+this flag is set. Exercise caution when enabling this.
+
=head2 $Archive::Tar::HAS_PERLIO
This variable holds a boolean indicating if we currently have
@@ -2187,6 +2234,13 @@ 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.
+=head2 $Archive::Tar::MAX_FILE_SIZE
+
+This variable holds an upper bound on the per-entry declared size that
+C 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
diff --git a/src/main/perl/lib/Archive/Tar/Constant.pm b/src/main/perl/lib/Archive/Tar/Constant.pm
index 75b416557..ab6768bc9 100644
--- a/src/main/perl/lib/Archive/Tar/Constant.pm
+++ b/src/main/perl/lib/Archive/Tar/Constant.pm
@@ -8,7 +8,7 @@ use vars qw[$VERSION @ISA @EXPORT];
BEGIN {
require Exporter;
- $VERSION = '3.04';
+ $VERSION = '3.12';
@ISA = qw[Exporter];
require Time::Local if $^O eq "MacOS";
diff --git a/src/main/perl/lib/Archive/Tar/File.pm b/src/main/perl/lib/Archive/Tar/File.pm
index 1661a6a03..d524b9df8 100644
--- a/src/main/perl/lib/Archive/Tar/File.pm
+++ b/src/main/perl/lib/Archive/Tar/File.pm
@@ -11,7 +11,7 @@ use Archive::Tar::Constant;
use vars qw[@ISA $VERSION];
#@ISA = qw[Archive::Tar];
-$VERSION = '3.04';
+$VERSION = '3.12';
### set value to 1 to oct() it during the unpack ###
diff --git a/src/main/perl/lib/IO/Socket/IP.pm b/src/main/perl/lib/IO/Socket/IP.pm
index eb1d3b9d9..c6779cf20 100644
--- a/src/main/perl/lib/IO/Socket/IP.pm
+++ b/src/main/perl/lib/IO/Socket/IP.pm
@@ -3,12 +3,12 @@
#
# (C) Paul Evans, 2010-2024 -- leonerd@leonerd.org.uk
-package IO::Socket::IP 0.43;
+package IO::Socket::IP 0.44;
use v5.14;
use warnings;
-use base qw( IO::Socket );
+use parent qw( IO::Socket );
use Carp;
@@ -1199,7 +1199,7 @@ sub join_addr
package # hide from indexer
IO::Socket::IP::_ForINET;
-use base qw( IO::Socket::IP );
+use parent qw( IO::Socket::IP );
sub configure
{
@@ -1213,7 +1213,7 @@ sub configure
package # hide from indexer
IO::Socket::IP::_ForINET6;
-use base qw( IO::Socket::IP );
+use parent qw( IO::Socket::IP );
sub configure
{
diff --git a/src/main/perl/lib/NEXT.pm b/src/main/perl/lib/NEXT.pm
index 9059a3e46..067929053 100644
--- a/src/main/perl/lib/NEXT.pm
+++ b/src/main/perl/lib/NEXT.pm
@@ -299,7 +299,7 @@ The C tells C that there must actually be a next method to call,
or it should throw an exception.
C is most commonly used in C methods, as a means to
-decline an C request, but preserve the normal exception-on-failure
+decline an C request, but preserve the normal exception-on-failure
semantics:
sub AUTOLOAD {
@@ -328,10 +328,10 @@ If C redispatching is used in the methods of a "diamond" class hierarchy:
use NEXT;
- package A;
+ package A;
sub foo { print "called A::foo\n"; shift->NEXT::foo() }
- package B;
+ package B;
sub foo { print "called B::foo\n"; shift->NEXT::foo() }
package C; @ISA = qw( A );
@@ -361,7 +361,7 @@ inherited. For example, the above code prints:
(i.e. C is called twice).
In some cases this I be the desired effect within a diamond hierarchy,
-but in others (e.g. for destructors) it may be more appropriate to
+but in others (e.g. for destructors) it may be more appropriate to
call each method only once during a sequence of redispatches.
To cover such cases, you can redispatch methods via:
@@ -377,10 +377,10 @@ once. That is, to skip any classes in the hierarchy that it has
already visited during redispatch. So, for example, if the
previous example were rewritten:
- package A;
+ package A;
sub foo { print "called A::foo\n"; shift->NEXT::DISTINCT::foo() }
- package B;
+ package B;
sub foo { print "called B::foo\n"; shift->NEXT::DISTINCT::foo() }
package C; @ISA = qw( A );
@@ -469,11 +469,11 @@ initializers) where it's more appropriate that the least-derived methods be
called first (as more-derived methods may rely on the behaviour of their
"ancestors"). In that case, instead of using the C pseudo-class:
- $obj->EVERY::foo(); # prints" A::foo B::foo X::foo D::foo
+ $obj->EVERY::foo(); # prints" A::foo B::foo X::foo D::foo
you can use the C pseudo-class:
- $obj->EVERY::LAST::foo(); # prints" D::foo X::foo B::foo A::foo
+ $obj->EVERY::LAST::foo(); # prints" D::foo X::foo B::foo A::foo
which reverses the order of method call.
@@ -509,11 +509,11 @@ left-most-depth-first-est one):
package Base;
sub DESTROY { $_[0]->EVERY::Destroy }
- package Derived1;
+ package Derived1;
use base 'Base';
sub Destroy {...}
- package Derived2;
+ package Derived2;
use base 'Base', 'Derived1';
sub Destroy {...}
@@ -532,14 +532,14 @@ a new object is invoked:
$obj->EVERY::LAST::Init(\%args);
}
- package Derived1;
+ package Derived1;
use base 'Base';
sub Init {
my ($argsref) = @_;
...
}
- package Derived2;
+ package Derived2;
use base 'Base', 'Derived1';
sub Init {
my ($argsref) = @_;
diff --git a/src/main/perl/lib/Pod/perl.pod b/src/main/perl/lib/Pod/perl.pod
index 50a7c33c2..eee74c0a8 100644
--- a/src/main/perl/lib/Pod/perl.pod
+++ b/src/main/perl/lib/Pod/perl.pod
@@ -182,17 +182,6 @@ aux h2ph h2xs perlbug pl2pm pod2html pod2man splain xsubpp
perlhist Perl history records
perldelta Perl changes since previous version
- perl54310delta Perl changes in version 5.43.10
- perl5439delta Perl changes in version 5.43.9
- perl5438delta Perl changes in version 5.43.8
- perl5437delta Perl changes in version 5.43.7
- perl5436delta Perl changes in version 5.43.6
- perl5435delta Perl changes in version 5.43.5
- perl5434delta Perl changes in version 5.43.4
- perl5433delta Perl changes in version 5.43.3
- perl5432delta Perl changes in version 5.43.2
- perl5431delta Perl changes in version 5.43.1
- perl5430delta Perl changes in version 5.43.0
perl5422delta Perl changes in version 5.42.2
perl5421delta Perl changes in version 5.42.1
perl5420delta Perl changes in version 5.42.0
diff --git a/src/main/perl/lib/Pod/perlclass.pod b/src/main/perl/lib/Pod/perlclass.pod
index 655375801..e526186d7 100644
--- a/src/main/perl/lib/Pod/perlclass.pod
+++ b/src/main/perl/lib/Pod/perlclass.pod
@@ -416,33 +416,25 @@ including an ability for them to provide new class or field attributes.
=head1 KNOWN BUGS
-The following bugs have been found in the experimental C feature:
+The following unresolved bugs exist in the experimental C feature:
=over 4
=item *
-Since Perl v5.38, inheriting from a parent class which is declared in the same
-file and which hadn't already been sealed can cause a segmentation fault.
-[L]
-
-=item *
-
-Since Perl v5.38 and with the experimental C feature, trying to
-replace a field variable causes a segmentation fault.
-[L]
-
-=item *
-
-Since Perl v5.38, it's possible to craft a class with leaky encapsulation,
+It's possible to craft a class with leaky encapsulation,
which can cause a segmentation fault.
[L]
+=item *
+Declaring fields after declaring a nested subclass corrupts the object storage.
+[L]
+
=item *
-In Perl v5.38, inheriting from a class would not always attempt to load the
-parent class (fixed in Perl v5.40).
-[L]
+Fields cannot be used by anonymous C expressions during C
+phasers or as part of a C