Avoid read-after-free in S_scan_heredoc() if the terminator line has no "\n".

The code added by commit 112d128413206514 to fix RT #65838 (Allow here-doc
with no final newline) could in some rare cases cause a read of free()d
memory during parsing. The code itself is only run if the Perl program
ends with a heredoc (which is an unusual structure), and if the last line of
the file on disk has no terminating newline character (which is also unusual,
as many editors default to adding a final newline). The bug would be
triggered if the fixup code in S_scan_heredoc() triggered a reallocation of
the buffer in PL_linestr when adding a newline to it.

diff --git a/t/op/heredoc.t b/t/op/heredoc.t
index 08b0af2..a239e92 100644 (file)
--- a/t/op/heredoc.t
+++ b/t/op/heredoc.t
@@ -7,7 +7,7 @@ BEGIN {
 }
 
 use strict;
-plan(tests => 9);
+plan(tests => 39);
 
 
 # heredoc without newline (#65838)
@@ -69,12 +69,19 @@ HEREDOC
         "string terminator must start at newline"
     );
 
-    fresh_perl_like(
-        "print <<;\nno more newlines",
-        qr/find string terminator/,
-        { switches => ['-X'] },
-        "empty string terminator still needs a newline"
-    );
+    # Loop over various lengths to try to force at least one to cause a
+    # reallocation in S_scan_heredoc()
+    # Timing on a modern machine suggests that this loop executes in less than
+    # 0.1s, so it's a very small cost for the default build. The benefit is
+    # that building with ASAN will reveal the bug and any related regressions.
+    for (1..31) {
+        fresh_perl_like(
+            "print <<;\n" . "x" x $_,
+            qr/find string terminator/,
+            { switches => ['-X'] },
+            "empty string terminator still needs a newline (length $_)"
+        );
+    }
 
     fresh_perl_like(
         "print <<ThisTerminatorIsLongerThanTheData;\nno more newlines",

diff --git a/toke.c b/toke.c
index 2ab2a71..1781899 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -10172,8 +10172,11 @@ S_scan_heredoc(pTHX_ char *s)
        }
        CopLINE_set(PL_curcop, (line_t)PL_multi_start - 1);
        if (!SvCUR(PL_linestr) || PL_bufend[-1] != '\n') {
-           lex_grow_linestr(SvCUR(PL_linestr) + 2);
+            s = lex_grow_linestr(SvLEN(PL_linestr) + 3);
+            /* ^That should be enough to avoid this needing to grow:  */
            sv_catpvs(PL_linestr, "\n\0");
+            assert(s == SvPVX(PL_linestr));
+            PL_bufend = SvEND(PL_linestr);
        }
        s = PL_bufptr;
 #ifdef PERL_MAD