From 4681935eb501faf057e03e5e03822e9c33cae28c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
Date: Fri, 5 Apr 2019 16:55:55 +0200
Subject: [PATCH] Fix a memory leak when assigning a regular expression to a
 non-copy-on-write string

---
 ...k-assigning-regexp-to-non-COW-string.patch | 109 ++++++++++++++++++
 perl.spec                                     |   7 ++
 2 files changed, 116 insertions(+)
 create mode 100644 perl-5.29.9-avoid-leak-assigning-regexp-to-non-COW-string.patch

diff --git a/perl-5.29.9-avoid-leak-assigning-regexp-to-non-COW-string.patch b/perl-5.29.9-avoid-leak-assigning-regexp-to-non-COW-string.patch
new file mode 100644
index 0000000..63b0f46
--- /dev/null
+++ b/perl-5.29.9-avoid-leak-assigning-regexp-to-non-COW-string.patch
@@ -0,0 +1,109 @@
+From 1385ac98c5f75358978bb05c2d6c4134413cf689 Mon Sep 17 00:00:00 2001
+From: David Mitchell <davem@iabyn.com>
+Date: Fri, 22 Mar 2019 17:38:48 +0000
+Subject: [PATCH] avoid leak assigning regexp to non-COW string
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+In something like
+
+    $s = substr(.....); # $s now a non-COW SvPOK() SV
+    $r = qr/..../;
+    $s = $$r;
+
+$s's previous string buffer would leak when an SVt_REGEXP type SV is
+assigned to it.
+
+Worse, if $s was an SVt_PVPV, it would fail an assert on debugging
+builds.
+
+The fix is to make sure any remaining stringy stuff is cleaned up
+before copying the REGEXP.
+
+Signed-off-by: Petr Písař <ppisar@redhat.com>
+---
+ regcomp.c | 16 ++++++++++++++++
+ t/op/qr.t | 34 +++++++++++++++++++++++++++++++++-
+ 2 files changed, 49 insertions(+), 1 deletion(-)
+
+diff --git a/regcomp.c b/regcomp.c
+index 15783541a4..e13da83673 100644
+--- a/regcomp.c
++++ b/regcomp.c
+@@ -20665,7 +20665,23 @@ Perl_reg_temp_copy(pTHX_ REGEXP *dsv, REGEXP *ssv)
+     if (!dsv)
+ 	dsv = (REGEXP*) newSV_type(SVt_REGEXP);
+     else {
++        assert(SvTYPE(dsv) == SVt_REGEXP || (SvTYPE(dsv) == SVt_PVLV));
++
++        /* our only valid caller, sv_setsv_flags(), should have done
++         * a SV_CHECK_THINKFIRST_COW_DROP() by now */
++        assert(!SvOOK(dsv));
++        assert(!SvIsCOW(dsv));
++        assert(!SvROK(dsv));
++
++        if (SvPVX_const(dsv)) {
++            if (SvLEN(dsv))
++                Safefree(SvPVX(dsv));
++            SvPVX(dsv) = NULL;
++        }
++        SvLEN_set(dsv, 0);
++        SvCUR_set(dsv, 0);
+ 	SvOK_off((SV *)dsv);
++
+ 	if (islv) {
+ 	    /* For PVLVs, the head (sv_any) points to an XPVLV, while
+              * the LV's xpvlenu_rx will point to a regexp body, which
+diff --git a/t/op/qr.t b/t/op/qr.t
+index 32b9e3b23b..e03a465430 100644
+--- a/t/op/qr.t
++++ b/t/op/qr.t
+@@ -7,7 +7,7 @@ BEGIN {
+     require './test.pl';
+ }
+ 
+-plan(tests => 34);
++plan(tests => 37);
+ 
+ sub r {
+     return qr/Good/;
+@@ -135,3 +135,35 @@ sub {
+     };
+ }
+ pass("PVLV-as-REGEXP double-free of PVX");
++
++# a non-cow SVPV leaked it's string buffer when a REGEXP was assigned to
++# it. Give valgrind/ASan something to work on
++{
++    my $s = substr("ab",0,1); # generate a non-COW string
++    my $r1 = qr/x/;
++    $s = $$r1; # make sure "a" isn't leaked
++    pass("REGEXP leak");
++
++    my $dest = 0;
++    sub Foo99::DESTROY { $dest++ }
++
++    # ditto but make sure we don't leak a reference
++    {
++        my $ref = bless [], "Foo99";
++        my $r2 = qr/x/;
++        $ref = $$r2;
++    }
++    is($dest, 1, "REGEXP RV leak");
++
++    # and worse, assigning a REGEXP to an PVLV that had a string value
++    # caused an assert failure. Same code, but using $_[0] which is an
++    # lvalue, rather than $s.
++
++    my %h;
++    sub {
++        $_[0] = substr("ab",0,1); # generate a non-COW string
++        my $r = qr/x/;
++        $_[0] = $$r; # make sure "a" isn't leaked
++    }->($h{foo}); # passes PVLV to sub
++    is($h{foo}, "(?^:x)", "REGEXP PVLV leak");
++}
+-- 
+2.20.1
+
diff --git a/perl.spec b/perl.spec
index fc10e2f..a6ed5d4 100644
--- a/perl.spec
+++ b/perl.spec
@@ -283,6 +283,10 @@ Patch61:        perl-5.29.9-fix-leak-in-cloned-regexes.patch
 # in upstream after 5.29.9
 Patch62:        perl-5.29.9-fix-leak-in-BEGIN-threads-new.patch
 
+# Fix a memory leak when assigning a regular expression to a non-copy-on-write
+# string, in upstream after 5.29.9
+Patch63:        perl-5.29.9-avoid-leak-assigning-regexp-to-non-COW-string.patch
+
 # Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
 Patch200:       perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch
 
@@ -2901,6 +2905,7 @@ Perl extension for Version Objects
 %patch60 -p1
 %patch61 -p1
 %patch62 -p1
+%patch63 -p1
 %patch200 -p1
 %patch201 -p1
 
@@ -2955,6 +2960,7 @@ perl -x patchlevel.h \
     'Fedora Patch60: Fix mbstate_t initialization in POSIX::mblen (RT#133928)' \
     'Fedora Patch61: Fix a memory leak when cloning a regular expression' \
     'Fedora Patch62: Fix a memory leak when spawning threads in a BEGIN phase' \
+    'Fedora Patch63: Fix a memory leak when assigning a regular expression to a non-copy-on-write string' \
     'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \
     'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
     %{nil}
@@ -5251,6 +5257,7 @@ popd
 - Fix mbstate_t initialization in POSIX::mblen (RT#133928)
 - Fix a memory leak when cloning a regular expression
 - Fix a memory leak when spawning threads in a BEGIN phase
+- Fix a memory leak when assigning a regular expression to a non-copy-on-write string
 
 * Tue Mar 05 2019 Björn Esser <besser82@fedoraproject.org> - 4:5.28.1-434
 - Add explicit Requires: libxcrypt-devel to devel sub-package (bug #1666098)