In perl.git, the branch maint-5.20 has been updated <http://perl5.git.perl.org/perl.git/commitdiff/cfc90b2b0829bea5963af704be4e63364c6c1dca?hp=fddd3378eb45e847a158b24e8a72666195022c1f>
- Log ----------------------------------------------------------------- commit cfc90b2b0829bea5963af704be4e63364c6c1dca Author: Jarkko Hietaniemi <[email protected]> Date: Thu Jan 8 11:05:56 2015 +0000 Version multibump. (cherry picked from commit ef47896ba965ec9b7355dc35c9abb2289d1a01f7) [Edited by the committer to bump the $VERSION to a value that has not already been used and will not be used in the future.] M dist/PathTools/Cwd.pm M dist/PathTools/lib/File/Spec.pm M dist/PathTools/lib/File/Spec/Cygwin.pm M dist/PathTools/lib/File/Spec/Epoc.pm M dist/PathTools/lib/File/Spec/Functions.pm M dist/PathTools/lib/File/Spec/Mac.pm M dist/PathTools/lib/File/Spec/OS2.pm M dist/PathTools/lib/File/Spec/Unix.pm M dist/PathTools/lib/File/Spec/VMS.pm M dist/PathTools/lib/File/Spec/Win32.pm commit bbb630fde2346f8503ccf1e59755bbd2741e79a9 Author: kmx <[email protected]> Date: Tue Dec 16 09:00:16 2014 +0000 [perl #123436] installperl patch related to $Config{dlext} (cherry picked from commit dc5c2addf88baf2341663222a7ef79d1b8df8429) M installperl commit db9c98f69c5b0676c032120f0a7e7886128706c6 Author: Father Chrysostomos <[email protected]> Date: Sun Sep 28 12:39:28 2014 -0700 sv.c: Suppress compiler warning Cast to U32 explicitly now that arena_size is U32. See <https://rt.perl.org/Ticket/Display.html?id=122861#txn-1310985>. (cherry picked from commit cd1dc8e2c73be346de250a16f103fb9a97814dd3) M sv.c commit fd4f2fcbed2000cf0c07e6ef99c8f27e4daff0a1 Author: Craig A. Berry <[email protected]> Date: Sun Sep 21 17:36:27 2014 -0500 Fix distclean for "pm_to_blib directly" extensions. The values of the %pm hash already have ../../ prepended, so we were trying to remove, for example, ../../../../lib/Exporter.pm instead of ../../lib/Exporter.pm. This fixes [perl #122820] wherein it was reported that a distclean make left some build products under lib/. (cherry picked from commit 9fa5aa9143471cda101c2ac9e87f7bf90ccd0b36) M make_ext.pl commit 69e3c09e107b4bd9f9e0099d7ca02c9147c825be Author: Jarkko Hietaniemi <[email protected]> Date: Thu Sep 4 10:33:07 2014 -0400 Avoid gcc warning. Cwd.xs:200:50: warning: size argument in 'strlcat' call appears to be size of the source; expected the size of the destination [-Wstrlcpy-strlcat-size] No effective difference since both the source and destination are buf[MAXPATHLEN]. They are now. (cherry picked from commit b6250659892d3195c5d3ecd04773e78dc0ccd564) M dist/PathTools/Cwd.xs commit d4e5fd3b3435a1ae915c6cebb0f3bd473b1430b4 Author: Anthony Heading <[email protected]> Date: Thu Aug 28 19:10:06 2014 -0400 stat Makefile.PL to get values for utime. On certain machines, the file system timestamps are in local time, so assigning a timestamp based on a time() call is prone to jump timezones to UTC. Anthony Heading is now a Perl 5 author. For: RT #122609 (cherry picked from commit 648eb45f2e489e7cbdab09c65bccaac4a78ae3ee) M AUTHORS M make_ext.pl commit b6ec6b6f703a8a2e68283ebeac3f4b844db8a13f Author: Tony Cook <[email protected]> Date: Sat Dec 20 13:52:29 2014 +1100 PerlIO::scalar: skip the 4GB seek test if off_t is too small (cherry picked from commit 9745959a89f3a201c789b8e4ce494405f95b2a7a) M ext/PerlIO-scalar/t/scalar.t commit d1d885e3d7f449604331e532941d7714a16019c4 Author: Tony Cook <[email protected]> Date: Thu Jan 8 09:22:58 2015 +0000 perldelta for 696efa16de2c (cherry picked from commit aa67537dafc18272058c189caa550b90c78f79f2) M pod/perldelta.pod commit 78dfdef96513325462bc13b446dae272fcfedd83 Author: Tony Cook <[email protected]> Date: Thu Dec 18 14:48:34 2014 +1100 fix PerlIO::scalar get_cnt when the file position is beyond 2GB This caused a new test to fail on 32-bit builds. (cherry picked from commit 696efa16de2cd1abedf24104d680f3d0983587f4) M ext/PerlIO-scalar/scalar.xs commit bc1e1a8817e03dd780c02f16003b56b973fefb14 Author: Tony Cook <[email protected]> Date: Thu Jan 8 09:21:00 2015 +0000 perldelta for 63d073d27fe5, 1d050e5534ce (cherry picked from commit b045b8b598844ddce261c725f3596c9336b42b79) M pod/perldelta.pod commit b723ab54413b0eb89537c4e6d190b8aa5d31e0b7 Author: Tony Cook <[email protected]> Date: Wed Dec 17 13:54:25 2014 +1100 don't allow a negative file position on a PerlIO::scalar handle previosly seek() would produce an error, but would still make the\ file position negative. (cherry picked from commit 1d050e5534ce798acb8f9cd9c56c9f557ec658e0) M ext/PerlIO-scalar/scalar.xs M ext/PerlIO-scalar/t/scalar.t commit f44f3aca29e1d38144aebebf143ac415a260f2d9 Author: Tony Cook <[email protected]> Date: Thu Jan 8 09:17:18 2015 +0000 [perl #123443] avoid overflowing got into a negative number (cherry picked from commit 63d073d27fe50d823f0e3c528ac62c9aa584704d) [Edited by the committer to bump the $VERSION to a value that has not already been used and will not be used in the future.] M ext/PerlIO-scalar/scalar.pm M ext/PerlIO-scalar/scalar.xs M ext/PerlIO-scalar/t/scalar.t commit b5b8a0967682a5a4341453d0a0c58cb76b69097b Author: Tony Cook <[email protected]> Date: Wed Dec 10 13:12:59 2014 +1100 perldelta for fcaef4dc8ca9, fb9282c3ccd3 (cherry picked from commit 279aef25246e63a7be992e42d2b92e22a892263e) M pod/perldelta.pod commit e556b61fd4fe733fe48122f3f7c593c467978262 Author: Tony Cook <[email protected]> Date: Wed Dec 10 11:54:49 2014 +1100 [perl #123245] avoid a panic in sv_chop() in formats This fixes two issues: 1) if you don't supply enough arguments to the format, pp_formline() uses &PL_sv_no as the sv, since we've already warned about the missing format argument, we don't need to produce a read only error for an SV the caller didn't supply 2) when the supplied string is empty for FF_LINESNGL and FF_LINEGLOB the case would skip most of its processing, including setting chophere, this meant that when the following FF_CHOP operator was processed it would pass a pointer into a different string, producing a panic. (cherry picked from commit fb9282c3ccd3b3c2e184a3158c46c930c23f30fb) M pp_ctl.c M t/op/write.t commit 9ee3a895856cc0db5a367f4fe57cb7267f4cc934 Author: Tony Cook <[email protected]> Date: Wed Dec 10 11:51:39 2014 +1100 [perl #123245] tests for format crashes (cherry picked from commit fcaef4dc8ca94ff0fe27bf4a249a5583ca0e7af5) M t/op/write.t commit dce259271d619165987f8d91e78883314aafd2b0 Author: Steffen Mueller <[email protected]> Date: Thu Jan 8 09:08:52 2015 +0000 Data::Dumper version bump for CPAN release (cherry picked from commit fa10264e34d420edf76a46139faa3277c0b96a2b) [Edited by the committer to bump the $VERSION to a value that has not already been used and will not be used in the future.] M dist/Data-Dumper/Dumper.pm commit bfb693376f3f32768848ae5bbb0a003b9ea7137d Author: Tony Cook <[email protected]> Date: Thu Jan 8 09:06:53 2015 +0000 don't recurse infinitely in Data::Dumper Add a configuration variable/option to limit recursion when dumping deep data structures. Defaults the limit to 1000, which can be reduced or increase, or eliminated by setting it to 0. This patch addresses CVE-2014-4330. This bug was found and reported by: LSE Leading Security Experts GmbH employee Markus Vervier. (cherry picked from commit 19be3be6968e2337bcdfe480693fff795ecd1304) [Edited by the committer to bump the $VERSION to a value that has not already been used and will not be used in the future.] M MANIFEST M dist/Data-Dumper/Dumper.pm M dist/Data-Dumper/Dumper.xs A dist/Data-Dumper/t/recurse.t ----------------------------------------------------------------------- Summary of changes: AUTHORS | 1 + MANIFEST | 1 + dist/Data-Dumper/Dumper.pm | 27 +++++++++++++++++-- dist/Data-Dumper/Dumper.xs | 32 +++++++++++++++------- dist/Data-Dumper/t/recurse.t | 45 +++++++++++++++++++++++++++++++ dist/PathTools/Cwd.pm | 2 +- dist/PathTools/Cwd.xs | 2 +- dist/PathTools/lib/File/Spec.pm | 2 +- dist/PathTools/lib/File/Spec/Cygwin.pm | 2 +- dist/PathTools/lib/File/Spec/Epoc.pm | 2 +- dist/PathTools/lib/File/Spec/Functions.pm | 2 +- dist/PathTools/lib/File/Spec/Mac.pm | 2 +- dist/PathTools/lib/File/Spec/OS2.pm | 2 +- dist/PathTools/lib/File/Spec/Unix.pm | 2 +- dist/PathTools/lib/File/Spec/VMS.pm | 2 +- dist/PathTools/lib/File/Spec/Win32.pm | 2 +- ext/PerlIO-scalar/scalar.pm | 2 +- ext/PerlIO-scalar/scalar.xs | 27 +++++++++++++------ ext/PerlIO-scalar/t/scalar.t | 21 ++++++++++++++- installperl | 2 +- make_ext.pl | 6 ++--- pod/perldelta.pod | 19 +++++++++++++ pp_ctl.c | 4 +-- sv.c | 4 +-- t/op/write.t | 26 +++++++++++++++++- 25 files changed, 198 insertions(+), 41 deletions(-) create mode 100644 dist/Data-Dumper/t/recurse.t diff --git a/AUTHORS b/AUTHORS index 8737576..dcbbfd5 100644 --- a/AUTHORS +++ b/AUTHORS @@ -101,6 +101,7 @@ Andy Dougherty <[email protected]> Andy Lester <[email protected]> Anno Siegel <[email protected]> Anthony David <[email protected]> +Anthony Heading <[email protected]> Anton Berezin <[email protected]> Anton Nikishaev <[email protected]> Anton Tagunov <[email protected]> diff --git a/MANIFEST b/MANIFEST index b29a799..2325ff3 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2994,6 +2994,7 @@ dist/Data-Dumper/t/perl-74170.t Regression test for stack reallocation dist/Data-Dumper/t/purity_deepcopy_maxdepth.t See if three Data::Dumper functions work dist/Data-Dumper/t/qr.t See if Data::Dumper works with qr|/| dist/Data-Dumper/t/quotekeys.t See if Data::Dumper::Quotekeys works +dist/Data-Dumper/t/recurse.t See if Data::Dumper::Maxrecurse works dist/Data-Dumper/t/seen.t See if Data::Dumper::Seen works dist/Data-Dumper/t/sortkeys.t See if Data::Dumper::Sortkeys works dist/Data-Dumper/t/sparseseen.t See if Data::Dumper::Sparseseen works diff --git a/dist/Data-Dumper/Dumper.pm b/dist/Data-Dumper/Dumper.pm index 7c8a72c..a084712 100644 --- a/dist/Data-Dumper/Dumper.pm +++ b/dist/Data-Dumper/Dumper.pm @@ -10,7 +10,7 @@ package Data::Dumper; BEGIN { - $VERSION = '2.151'; # Don't forget to set version and release + $VERSION = '2.151_01'; # Don't forget to set version and release } # date in POD below! #$| = 1; @@ -56,6 +56,7 @@ $Useperl = 0 unless defined $Useperl; $Sortkeys = 0 unless defined $Sortkeys; $Deparse = 0 unless defined $Deparse; $Sparseseen = 0 unless defined $Sparseseen; +$Maxrecurse = 1000 unless defined $Maxrecurse; # # expects an arrayref of values to be dumped. @@ -92,6 +93,7 @@ sub new { 'bless' => $Bless, # keyword to use for "bless" # expdepth => $Expdepth, # cutoff depth for explicit dumping maxdepth => $Maxdepth, # depth beyond which we give up + maxrecurse => $Maxrecurse, # depth beyond which we abort useperl => $Useperl, # use the pure Perl implementation sortkeys => $Sortkeys, # flag or filter for sorting hash keys deparse => $Deparse, # use B::Deparse for coderefs @@ -350,6 +352,12 @@ sub _dump { return qq['$val']; } + # avoid recursing infinitely [perl #122111] + if ($s->{maxrecurse} > 0 + and $s->{level} >= $s->{maxrecurse}) { + die "Recursion limit of $s->{maxrecurse} exceeded"; + } + # we have a blessed ref my ($blesspad); if ($realpack and !$no_bless) { @@ -680,6 +688,11 @@ sub Maxdepth { defined($v) ? (($s->{'maxdepth'} = $v), return $s) : $s->{'maxdepth'}; } +sub Maxrecurse { + my($s, $v) = @_; + defined($v) ? (($s->{'maxrecurse'} = $v), return $s) : $s->{'maxrecurse'}; +} + sub Useperl { my($s, $v) = @_; defined($v) ? (($s->{'useperl'} = $v), return $s) : $s->{'useperl'}; @@ -1105,6 +1118,16 @@ no maximum depth. =item * +$Data::Dumper::Maxrecurse I<or> $I<OBJ>->Maxrecurse(I<[NEWVAL]>) + +Can be set to a positive integer that specifies the depth beyond which +recursion into a structure will throw an exception. This is intended +as a security measure to prevent perl running out of stack space when +dumping an excessively deep structure. Can be set to 0 to remove the +limit. Default is 1000. + +=item * + $Data::Dumper::Useperl I<or> $I<OBJ>->Useperl(I<[NEWVAL]>) Can be set to a boolean value which controls whether the pure Perl @@ -1398,7 +1421,7 @@ modify it under the same terms as Perl itself. =head1 VERSION -Version 2.151 (March 7 2014) +Version 2.151_01 (January 8 2015) =head1 SEE ALSO diff --git a/dist/Data-Dumper/Dumper.xs b/dist/Data-Dumper/Dumper.xs index 12c4ebd..49937be 100644 --- a/dist/Data-Dumper/Dumper.xs +++ b/dist/Data-Dumper/Dumper.xs @@ -28,7 +28,7 @@ static I32 DD_dump (pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, SV *pad, SV *xpad, SV *apad, SV *sep, SV *pair, SV *freezer, SV *toaster, I32 purity, I32 deepcopy, I32 quotekeys, SV *bless, - I32 maxdepth, SV *sortkeys, int use_sparse_seen_hash, I32 useqq); + I32 maxdepth, SV *sortkeys, int use_sparse_seen_hash, I32 useqq, IV maxrecurse); #ifndef HvNAME_get #define HvNAME_get HvNAME @@ -412,7 +412,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv, AV *postav, I32 *levelp, I32 indent, SV *pad, SV *xpad, SV *apad, SV *sep, SV *pair, SV *freezer, SV *toaster, I32 purity, I32 deepcopy, I32 quotekeys, SV *bless, I32 maxdepth, SV *sortkeys, - int use_sparse_seen_hash, I32 useqq) + int use_sparse_seen_hash, I32 useqq, IV maxrecurse) { char tmpbuf[128]; Size_t i; @@ -589,6 +589,10 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv, return 1; } + if (maxrecurse > 0 && *levelp >= maxrecurse) { + croak("Recursion limit of %" IVdf " exceeded", maxrecurse); + } + if (realpack && !no_bless) { /* we have a blessed ref */ STRLEN blesslen; const char * const blessstr = SvPV(bless, blesslen); @@ -674,7 +678,8 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv, DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv, postav, levelp, indent, pad, xpad, apad, sep, pair, freezer, toaster, purity, deepcopy, quotekeys, bless, - maxdepth, sortkeys, use_sparse_seen_hash, useqq); + maxdepth, sortkeys, use_sparse_seen_hash, useqq, + maxrecurse); sv_catpvn(retval, ")}", 2); } /* plain */ else { @@ -682,7 +687,8 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv, DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv, postav, levelp, indent, pad, xpad, apad, sep, pair, freezer, toaster, purity, deepcopy, quotekeys, bless, - maxdepth, sortkeys, use_sparse_seen_hash, useqq); + maxdepth, sortkeys, use_sparse_seen_hash, useqq, + maxrecurse); } SvREFCNT_dec(namesv); } @@ -694,7 +700,8 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv, DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv, postav, levelp, indent, pad, xpad, apad, sep, pair, freezer, toaster, purity, deepcopy, quotekeys, bless, - maxdepth, sortkeys, use_sparse_seen_hash, useqq); + maxdepth, sortkeys, use_sparse_seen_hash, useqq, + maxrecurse); SvREFCNT_dec(namesv); } else if (realtype == SVt_PVAV) { @@ -767,7 +774,8 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv, DD_dump(aTHX_ elem, iname, ilen, retval, seenhv, postav, levelp, indent, pad, xpad, apad, sep, pair, freezer, toaster, purity, deepcopy, quotekeys, bless, - maxdepth, sortkeys, use_sparse_seen_hash, useqq); + maxdepth, sortkeys, use_sparse_seen_hash, + useqq, maxrecurse); if (ix < ixmax) sv_catpvn(retval, ",", 1); } @@ -970,7 +978,8 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv, DD_dump(aTHX_ hval, SvPVX_const(sname), SvCUR(sname), retval, seenhv, postav, levelp, indent, pad, xpad, newapad, sep, pair, freezer, toaster, purity, deepcopy, quotekeys, bless, - maxdepth, sortkeys, use_sparse_seen_hash, useqq); + maxdepth, sortkeys, use_sparse_seen_hash, useqq, + maxrecurse); SvREFCNT_dec(sname); Safefree(nkey_buffer); if (indent >= 2) @@ -1179,7 +1188,8 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv, seenhv, postav, &nlevel, indent, pad, xpad, newapad, sep, pair, freezer, toaster, purity, deepcopy, quotekeys, bless, maxdepth, - sortkeys, use_sparse_seen_hash, useqq); + sortkeys, use_sparse_seen_hash, useqq, + maxrecurse); SvREFCNT_dec(e); } } @@ -1269,6 +1279,7 @@ Data_Dumper_Dumpxs(href, ...) SV *val, *name, *pad, *xpad, *apad, *sep, *pair, *varname; SV *freezer, *toaster, *bless, *sortkeys; I32 purity, deepcopy, quotekeys, maxdepth = 0; + IV maxrecurse = 1000; char tmpbuf[1024]; I32 gimme = GIMME; int use_sparse_seen_hash = 0; @@ -1355,6 +1366,8 @@ Data_Dumper_Dumpxs(href, ...) bless = *svp; if ((svp = hv_fetch(hv, "maxdepth", 8, FALSE))) maxdepth = SvIV(*svp); + if ((svp = hv_fetch(hv, "maxrecurse", 10, FALSE))) + maxrecurse = SvIV(*svp); if ((svp = hv_fetch(hv, "sortkeys", 8, FALSE))) { sortkeys = *svp; if (! SvTRUE(sortkeys)) @@ -1434,7 +1447,8 @@ Data_Dumper_Dumpxs(href, ...) DD_dump(aTHX_ val, SvPVX_const(name), SvCUR(name), valstr, seenhv, postav, &level, indent, pad, xpad, newapad, sep, pair, freezer, toaster, purity, deepcopy, quotekeys, - bless, maxdepth, sortkeys, use_sparse_seen_hash, useqq); + bless, maxdepth, sortkeys, use_sparse_seen_hash, + useqq, maxrecurse); SPAGAIN; if (indent >= 2 && !terse) diff --git a/dist/Data-Dumper/t/recurse.t b/dist/Data-Dumper/t/recurse.t new file mode 100644 index 0000000..275a89d --- /dev/null +++ b/dist/Data-Dumper/t/recurse.t @@ -0,0 +1,45 @@ +#!perl + +# Test the Maxrecurse option + +use strict; +use Test::More tests => 32; +use Data::Dumper; + +SKIP: { + skip "no XS available", 16 + if $Data::Dumper::Useperl; + local $Data::Dumper::Useperl = 1; + test_recursion(); +} + +test_recursion(); + +sub test_recursion { + my $pp = $Data::Dumper::Useperl ? "pure perl" : "XS"; + $Data::Dumper::Purity = 1; # make sure this has no effect + $Data::Dumper::Indent = 0; + $Data::Dumper::Maxrecurse = 1; + is(eval { Dumper([]) }, '$VAR1 = [];', "$pp: maxrecurse 1, []"); + is(eval { Dumper([[]]) }, undef, "$pp: maxrecurse 1, [[]]"); + ok($@, "exception thrown"); + is(eval { Dumper({}) }, '$VAR1 = {};', "$pp: maxrecurse 1, {}"); + is(eval { Dumper({ a => 1 }) }, q($VAR1 = {'a' => 1};), + "$pp: maxrecurse 1, { a => 1 }"); + is(eval { Dumper({ a => {} }) }, undef, "$pp: maxrecurse 1, { a => {} }"); + ok($@, "exception thrown"); + is(eval { Dumper(\1) }, "\$VAR1 = \\1;", "$pp: maxrecurse 1, \\1"); + is(eval { Dumper(\\1) }, undef, "$pp: maxrecurse 1, \\1"); + ok($@, "exception thrown"); + $Data::Dumper::Maxrecurse = 3; + is(eval { Dumper(\1) }, "\$VAR1 = \\1;", "$pp: maxrecurse 3, \\1"); + is(eval { Dumper(\(my $s = {})) }, "\$VAR1 = \\{};", "$pp: maxrecurse 3, \\{}"); + is(eval { Dumper(\(my $s = { a => [] })) }, "\$VAR1 = \\{'a' => []};", + "$pp: maxrecurse 3, \\{ a => [] }"); + is(eval { Dumper(\(my $s = { a => [{}] })) }, undef, + "$pp: maxrecurse 3, \\{ a => [{}] }"); + ok($@, "exception thrown"); + $Data::Dumper::Maxrecurse = 0; + is(eval { Dumper([[[[[]]]]]) }, q($VAR1 = [[[[[]]]]];), + "$pp: check Maxrecurse doesn't set limit to 0 recursion"); +} diff --git a/dist/PathTools/Cwd.pm b/dist/PathTools/Cwd.pm index 01393f3..210ea32 100644 --- a/dist/PathTools/Cwd.pm +++ b/dist/PathTools/Cwd.pm @@ -171,7 +171,7 @@ use strict; use Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); -$VERSION = '3.48'; +$VERSION = '3.48_01'; my $xs_version = $VERSION; $VERSION =~ tr/_//; diff --git a/dist/PathTools/Cwd.xs b/dist/PathTools/Cwd.xs index 4ddbdac..1f174bf 100644 --- a/dist/PathTools/Cwd.xs +++ b/dist/PathTools/Cwd.xs @@ -197,7 +197,7 @@ bsd_realpath(const char *path, char resolved[MAXPATHLEN]) symlink[slen] = '/'; symlink[slen + 1] = 0; } - left_len = my_strlcat(symlink, left, sizeof(left)); + left_len = my_strlcat(symlink, left, sizeof(symlink)); if (left_len >= sizeof(left)) { errno = ENAMETOOLONG; return (NULL); diff --git a/dist/PathTools/lib/File/Spec.pm b/dist/PathTools/lib/File/Spec.pm index bf0a327..01a616e 100644 --- a/dist/PathTools/lib/File/Spec.pm +++ b/dist/PathTools/lib/File/Spec.pm @@ -3,7 +3,7 @@ package File::Spec; use strict; use vars qw(@ISA $VERSION); -$VERSION = '3.48'; +$VERSION = '3.48_01'; $VERSION =~ tr/_//; my %module = (MacOS => 'Mac', diff --git a/dist/PathTools/lib/File/Spec/Cygwin.pm b/dist/PathTools/lib/File/Spec/Cygwin.pm index a791a2a..b9e3703 100644 --- a/dist/PathTools/lib/File/Spec/Cygwin.pm +++ b/dist/PathTools/lib/File/Spec/Cygwin.pm @@ -4,7 +4,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.48'; +$VERSION = '3.48_01'; $VERSION =~ tr/_//; @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/Epoc.pm b/dist/PathTools/lib/File/Spec/Epoc.pm index a7859c5..e5928b835 100644 --- a/dist/PathTools/lib/File/Spec/Epoc.pm +++ b/dist/PathTools/lib/File/Spec/Epoc.pm @@ -3,7 +3,7 @@ package File::Spec::Epoc; use strict; use vars qw($VERSION @ISA); -$VERSION = '3.48'; +$VERSION = '3.48_01'; $VERSION =~ tr/_//; require File::Spec::Unix; diff --git a/dist/PathTools/lib/File/Spec/Functions.pm b/dist/PathTools/lib/File/Spec/Functions.pm index 0170843..451f5bd 100644 --- a/dist/PathTools/lib/File/Spec/Functions.pm +++ b/dist/PathTools/lib/File/Spec/Functions.pm @@ -5,7 +5,7 @@ use strict; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); -$VERSION = '3.48'; +$VERSION = '3.48_01'; $VERSION =~ tr/_//; require Exporter; diff --git a/dist/PathTools/lib/File/Spec/Mac.pm b/dist/PathTools/lib/File/Spec/Mac.pm index a8dc2df..b0aacec 100644 --- a/dist/PathTools/lib/File/Spec/Mac.pm +++ b/dist/PathTools/lib/File/Spec/Mac.pm @@ -4,7 +4,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.48'; +$VERSION = '3.48_01'; $VERSION =~ tr/_//; @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/OS2.pm b/dist/PathTools/lib/File/Spec/OS2.pm index df458c9..7de0f89 100644 --- a/dist/PathTools/lib/File/Spec/OS2.pm +++ b/dist/PathTools/lib/File/Spec/OS2.pm @@ -4,7 +4,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.48'; +$VERSION = '3.48_01'; $VERSION =~ tr/_//; @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/Unix.pm b/dist/PathTools/lib/File/Spec/Unix.pm index e4eddbb..c813cc1 100644 --- a/dist/PathTools/lib/File/Spec/Unix.pm +++ b/dist/PathTools/lib/File/Spec/Unix.pm @@ -3,7 +3,7 @@ package File::Spec::Unix; use strict; use vars qw($VERSION); -$VERSION = '3.48'; +$VERSION = '3.48_01'; my $xs_version = $VERSION; $VERSION =~ tr/_//; diff --git a/dist/PathTools/lib/File/Spec/VMS.pm b/dist/PathTools/lib/File/Spec/VMS.pm index b045e27..3072fab 100644 --- a/dist/PathTools/lib/File/Spec/VMS.pm +++ b/dist/PathTools/lib/File/Spec/VMS.pm @@ -4,7 +4,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.48'; +$VERSION = '3.48_01'; $VERSION =~ tr/_//; @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/Win32.pm b/dist/PathTools/lib/File/Spec/Win32.pm index 352ec99..6c063b5 100644 --- a/dist/PathTools/lib/File/Spec/Win32.pm +++ b/dist/PathTools/lib/File/Spec/Win32.pm @@ -5,7 +5,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.48'; +$VERSION = '3.48_01'; $VERSION =~ tr/_//; @ISA = qw(File::Spec::Unix); diff --git a/ext/PerlIO-scalar/scalar.pm b/ext/PerlIO-scalar/scalar.pm index 7581f84..7e93f6d 100644 --- a/ext/PerlIO-scalar/scalar.pm +++ b/ext/PerlIO-scalar/scalar.pm @@ -1,5 +1,5 @@ package PerlIO::scalar; -our $VERSION = '0.18'; +our $VERSION = '0.18_01'; require XSLoader; XSLoader::load(); 1; diff --git a/ext/PerlIO-scalar/scalar.xs b/ext/PerlIO-scalar/scalar.xs index 8d217c9..5c5eccf 100644 --- a/ext/PerlIO-scalar/scalar.xs +++ b/ext/PerlIO-scalar/scalar.xs @@ -103,28 +103,33 @@ IV PerlIOScalar_seek(pTHX_ PerlIO * f, Off_t offset, int whence) { PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar); + Off_t new_posn; switch (whence) { case SEEK_SET: - s->posn = offset; + new_posn = offset; break; case SEEK_CUR: - s->posn = offset + s->posn; + new_posn = offset + s->posn; break; case SEEK_END: { STRLEN oldcur; (void)SvPV(s->var, oldcur); - s->posn = offset + oldcur; + new_posn = offset + oldcur; break; } + default: + SETERRNO(EINVAL, SS_IVCHAN); + return -1; } - if (s->posn < 0) { + if (new_posn < 0) { if (ckWARN(WARN_LAYER)) Perl_warner(aTHX_ packWARN(WARN_LAYER), "Offset outside string"); SETERRNO(EINVAL, SS_IVCHAN); return -1; } + s->posn = new_posn; return 0; } @@ -151,7 +156,7 @@ PerlIOScalar_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) SV *sv = s->var; char *p; STRLEN len; - I32 got; + STRLEN got; p = SvPV(sv, len); if (SvUTF8(sv)) { if (sv_utf8_downgrade(sv, TRUE)) { @@ -164,9 +169,15 @@ PerlIOScalar_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) return -1; } } - got = len - (STRLEN)(s->posn); - if (got <= 0) + /* I assume that Off_t is at least as large as len (which + * seems safe) and that the size of the buffer in our SV is + * always less than half the size of the address space + */ + assert(sizeof(Off_t) >= sizeof(len)); + assert((Off_t)len >= 0); + if ((Off_t)len <= s->posn) return 0; + got = len - (STRLEN)(s->posn); if ((STRLEN)got > (STRLEN)count) got = (STRLEN)count; Copy(p + (STRLEN)(s->posn), vbuf, got, STDCHAR); @@ -265,7 +276,7 @@ PerlIOScalar_get_cnt(pTHX_ PerlIO * f) PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar); STRLEN len; (void)SvPV(s->var,len); - if (len > (STRLEN) s->posn) + if ((Off_t)len > s->posn) return len - (STRLEN)s->posn; else return 0; diff --git a/ext/PerlIO-scalar/t/scalar.t b/ext/PerlIO-scalar/t/scalar.t index 9bc1abe..f4cfbef 100644 --- a/ext/PerlIO-scalar/t/scalar.t +++ b/ext/PerlIO-scalar/t/scalar.t @@ -16,7 +16,7 @@ use Fcntl qw(SEEK_SET SEEK_CUR SEEK_END); # Not 0, 1, 2 everywhere. $| = 1; -use Test::More tests => 114; +use Test::More tests => 120; my $fh; my $var = "aaa\n"; @@ -491,3 +491,22 @@ my $byte_warning = "Strings with code points over 0xFF may not be mapped into in print $refh "boo\n"; is $x, $as_string."boo\n", 'string gets appended to ref'; } + +SKIP: +{ # [perl #123443] + skip "Can't seek over 4GB with a small off_t", 4 + if $Config::Config{lseeksize} < 8; + my $buf0 = "hello"; + open my $fh, "<", \$buf0 or die $!; + ok(seek($fh, 2**32, SEEK_SET), "seek to a large position"); + is(read($fh, my $tmp, 1), 0, "read from a large offset"); + is($tmp, "", "should have read nothing"); + ok(eof($fh), "fh should be eof"); +} + +{ + my $buf0 = "hello"; + open my $fh, "<", \$buf0 or die $!; + ok(!seek($fh, -10, SEEK_CUR), "seek to negative position"); + is(tell($fh), 0, "shouldn't change the position"); +} diff --git a/installperl b/installperl index 5acc06a..594f045 100755 --- a/installperl +++ b/installperl @@ -260,7 +260,7 @@ if (($Is_W32 and ! $Is_NetWare) or $Is_Cygwin) { if ($Is_Cygwin) { $perldll = $libperl; } else { - $perldll = 'perl5'.$Config{patchlevel}.'.'.$dlext; + $perldll = 'perl5'.$Config{patchlevel}.'.'.$so; } if ($dlsrc ne "dl_none.xs") { diff --git a/make_ext.pl b/make_ext.pl index b433762..e647aa9 100644 --- a/make_ext.pl +++ b/make_ext.pl @@ -443,8 +443,8 @@ EOM # the Makefile.PL. Altering the atime and mtime backwards by 4 # seconds seems to resolve the issue. eval { - my $ftime = time - 4; - utime $ftime, $ftime, 'Makefile.PL'; + my $ftime = (stat('Makefile.PL'))[9] - 4; + utime $ftime, $ftime, 'Makefile.PL'; }; } elsif ($mname =~ /\A(?:Carp |ExtUtils::CBuilder @@ -715,7 +715,7 @@ sub just_pm_to_blib { # (which it has to deal with, as cpan/foo/bar creates # lib/auto/foo/bar, but the EU::MM rule will only # rmdir lib/auto/foo/bar, leaving lib/auto/foo - _unlink("../../$_") + _unlink($_) foreach sort values %pm; } } diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 455dc2b..3dda751 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -124,6 +124,19 @@ L<attributes> has been upgraded from version 0.22 to 0.23. The usage of C<memEQs> in the XS has been corrected. L<[perl #122701]|https://rt.perl.org/Ticket/Display.html?id=122701> +=item * + +L<PerlIO::scalar> has been upgraded from version 0.20 to 0.21. + +Reading from a position well past the end of the scalar now correctly +returns end of file. [perl #123443] + +Seeking to a negative position still fails, but no longer leaves the +file position set to a negation location. + +C<eof()> on a C<PerlIO::scalar> handle now properly returns true when +the file position is past the 2GB mark on 32-bit systems. + =back =head2 Removed Modules and Pragmata @@ -391,6 +404,12 @@ process). [perl #40565] Tainted constants evaluated at compile time no longer cause unrelated statements to become tainted. [perl #122669] +=item * + +Calling C<write> on a format with a C<^**> field could produce a panic +in sv_chop() if there were insufficient arguments or if the variable +used to fill the field was empty. [perl #123245] + =back =head1 Known Problems diff --git a/pp_ctl.c b/pp_ctl.c index 39b7941..1a86251 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -678,7 +678,7 @@ PP(pp_formline) goto append; case FF_CHOP: /* (for ^*) chop the current item */ - { + if (sv != &PL_sv_no) { const char *s = chophere; if (chopspace) { while (isSPACE(*s)) @@ -704,11 +704,11 @@ PP(pp_formline) const char *const send = s + len; item_is_utf8 = DO_UTF8(sv); + chophere = s + len; if (!len) break; trans = 0; gotsome = TRUE; - chophere = s + len; source = (U8 *) s; to_copy = len; while (s < send) { diff --git a/sv.c b/sv.c index 49d8f11..6489468 100644 --- a/sv.c +++ b/sv.c @@ -928,9 +928,9 @@ struct body_details { ? count * body_size \ : FIT_ARENA0 (body_size) #define FIT_ARENA(count,body_size) \ - count \ + (U32)(count \ ? FIT_ARENAn (count, body_size) \ - : FIT_ARENA0 (body_size) + : FIT_ARENA0 (body_size)) /* Calculate the length to copy. Specifically work out the length less any final padding the compiler needed to add. See the comment in sv_upgrade diff --git a/t/op/write.t b/t/op/write.t index 7591cde..a0172ee 100644 --- a/t/op/write.t +++ b/t/op/write.t @@ -98,7 +98,7 @@ for my $tref ( @NumTests ){ my $bas_tests = 21; # number of tests in section 3 -my $bug_tests = 66 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 4 + 2 + 3 + 96 + 11; +my $bug_tests = 66 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 4 + 2 + 3 + 96 + 11 + 2; # number of tests in section 4 my $hmb_tests = 37; @@ -1935,6 +1935,30 @@ format Potshriggley = is $x, undef, 'formats in subs do not leak'; } +fresh_perl_is(<<'EOP', <<'EXPECT', +use warnings 'syntax' ; +format STDOUT = +^*|^* +my $x = q/dd/, $x +. +write; +EOP +dd| +EXPECT + { stderr => 1 }, '#123245 panic in sv_chop'); + +fresh_perl_is(<<'EOP', <<'EXPECT', +use warnings 'syntax' ; +format STDOUT = +^*|^* +my $x = q/dd/ +. +write; +EOP +Not enough format arguments at - line 4. +dd| +EXPECT + { stderr => 1 }, '#123245 different panic in sv_chop'); ############################# ## Section 4 -- Perl5 Master Repository
