In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/dc529e655355bff17b35ddec08d5bc5cbbdd206a?hp=a75f6a0b013c6142133284dab143f1ad0e581b10>

- Log -----------------------------------------------------------------
commit dc529e655355bff17b35ddec08d5bc5cbbdd206a
Author: Tony Cook <[email protected]>
Date:   Mon Nov 7 11:22:55 2016 +1100

    (perl #129995) avoid sv_catpvn() in do_vop() when unneeded
    
    This could call sv_catpvn() with the source string being within the
    destination SV, which caused a freed memory access if do_vop() and
    sv_catpvn_flags() had different ideas about the ideal size of the
    target SV's buffer.
-----------------------------------------------------------------------

Summary of changes:
 doop.c     | 13 +++++++++++--
 t/op/bop.t |  6 +++++-
 2 files changed, 16 insertions(+), 3 deletions(-)

diff --git a/doop.c b/doop.c
index 5525c47..bc23c9e 100644
--- a/doop.c
+++ b/doop.c
@@ -1218,8 +1218,17 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV 
*right)
            len = lensave;
            if (rightlen > len)
                sv_catpvn_nomg(sv, rsave + len, rightlen - len);
-           else if (leftlen > (STRLEN)len)
-               sv_catpvn_nomg(sv, lsave + len, leftlen - len);
+           else if (leftlen > (STRLEN)len) {
+                if (sv == left) {
+                    /* sv_catpvn() might move the source from under us,
+                       and the data is already in place, just adjust to
+                       include it */
+                    SvCUR_set(sv, leftlen);
+                    *SvEND(sv) = '\0';
+                }
+                else
+                    sv_catpvn_nomg(sv, lsave + len, leftlen - len);
+            }
            else
                *SvEND(sv) = '\0';
            break;
diff --git a/t/op/bop.t b/t/op/bop.t
index f9bf1c5..dd5b5ef 100644
--- a/t/op/bop.t
+++ b/t/op/bop.t
@@ -19,7 +19,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 => 192 + (10*13*2) + 5 + 30;
+plan tests => 192 + (10*13*2) + 5 + 31;
 
 # numerics
 ok ((0xdead & 0xbeef) == 0x9ead);
@@ -678,3 +678,7 @@ for (["aaa","aaa"],[substr ("a\x{100}",0,1), "a"]) {
     $byte = substr unpack("P2", pack "P", $$_[0] &. $$_[1]), -1;
 }
 is $byte, "\0", "utf8 &. appends null byte";
+
+# only visible under sanitize
+fresh_perl_is('$x = "UUUUUUUV"; $y = "xxxxxxx"; $x |= $y; print $x',
+              '}}}}}}}V', {}, "[perl #129995] access to freed memory");

--
Perl5 Master Repository

Reply via email to