This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
heap-buffer-overflow
authorKarl Williamson <khw@cpan.org>
Tue, 17 Apr 2018 04:13:30 +0000 (22:13 -0600)
committerKarl Williamson <khw@cpan.org>
Tue, 17 Apr 2018 04:33:49 +0000 (22:33 -0600)
The fix is simpler than in the maintenance releases due to prior changes
in 5.27.

The problem is that under some circumstances the sharp s takes up two
bytes when space for only one had been allocated.  Just the right set of
circumstances are required for this to happen.

regcomp.c
t/re/pat.t

index 4e72589..b69b2c9 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -13968,6 +13968,24 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
                                 ender = 's';
                                 added_len = 2;
                             }
+                            else if (RExC_uni_semantics) {
+
+                                /* Here, we are supossed to be using Unicode
+                                 * rules, but this folding node is not.  This
+                                 * happens during pass 1 when the node started
+                                 * out not under Unicode rules, but a \N{} was
+                                 * encountered during the processing of it,
+                                 * causing Unicode rules to be switched into.
+                                 * Pass 1 continues uninteruppted, as by the
+                                 * time we get to pass 2, we will know enough
+                                 * to generate the correct folds.  Except in
+                                 * this one case, we need to restart the node,
+                                 * because the fold of the sharp s requires 2
+                                 * characters, and the sizing needs to account
+                                 * for that. */
+                                p = oldp;
+                                goto loopdone;
+                            }
                             else {
                                 RExC_seen_unfolded_sharp_s = 1;
                                 maybe_exactfu = FALSE;
index d327a36..066ac96 100644 (file)
@@ -23,7 +23,7 @@ BEGIN {
     skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader;
     skip_all_without_unicode_tables();
 
-plan tests => 846;  # Update this when adding/deleting tests.
+plan tests => 847;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -32,6 +32,8 @@ run_tests() unless caller;
 #
 sub run_tests {
 
+    my $sharp_s = uni_to_native("\xdf");
+
     {
         my $x = "abc\ndef\n";
        (my $x_pretty = $x) =~ s/\n/\\n/g;
@@ -1409,9 +1411,6 @@ EOP
 
     {   # Various flags weren't being set when a [] is optimized into an
         # EXACTish node
-        ;
-        ;
-        my $sharp_s = uni_to_native("\xdf");
         ok("\x{017F}\x{017F}" =~ qr/^[$sharp_s]?$/i, "[] to EXACTish optimization");
     }
 
@@ -1941,6 +1940,9 @@ EOP
     {
         fresh_perl_is('$_="0\x{1000000}";/^000?\0000/','',{},"dont throw assert errors trying to fbm past end of string");
     }
+    {   # [perl $132227]
+        fresh_perl_is("('0ba' . ('ss' x 300)) =~ m/0B\\N{U+41}" . $sharp_s x 150 . '/i and print "1\n"',  1,{},"Use of sharp s under /di that changes to /ui");
+    }
 
 } # End of sub run_tests