File perl-badutf8hang.diff of Package perl

Overview Repositories Revisions Requests Users Attributes Meta

File perl-badutf8hang.diff of Package perl

commit 62a27ee62dc5abc442c1f4dc193fd5f648f51a39
Author: Yves Orton <demerphq@gmail.com>
Date:   Thu Apr 21 11:16:08 2016 +0200

backport fix for Perl #123562 to 5.18.2

diff --git a/regexec.c b/regexec.c
index b865b46..a9bc315 100644
--- a/regexec.c
+++ b/regexec.c
@@ -7435,6 +7435,10 @@ S_reghop3(U8 *s, I32 off, const U8* lim)
             if (UTF8_IS_CONTINUED(*s)) {
                 while (s > lim && UTF8_IS_CONTINUATION(*s))
                     s--;
+                if (! UTF8_IS_START(*s)) {
+                    dTHX;
+                    Perl_croak(aTHX_ "Malformed UTF-8 character (fatal)");
+                }
 	    }
             /* XXX could check well-formedness here */
 	}
@@ -7466,6 +7470,10 @@ S_reghop4(U8 *s, I32 off, const U8* llim, const U8* rlim)
             if (UTF8_IS_CONTINUED(*s)) {
                 while (s > llim && UTF8_IS_CONTINUATION(*s))
                     s--;
+                if (! UTF8_IS_START(*s)) {
+                    dTHX;
+                    Perl_croak(aTHX_ "Malformed UTF-8 character (fatal)");
+                }
             }
             /* XXX could check well-formedness here */
         }
@@ -7495,6 +7503,10 @@ S_reghopmaybe3(U8* s, I32 off, const U8* lim)
             if (UTF8_IS_CONTINUED(*s)) {
                 while (s > lim && UTF8_IS_CONTINUATION(*s))
                     s--;
+                if (! UTF8_IS_START(*s)) {
+                    dTHX;
+                    Perl_croak(aTHX_ "Malformed UTF-8 character (fatal)");
+                }
 	    }
             /* XXX could check well-formedness here */
 	}
diff --git a/t/re/pat.t b/t/re/pat.t
index edb78ca..e359e52 100644
--- a/t/re/pat.t
+++ b/t/re/pat.t
@@ -20,7 +20,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 672;  # Update this when adding/deleting tests.
+plan tests => 673;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -1401,6 +1401,21 @@ EOP
 	is ($s, 'XXcdXXX&', 'RT #119125 with /x');
     }
 
+    {   # Test that we handle some malformed UTF-8 without looping [perl
+        # #123562]
+
+        my $code='
+            BEGIN{require q(test.pl);}
+            use Encode qw(_utf8_on);
+            my $malformed = "a\x80\n";
+            _utf8_on($malformed);
+            watchdog(3);
+            $malformed =~ /(\n\r|\r)$/;
+            print q(No infinite loop here!);
+        ';
+        fresh_perl_like($code, qr/Malformed UTF-8 character/, {},
+            "test that we handle some UTF-8 malformations without looping" );
+    }
 } # End of sub run_tests
 
 1;

Places

File perl-badutf8hang.diff of Package perl

Places