From: Andrew Hewus Fresh Subject: Misc perl CVE To: tech@openbsd.org Date: Thu, 4 Jun 2026 18:37:57 -0700 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, 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 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 at the end of the file. If the C 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 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. When the sytem encoding cannot +encoding of the host running C. When the system encoding cannot be determined C 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 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: If the zip file being processed contains one or more nested zip files, and the outer zip file uses the C compression @@ -7994,7 +8061,7 @@ can display the filenames using the C<-- A less common variation of this is where the C 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 = '(?{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 = '(?{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"; }