Download raw body.
Misc perl CVE
In May, the CPAN security team announced a set of pretty minor CVE for
perl and modules that ship in core. Attached is the upstream patches
applied to the src tree.
https://lists.security.metacpan.org/cve-announce/threads/2026/05/
You can see the individual patches on Github.
https://github.com/afresh1/OpenBSD-perl/tree/2026-05-CVE/patches/GOOD/UPSTREAM/2026-05
I'm headed out of town for the weekend tomorrow afternoon, but I should
be around to commit it early next week.
Comments, OK?
Distribution: Archive-Tar
* CVE-2026-42496
Archive::Tar versions before 3.08 for Perl extract symlinks with
attacker controlled targets outside the extraction directory
* CVE-2026-42497
Archive::Tar versions before 3.08 for Perl extract hardlinks to
attacker controlled paths outside the extraction directory
* CVE-2026-9538
Archive::Tar versions before 3.10 for Perl allow memory exhaustion
via attacker controlled entry size field in tar header
Distribution: HTTP-Tiny
* CVE-2026-7010
HTTP::Tiny versions before 0.093 for Perl do not validate CRLF in
HTTP request lines or control field header values
Distribution: IO-Compress
* CVE-2026-48961
IO::Compress versions from 2.207 before 2.220 for Perl ship a
zipdetails CLI tool that crashes with undefined subroutine on
Info-ZIP Unix Extra Field with 8-byte UID or GID
* CVE-2026-48962
IO::Compress versions before 2.220 for Perl can execute arbitrary
code in File::GlobMapper via an attacker-controlled output glob
* CVE-2025-15649
IO::Uncompress::Unzip versions before 2.215 for Perl propagate
uncaught exception when parsing zip header with malformed DOS date
* CVE-2026-48959
IO::Uncompress::Unzip versions before 2.220 for Perl allow CPU
exhaustion via per-byte read loop in fastForward
Distribution: perl
* CVE-2026-8376
Perl versions through 5.43.10 have a heap buffer overflow when
compiling regular expressions with a repeated fixed string on 32-bit
builds
Index: gnu/usr.bin/perl/regcomp_study.c
===================================================================
RCS file: /home/afresh1/OpenBSD-perl/OP/cvs/src/gnu/usr.bin/perl/regcomp_study.c,v
diff -u -p -a -u -p -r1.1.1.3 regcomp_study.c
--- gnu/usr.bin/perl/regcomp_study.c 26 Dec 2025 22:12:29 -0000 1.1.1.3
+++ gnu/usr.bin/perl/regcomp_study.c 3 Jun 2026 01:35:43 -0000
@@ -2770,6 +2770,13 @@ Perl_study_chunk(pTHX_
(U8 *) SvEND(data->last_found))
- (U8*)s;
l -= old;
+
+ if (l > 0 &&
+ (mincount >= SSize_t_MAX / (SSize_t)l
+ || old > SSize_t_MAX - mincount * (SSize_t)l)) {
+ FAIL("Regexp out of space");
+ }
+
/* Get the added string: */
last_str = newSVpvn_utf8(s + old, l, UTF);
last_chrs = UTF ? utf8_length((U8*)(s + old),
Index: gnu/usr.bin/perl/cpan/Archive-Tar/lib/Archive/Tar.pm
===================================================================
RCS file: /home/afresh1/OpenBSD-perl/OP/cvs/src/gnu/usr.bin/perl/cpan/Archive-Tar/lib/Archive/Tar.pm,v
diff -u -p -a -u -p -r1.10 Tar.pm
--- gnu/usr.bin/perl/cpan/Archive-Tar/lib/Archive/Tar.pm 26 Dec 2025 22:14:13 -0000 1.10
+++ gnu/usr.bin/perl/cpan/Archive-Tar/lib/Archive/Tar.pm 3 Jun 2026 01:35:40 -0000
@@ -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++;
@@ -2186,6 +2225,13 @@ writing files during extraction. It defa
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
Index: gnu/usr.bin/perl/cpan/Archive-Tar/t/04_resolved_issues.t
===================================================================
RCS file: /home/afresh1/OpenBSD-perl/OP/cvs/src/gnu/usr.bin/perl/cpan/Archive-Tar/t/04_resolved_issues.t,v
diff -u -p -a -u -p -r1.1.1.7 04_resolved_issues.t
--- gnu/usr.bin/perl/cpan/Archive-Tar/t/04_resolved_issues.t 26 Dec 2025 22:12:40 -0000 1.1.1.7
+++ gnu/usr.bin/perl/cpan/Archive-Tar/t/04_resolved_issues.t 3 Jun 2026 01:35:40 -0000
@@ -220,6 +220,7 @@ if ($^O ne 'msys') # symlink tests fail
}
{ #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
{ #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;
Index: gnu/usr.bin/perl/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm
===================================================================
RCS file: /home/afresh1/OpenBSD-perl/OP/cvs/src/gnu/usr.bin/perl/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm,v
diff -u -p -a -u -p -r1.9 Tiny.pm
--- gnu/usr.bin/perl/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm 26 Dec 2025 22:14:14 -0000 1.9
+++ gnu/usr.bin/perl/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm 3 Jun 2026 01:35:40 -0000
@@ -1381,6 +1381,8 @@ sub write_header_lines {
my $field_name = $HeaderCase{$k};
my $v = $headers->{$k};
for (ref $v eq 'ARRAY' ? @$v : $v) {
+ die(qq/Invalid HTTP header field value ($field_name): / . $Printable->($_). "\n")
+ unless $_ eq '' || /\A $Field_Content \z/xo;
$_ = '' unless defined $_;
$buf .= "$field_name: $_\x0D\x0A";
}
@@ -1571,6 +1573,12 @@ sub read_response_header {
sub write_request_header {
@_ == 5 || die(q/Usage: $handle->write_request_header(method, request_uri, headers, header_case)/ . "\n");
my ($self, $method, $request_uri, $headers, $header_case) = @_;
+
+ die (q/Invalid characters in Request-URI /. $Printable->($request_uri). "\n")
+ if $request_uri =~ /[\x00-\x20\x7F]/;
+
+ die (q/Invalid characters in Method /. $Printable->($method). "\n")
+ if $method =~ /[\x00-\x20\x7F]/;
return $self->write_header_lines($headers, $header_case, "$method $request_uri HTTP/1.1\x0D\x0A");
}
Index: gnu/usr.bin/perl/cpan/IO-Compress/bin/zipdetails
===================================================================
RCS file: /home/afresh1/OpenBSD-perl/OP/cvs/src/gnu/usr.bin/perl/cpan/IO-Compress/bin/zipdetails,v
diff -u -p -a -u -p -r1.7 zipdetails
--- gnu/usr.bin/perl/cpan/IO-Compress/bin/zipdetails 28 Jan 2025 01:06:11 -0000 1.7
+++ gnu/usr.bin/perl/cpan/IO-Compress/bin/zipdetails 3 Jun 2026 01:35:40 -0000
@@ -93,7 +93,7 @@ use constant ZIP_EXTRA_SUBFIELD_MAX_SIZE
ZIP_EXTRA_SUBFIELD_HEADER_SIZE;
use constant ZIP_EOCD_MIN_SIZE => 22 ;
-
+use constant ZIP_CENTRAL_HDR_MIN_SIZE => 46 ;
use constant ZIP_LD_FILENAME_OFFSET => 30;
use constant ZIP_CD_FILENAME_OFFSET => 46;
@@ -107,7 +107,7 @@ my %ZIP_CompressionMethods =
4 => 'Reduced compression factor 3',
5 => 'Reduced compression factor 4',
6 => 'Imploded',
- 7 => 'Reserved for Tokenizing compression algorithm',
+ 7 => 'Tokenized',
8 => 'Deflated',
9 => 'Deflate64',
10 => 'PKWARE Data Compression Library Imploding',
@@ -120,7 +120,7 @@ my %ZIP_CompressionMethods =
17 => 'Reserved by PKWARE',
18 => 'IBM/TERSE or Xceed BWT', # APPNOTE has IBM/TERSE. Xceed reuses it unofficially
19 => 'IBM LZ77 z Architecture (PFS)',
- 20 => 'Ipaq8', # see https://encode.su/threads/1048-info-zip-lpaq8
+ 20 => 'Zstandard (Deprecated) or Ipaq8', # Deprecated ZStandard and see https://encode.su/threads/1048-info-zip-lpaq8
92 => 'Reference', # Winzip Only from version 25
93 => 'Zstandard',
94 => 'MP3',
@@ -4002,7 +4002,7 @@ sub walkExtra
# Belt & Braces - should now be at $endExtraOffset
# error here means issue in an extra handler
- # should noy happen, but just in case
+ # should not happen, but just in case
# TODO -- need tests for this
my $here = $FH->tell() ;
if ($here > $endExtraOffset)
@@ -4132,7 +4132,7 @@ sub walk_Zip64_in_LD
if ($assumeLengthsPresent || $assumeAllFieldsPresent || full32 $entry->std_uncompressedSize )
{
- # TODO defer a warning if in local header & central/local don't have std_uncompressedSizeset to 0xffffffff
+ # TODO defer a warning if in local header & central/local don't have std_uncompressedSize set to 0xffffffff
if (length $zip64Extended < 8)
{
my $message = extraFieldIdentifier($extraID) . ": Expected " . decimalHex0x(8) . " bytes for 'Uncompressed Size': only " . decimalHex0x(length $zip64Extended) . " bytes present";
@@ -4733,7 +4733,7 @@ sub decode_Minizip_Hash
# 0x1a51 Minizip Hash
# Definition in https://github.com/zlib-ng/minizip-ng/blob/master/doc/mz_extrafield.md#hash-0x1a51
- # caller ckecks there are at least 4 bytes available
+ # caller checks there are at least 4 bytes available
my $extraID = shift ;
my $len = shift;
my $entry = shift;
@@ -4975,13 +4975,21 @@ sub decode_Ux
out_v " GID";
}
-sub decodeLitteEndian
+sub canDecodeLittleEndian
+{
+ my $value = shift;
+
+ state $valid = { 0 => 1, 1 => 1, 2 => 1, 4 => 2, 8 => 1} ;
+ return $valid->{$value};
+}
+
+sub decodeLittleEndian
{
my $value = shift ;
if (length $value == 8)
{
- return unpackValueQ ($value)
+ return unpackValue_Q ($value)
}
elsif (length $value == 4)
{
@@ -4997,7 +5005,7 @@ sub decodeLitteEndian
}
else {
# TODO - fix this
- internalFatal undef, "unsupported decodeLitteEndian length '" . length ($value) . "'";
+ internalFatal undef, "unsupported decodeLittleEndian length '" . length ($value) . "'";
}
}
@@ -5032,9 +5040,21 @@ sub decode_ux
}
myRead(my $data, $uidSize);
- out2 $data, "UID", decodeLitteEndian($data);
+ if (canDecodeLittleEndian($uidSize))
+ {
+ out2 $data, "UID", decodeLittleEndian($data);
+ }
+ else
+ {
+ out2 $data, "UID", "Invalid UID Value: " . hexDump($data);
+ info $FH->tell() - $uidSize, extraFieldIdentifier($extraID) . ": UID value is not a valid value"
+ }
$available -= $uidSize ;
}
+ else
+ {
+ info $FH->tell() - 1, extraFieldIdentifier($extraID) . ": 'UID Size' should not be zero"
+ }
if ($available < 1)
{
@@ -5058,9 +5078,21 @@ sub decode_ux
}
myRead(my $data, $gidSize);
- out2 $data, "GID", decodeLitteEndian($data);
+ if (canDecodeLittleEndian($gidSize))
+ {
+ out2 $data, "GID", decodeLittleEndian($data);
+ }
+ else
+ {
+ out2 $data, "GID", "Invalid GID Value: " .hexDump($data);
+ info $FH->tell() - $gidSize, extraFieldIdentifier($extraID) . ": GID value is not a valid value"
+ }
$available -= $gidSize ;
}
+ else
+ {
+ info $FH->tell() - 1, extraFieldIdentifier($extraID) . ": 'GID Size' should not be zero"
+ }
}
@@ -5517,6 +5549,9 @@ sub peekAtOffset
my $offset = shift;
my $len = shift;
+ return undef
+ if $offset + $len > $FILELEN;
+
my $here = $FH->tell();
seekTo($offset) ;
@@ -5526,7 +5561,7 @@ sub peekAtOffset
seekTo($here);
length $buffer == $len
- or return '';
+ or return undef;
return $buffer;
}
@@ -5572,7 +5607,7 @@ sub chckForAPKSigningBlock
my $cdOffset = shift;
my $cdSize = shift;
- # APK Signing Block comes directy before the Central directory
+ # APK Signing Block comes directly before the Central directory
# See https://source.android.com/security/apksigning/v2
# If offset available is less than 44, it isn't an APK signing block
@@ -5735,7 +5770,7 @@ sub scanCentralDirectory
if (! full32 $locHeaderOffset)
{
# Check for corrupt offset
- # 1. ponting paset EOF
+ # 1. pointing paset EOF
# 2. offset points forward in the file
# 3. value at offset is not a CD record signature
@@ -5998,7 +6033,39 @@ sub findCentralDirectoryOffset
if (needZip64EOCDLocator($diskNumber, $cdDiskNumber, $entriesOnThisDisk, $totalEntries, $centralDirOffset, $centralDirSize) &&
! emptyArchive($here, $diskNumber, $cdDiskNumber, $entriesOnThisDisk, $totalEntries, $centralDirOffset, $centralDirSize))
{
+ # Possible/probable that need a zip64 record
+ # Must have if -- centralDirOffset > 0xFFFFFFFF or centralDirSize
+
+ my $want_zip64 = 0;
+
+ # Edge condition where centralDirOffset is exactly full32, but archive isn't a zip64 file
+ # Check if offset to central header is full32 and the central signature is not present
+ if (full32($centralDirOffset))
+ {
+ my $value = peekAtOffset($centralDirOffset, 4);
+ $want_zip64 = 1
+ if defined $value && unpack( "V", $value) != ZIP_CENTRAL_HDR_SIG ;
+ }
+
+ # Already past point of no return?
+ $want_zip64 = 1
+ if $here > MAX32 + ZIP_EOCD_MIN_SIZE + ZIP_CENTRAL_HDR_MIN_SIZE;
+
+ # may look like there should be a zip64 entry, but not always the case
+ {
+ my $gotSig = peekAtOffset($here - ZIP64_END_CENTRAL_LOC_HDR_SIZE, 4) ;
+ if (defined $gotSig && unpack("V", $gotSig) != ZIP64_END_CENTRAL_LOC_HDR_SIG)
+ {
+ warning $$here - ZIP64_END_CENTRAL_LOC_HDR_SIZE - 4, sprintf("Expected signature for " . Signatures::nameAndHex(ZIP64_END_CENTRAL_LOC_HDR_SIG) . " not found, got 0x%X", $gotSig);
+ }
+ else
+ {
+ $want_zip64 = 1;
+ }
+ }
+
($centralDirOffset, $centralDirSize) = offsetFromZip64($fh, $here, ZIP_EOCD_MIN_SIZE + $commentLength + $trailingBytes)
+ if $want_zip64;
}
elsif ($is64bit)
{
@@ -6131,7 +6198,7 @@ sub nibbles
{
package HeaderOffsetIndex;
- # Store a list of header offsets recorded when scannning the central directory
+ # Store a list of header offsets recorded when scanning the central directory
sub new
{
@@ -7546,7 +7613,7 @@ at hand to help understand the output fr
By default the program expects to be given a well-formed zip file. It will
navigate the zip file by first parsing the zip C<Central Directory> at the end
of the file. If the C<Central Directory> is found, it will then walk
-sequentally through the zip records starting at the beginning of the file.
+sequentially through the zip records starting at the beginning of the file.
See L<Advanced Analysis> for other processing options.
If the program finds any structural or portability issues with the zip file
@@ -7567,7 +7634,7 @@ C<--utc> option to display these fields
=head3 Filenames & Comments
Filenames and comments are decoded/encoded using the default system
-encoding of the host running C<zipdetails>. When the sytem encoding cannot
+encoding of the host running C<zipdetails>. When the system encoding cannot
be determined C<cp437> will be used.
The exceptions are
@@ -7605,7 +7672,7 @@ where the zip files contains sensitive d
=item C<--scan>
-Pessimistically scan the zip file loking for possible zip records. Can be
+Pessimistically scan the zip file looking for possible zip records. Can be
error-prone. For very large zip files this option is slow. Consider using
the C<--walk> option first. See L<"Advanced Analysis Options">
@@ -7915,7 +7982,7 @@ any zip metadata that is still present i
When either of these options is enabled, this program will bypass the
initial step of reading the C<Central Directory> at the end of the file and
simply scan the zip file sequentially from the start of the file looking
-for zip metedata records. Although this can be error prone, for the most
+for zip metadata records. Although this can be error prone, for the most
part it will find any zip file metadata that is still present in the file.
The difference between the two options is how aggressive the sequential
@@ -7933,7 +8000,7 @@ record and display it.
=head3 C<--walk>
The C<--walk> option optimistically assumes that it has found a real zip
-metatada record and so starts the scan for the next record directly after
+metadata record and so starts the scan for the next record directly after
the record it has just output.
=head3 C<--scan>
@@ -7942,8 +8009,8 @@ The C<--scan> option is pessimistic and
sequence may have been a false-positive, so before starting the scan for
the next resord, it will rewind to the location in the file directly after
the 4-byte sequecce it just processed. This means it will rescan data that
-has already been processed. For very lage zip files the C<--scan> option
-can be really realy slow, so trying the C<--walk> option first.
+has already been processed. For very large zip files the C<--scan> option
+can be really really slow, so trying the C<--walk> option first.
B<Important Note>: If the zip file being processed contains one or more
nested zip files, and the outer zip file uses the C<STORE> compression
@@ -7994,7 +8061,7 @@ can display the filenames using the C<--
A less common variation of this is where the C<EFS> bit is set, signalling
that the filename will be encoded in UTF-8, but the filename is not encoded
-in UTF-8. To deal with this scenarion, use the C<--no-language-encoding>
+in UTF-8. To deal with this scenario, use the C<--no-language-encoding>
option along with the C<--encoding> option.
Index: gnu/usr.bin/perl/cpan/IO-Compress/lib/File/GlobMapper.pm
===================================================================
RCS file: /home/afresh1/OpenBSD-perl/OP/cvs/src/gnu/usr.bin/perl/cpan/IO-Compress/lib/File/GlobMapper.pm,v
diff -u -p -a -u -p -r1.7 GlobMapper.pm
--- gnu/usr.bin/perl/cpan/IO-Compress/lib/File/GlobMapper.pm 28 Jan 2025 01:06:11 -0000 1.7
+++ gnu/usr.bin/perl/cpan/IO-Compress/lib/File/GlobMapper.pm 3 Jun 2026 01:35:40 -0000
@@ -29,6 +29,11 @@ our ($VERSION, @EXPORT_OK);
$VERSION = '1.001';
@EXPORT_OK = qw( globmap );
+our $BEGIN_DELIM = "\xFF";
+our $END_DELIM = "\xFE";
+our $BACKSLASH_ESC = "\xFD";
+our $HASH_ESC = "\xFC";
+our $STAR_ESC = "\xFB";
our ($noPreBS, $metachars, $matchMetaRE, %mapping, %wildCount);
$noPreBS = '(?<!\\\)' ; # no preceding backslash
@@ -310,14 +315,23 @@ sub _parseOutputGlob
}
my $noPreBS = '(?<!\\\)' ; # no preceding backslash
- #warn "noPreBS = '$noPreBS'\n";
+ my $noPreESC = '(?<![${BEGIN_DELIM}])' ; # no preceding backslash
- #$string =~ s/${noPreBS}\$(\d)/\${$1}/g;
- $string =~ s/${noPreBS}#(\d)/\${$1}/g;
- $string =~ s#${noPreBS}\*#\${inFile}#g;
- $string = '"' . $string . '"';
+ # escape any use of the delimiter symbols
+ # $string =~ s/(${BEGIN_DELIM}|${END_DELIM}|${BACKSLASH_ESC})/$1$1/g;
+
+ # escape \# and \*
+ $string =~ s/\\#/${HASH_ESC}/g;
+ $string =~ s/\\\*/${STAR_ESC}/g;
+
+ # Transform "#3" to BEGIN_DELIM 3 END_DELIM
+ $string =~ s/${noPreESC}#(\d)/${BEGIN_DELIM}${1}${END_DELIM}/g;
+
+ $string =~ s#\*#${BEGIN_DELIM}${END_DELIM}#g;
+
+ # print "INPUT '$self->{InputPattern}'\n";
+ # print "OUTPUT '$self->{OutputGlob}' => '$string'\n";
- #print "OUTPUT '$self->{OutputGlob}' => '$string'\n";
$self->{OutputPattern} = $string ;
return 1 ;
@@ -335,11 +349,31 @@ sub _getFiles
next if $inFiles{$inFile} ++ ;
my $outFile = $inFile ;
+ my @matches ;
+
+ my $noPreESC = '(?<![${BEGIN_DELIM}])' ; # no preceding backslash
- if ( $inFile =~ m/$self->{InputPattern}/ )
+ if (@matches = ($inFile =~ m/$self->{InputPattern}/ ))
{
- no warnings 'uninitialized';
- eval "\$outFile = $self->{OutputPattern};" ;
+ $outFile = $self->{OutputPattern};
+ my $ix = 1;
+
+ # get the filename glob
+ $outFile =~ s/${noPreESC}${BEGIN_DELIM}${END_DELIM}/$inFile/g;
+
+ # now each of the #1, #2,...
+ for my $pattern (@matches)
+ {
+ $outFile =~ s/${noPreESC}${BEGIN_DELIM}${ix}${END_DELIM}/$pattern/g;
+
+ ++ $ix;
+ }
+
+ # unescape
+ $outFile =~ s/${BEGIN_DELIM}${BEGIN_DELIM}/${BEGIN_DELIM}/g;
+ $outFile =~ s/${END_DELIM}${END_DELIM}/${END_DELIM}/g;
+ $outFile =~ s/${HASH_ESC}/#/g;
+ $outFile =~ s/${STAR_ESC}/*/g;
if (defined $outInMapping{$outFile})
{
Index: gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Unzip.pm
===================================================================
RCS file: /home/afresh1/OpenBSD-perl/OP/cvs/src/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Unzip.pm,v
diff -u -p -a -u -p -r1.10 Unzip.pm
--- gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Unzip.pm 26 Dec 2025 22:14:14 -0000 1.10
+++ gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Unzip.pm 3 Jun 2026 01:35:40 -0000
@@ -157,8 +157,8 @@ sub fastForward
while ($offset > 0)
{
- $c = length $offset
- if length $offset < $c ;
+ $c = $offset
+ if $offset < $c ;
$offset -= $c;
@@ -802,7 +802,14 @@ sub filterUncompressed
# from Archive::Zip & info-zip
sub _dosToUnixTime
{
+ # Returns zero when $dt is already zero or it doesn't expand to a value that Time::Local::timelocal()
+ # can handle.
+
my $dt = shift;
+ # warn "_dosToUnixTime dt=[$dt]\n";
+
+ # some zip files don't populate the datetime field at all
+ return 0 if ! $dt;
my $year = ( ( $dt >> 25 ) & 0x7f ) + 80;
my $mon = ( ( $dt >> 21 ) & 0x0f ) - 1;
@@ -813,10 +820,15 @@ sub _dosToUnixTime
my $sec = ( ( $dt << 1 ) & 0x3e );
use Time::Local ;
- my $time_t = Time::Local::timelocal( $sec, $min, $hour, $mday, $mon, $year);
+
+ my $time_t ;
+ # wrap in an eval to catch out of range errors
+ eval {
+ $time_t = Time::Local::timelocal( $sec, $min, $hour, $mday, $mon, $year);
+ } ;
+
return 0 if ! defined $time_t;
return $time_t;
-
}
#sub scanCentralDirectory
Index: gnu/usr.bin/perl/cpan/IO-Compress/t/globmapper.t
===================================================================
RCS file: /home/afresh1/OpenBSD-perl/OP/cvs/src/gnu/usr.bin/perl/cpan/IO-Compress/t/globmapper.t,v
diff -u -p -a -u -p -r1.1.1.4 globmapper.t
--- gnu/usr.bin/perl/cpan/IO-Compress/t/globmapper.t 28 Jan 2025 01:04:26 -0000 1.1.1.4
+++ gnu/usr.bin/perl/cpan/IO-Compress/t/globmapper.t 3 Jun 2026 01:35:40 -0000
@@ -24,7 +24,7 @@ Perl $]" )
$extra = 1
if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 };
- plan tests => 68 + $extra ;
+ plan tests => 76 + $extra ;
use_ok('File::GlobMapper') ;
}
@@ -287,6 +287,56 @@ Perl $]" )
[ [map { "$tmpDir/$_" } qw(abc1.tmp X-c1-a-X)],
[map { "$tmpDir/$_" } qw(abc2.tmp X-c2-a-X)],
[map { "$tmpDir/$_" } qw(abc3.tmp X-c3-a-X)],
+ ], " got mapping";
+}
+
+{
+ title "check escaping";
+
+ my $tmpDir ;#= 'td';
+ my $lex = LexDir->new( $tmpDir );
+
+ my $BEGIN_DELIM = "\xFF";
+ my $END_DELIM = "\xFE";
+
+ #mkdir $tmpDir, 0777 ;
+
+ touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
+
+ my $map = File::GlobMapper::globmap("$tmpDir/*b*.tmp", "$tmpDir/X-${BEGIN_DELIM}#2-#1${END_DELIM}-X");
+ ok $map, " got map"
+ or diag $File::GlobMapper::Error ;
+
+ is @{ $map }, 3, " returned 3 maps";
+ is_deeply $map,
+ [ [map { "$tmpDir/$_" } ("abc1.tmp", "X-${BEGIN_DELIM}c1-a${END_DELIM}-X")],
+ [map { "$tmpDir/$_" } ("abc2.tmp", "X-${BEGIN_DELIM}c2-a${END_DELIM}-X")],
+ [map { "$tmpDir/$_" } ("abc3.tmp", "X-${BEGIN_DELIM}c3-a${END_DELIM}-X")],
+ ], " got mapping";
+}
+
+{
+ title "check backslash escaping";
+
+ my $tmpDir ;#= 'td';
+ my $lex = LexDir->new( $tmpDir );
+
+ my $BEGIN_DELIM = "\xFF";
+ my $END_DELIM = "\xFE";
+
+ #mkdir $tmpDir, 0777 ;
+
+ touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
+
+ my $map = File::GlobMapper::globmap("$tmpDir/*b*.tmp", $tmpDir . '/X-#2-\\#1\\*-X');
+ ok $map, " got map"
+ or diag $File::GlobMapper::Error ;
+
+ is @{ $map }, 3, " returned 3 maps";
+ is_deeply $map,
+ [ [map { "$tmpDir/$_" } ("abc1.tmp", "X-c1-#1*-X")],
+ [map { "$tmpDir/$_" } ("abc2.tmp", "X-c2-#1*-X")],
+ [map { "$tmpDir/$_" } ("abc3.tmp", "X-c3-#1*-X")],
], " got mapping";
}
Misc perl CVE