summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTony Cook <tony@develop-help.com>2019-04-15 15:23:32 +1000
committerSteve Hay <steve.m.hay@googlemail.com>2020-12-26 14:50:15 +0000
commit776be7c3edd492f9b471f722b6f709e3af53c6bd (patch)
tree96dd5739182a576acb6d352e5c85b188ec9f2f91
parenta24862483430f6e1904653f3024cc6774650d80b (diff)
downloadperl-776be7c3edd492f9b471f722b6f709e3af53c6bd.tar.gz
(perl #17844) don't update SvCUR until after we've done moving
SvCUR() before the SvGROW() calls could result in reading beyond the end of a buffer. It wasn't a problem in the normal case, since sv_grow() just calls realloc() which has its own notion of how big the memory block is, but if the SV is SvOOK() sv_backoff() tries to move SvCUR()+1 bytes, which might be larger than the currently allocated size of the PV. (cherry picked from commit 45f235c116d4deab95c576aff77fe46d609f8553)
-rw-r--r--doop.c2
-rw-r--r--t/op/bop.t11
2 files changed, 11 insertions, 2 deletions
diff --git a/doop.c b/doop.c
index 267b640f4d..0037c2458a 100644
--- a/doop.c
+++ b/doop.c
@@ -1090,7 +1090,6 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
lsave = lc;
rsave = rc;
- SvCUR_set(sv, len);
(void)SvPOK_only(sv);
if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
dc = SvPV_force_nomg_nolen(sv);
@@ -1106,6 +1105,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
sv_usepvn_flags(sv, dc, needlen, SV_HAS_TRAILING_NUL);
dc = SvPVX(sv); /* sv_usepvn() calls Renew() */
}
+ SvCUR_set(sv, len);
if (len >= sizeof(long)*4 &&
!(PTR2nat(dc) % sizeof(long)) &&
diff --git a/t/op/bop.t b/t/op/bop.t
index eecd90387f..07f057d0a9 100644
--- a/t/op/bop.t
+++ b/t/op/bop.t
@@ -18,7 +18,7 @@ BEGIN {
# If you find tests are failing, please try adding names to tests to track
# down where the failure is, and supply your new names as a patch.
# (Just-in-time test naming)
-plan tests => 501;
+plan tests => 502;
# numerics
ok ((0xdead & 0xbeef) == 0x9ead);
@@ -669,3 +669,12 @@ foreach my $op_info ([and => "&"], [or => "|"], [xor => "^"]) {
like $@, $expected, $description;
}
}
+
+{
+ # perl #17844 - only visible with valgrind/ASAN
+ fresh_perl_is(<<'EOS',
+formline X000n^\\0,\\0^\\0for\0,0..10
+EOS
+ '',
+ {}, "[perl #17844] access beyond end of block");
+}