This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
(perl #129125) copy form data if it might be freed
authorTony Cook <tony@develop-help.com>
Thu, 19 Jan 2017 05:28:03 +0000 (16:28 +1100)
committerTony Cook <tony@develop-help.com>
Thu, 19 Jan 2017 05:28:03 +0000 (16:28 +1100)
If the format SV also appeared as an argument, and the FF_CHOP
operator modified that argument, the magic and hence the compiled
format would be freed, and the next iteration of the processing
the compiled format would read freed memory.

Unlike my original patch this copies the formsv too, since
that is also stored in the magic, and is needed for presenting
literal text from the format.

pp_ctl.c
t/op/write.t

index c657336..5588a3b 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -490,6 +490,7 @@ PP(pp_formline)
     U8 *source;                    /* source of bytes to append */
     STRLEN to_copy;        /* how may bytes to append */
     char trans;                    /* what chars to translate */
     U8 *source;                    /* source of bytes to append */
     STRLEN to_copy;        /* how may bytes to append */
     char trans;                    /* what chars to translate */
+    bool copied_form = false; /* have we duplicated the form? */
 
     mg = doparseform(tmpForm);
 
 
     mg = doparseform(tmpForm);
 
@@ -687,6 +688,23 @@ PP(pp_formline)
        case FF_CHOP: /* (for ^*) chop the current item */
            if (sv != &PL_sv_no) {
                const char *s = chophere;
        case FF_CHOP: /* (for ^*) chop the current item */
            if (sv != &PL_sv_no) {
                const char *s = chophere;
+                if (!copied_form &&
+                    ((sv == tmpForm || SvSMAGICAL(sv))
+                     || (SvGMAGICAL(tmpForm) && !sv_only_taint_gmagic(tmpForm))) ) {
+                    /* sv and tmpForm are either the same SV, or magic might allow modification
+                       of tmpForm when sv is modified, so copy */
+                    SV *newformsv = sv_mortalcopy(formsv);
+                    U32 *new_compiled;
+
+                    f = SvPV_nolen(newformsv) + (f - SvPV_nolen(formsv));
+                    Newx(new_compiled, mg->mg_len / sizeof(U32), U32);
+                    memcpy(new_compiled, mg->mg_ptr, mg->mg_len);
+                    SAVEFREEPV(new_compiled);
+                    fpc = new_compiled + (fpc - (U32*)mg->mg_ptr);
+                    formsv = newformsv;
+
+                    copied_form = true;
+                }
                if (chopspace) {
                    while (isSPACE(*s))
                        s++;
                if (chopspace) {
                    while (isSPACE(*s))
                        s++;
index 93f70fa..3172681 100644 (file)
@@ -98,7 +98,7 @@ for my $tref ( @NumTests ){
 my $bas_tests = 21;
 
 # number of tests in section 3
 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 + 4;
+my $bug_tests = 66 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 6 + 2 + 3 + 96 + 11 + 4;
 
 # number of tests in section 4
 my $hmb_tests = 37;
 
 # number of tests in section 4
 my $hmb_tests = 37;
@@ -1637,6 +1637,23 @@ printf ">%s<\n", ref $zamm;
 print "$zamm->[0]\n";
 EOP
 
 print "$zamm->[0]\n";
 EOP
 
+# [perl #129125] - detected by -fsanitize=address or valgrind
+# the compiled format would be freed when the format string was modified
+# by the chop operator
+fresh_perl_is(<<'EOP', "^", { stderr => 1 }, '#129125 - chop on format');
+my $x = '^@';
+formline$x=>$x;
+print $^A;
+EOP
+
+fresh_perl_is(<<'EOP', '<^< xx AA><xx ^<><>', { stderr => 1 }, '#129125 - chop on format, later values');
+my $x = '^< xx ^<';
+my $y = 'AA';
+formline $x => $x, $y;
+print "<$^A><$x><$y>";
+EOP
+
+
 # [perl #73690]
 
 select +(select(RT73690), do {
 # [perl #73690]
 
 select +(select(RT73690), do {