From 45f235c116d4deab95c576aff77fe46d609f8553 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 15 Apr 2019 15:23:32 +1000
Subject: [PATCH] (perl #17844) don't update SvCUR until after we've done
 moving
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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.

Signed-off-by: Petr Písař <ppisar@redhat.com>
---
 doop.c     |  2 +-
 t/op/bop.t | 11 ++++++++++-
 2 files changed, 11 insertions(+), 2 deletions(-)

diff --git a/doop.c b/doop.c
index 88220092c3..c9c953212e 100644
--- a/doop.c
+++ b/doop.c
@@ -1087,7 +1087,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);
@@ -1103,6 +1102,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");
+}
-- 
2.25.4