Bug#825378: perl: freeze on parsing (broken) code
Yuriy M. Kaminskiy
yumkam at gmail.com
Sat May 28 21:09:17 UTC 2016
Control: tags -1 patch
thanks
On 28.05.2016 17:50, Dominic Hargreaves wrote:
> On Thu, May 26, 2016 at 04:47:07PM +0100, Dominic Hargreaves wrote:
>> On Thu, May 26, 2016 at 04:22:45PM +0300, Yuriy M. Kaminskiy wrote:
>>> Dear Maintainer,
>>>
>>> I've made typo in code, and found that it freezes perl on attempt to parse:
>>> perl -ce 's{foo}{$h->X({->aaa=>"b"},$d)}ge'
>>> ( it was meant to be 's{foo}{$h->X({-aaa=>"b"},$d)}ge' )
>>
>> Thanks for the report!
>>
>> [snip backtrace]
>>
>>> (Theoretically, this can be called "potential DoS on parsing untrusted
>>> code", but I'm pretty sure parsing untrusted perl code is not safe anyway).
>>>
>>> It seems only jessie version affected, perl binaries extracted from
>>> perl-base packages from wheezy and squeeze seems correctly report error:
>>
>> Just to note that I can confirm that it we get a syntax error on
>> wheezy (so this is a regression for jessie).
>>
>>> $ ./perl5.22.2 -ce 's{foo}{$h->X({->aaa=>"b"},$d)}ge'
>>> syntax error at -e line 1, near "{->aaa"
>>> syntax error at -e line 1, near ")}"
>>> -e had compilation errors.
>>>
>>> It seems no changes in 5.20.2-3+deb8u5 (from jessie-proposed-updates) (also
>>> freezes).
>>
>> Thanks for the report!
>>
>> I bisected this using something like:
>>
>> cat ../test_prog.sh
>> #!/bin/sh
>>
>> ./perl -e 's{foo}{$h->X({->aaa=>"b"},$d)}ge;'
>>
>> if [ $? = 255 ]; then
>> exit 0
>> fi
>>
>> ../perl/Porting/bisect.pl --expect-fail --start v5.20.0 --end v5.22.0 --timeout 2 -- ../test_prog.sh
>>
>> This was fixed upstream by f8a7ccebba5637bf0cf5a23cea563b2ccd62312d[1],
>> which as you observed was first included in 5.22.0. It may be a candidate
>> for backporting to jessie / maint-5.20 upstream, but the patch doesn't
>> apply as-is.
>
> Just to add to this: since perl 5.20 is out of support upstream, and
> this isn't a critical issue, I suspect not much more will happen on
> this bug from me. If someone else wants to backport the patch, I'd
> happily consider it for inclusion in a future stable update.
Something like attached? (only complication: lack of op_sibling_splice
in 5.20).
Compiled with pbuilder (BTW, needed USENETWORK=yes; otherwise it failed
two tests for IO::Socket::IP; looks like #759799?), minimally tested,
seems work.
Disclaimer: use with care/review carefully/IANAPH.
-------------- next part --------------
diff -Nru perl-5.20.2/debian/changelog perl-5.20.2/debian/changelog
--- perl-5.20.2/debian/changelog 2016-05-24 01:42:25.000000000 +0300
+++ perl-5.20.2/debian/changelog 2016-05-28 18:04:59.000000000 +0300
@@ -1,3 +1,10 @@
+perl (5.20.2-3+deb8u5.1) UNRELEASED; urgency=medium
+
+ * Non-maintainer upload.
+ * Backported fix for freeze on parsing invalid code (Closes: #825378)
+
+ -- Yuriy M. Kaminskiy <yumkam+debian at gmail.com> Sat, 28 May 2016 18:04:02 +0300
+
perl (5.20.2-3+deb8u5) jessie; urgency=medium
* Apply patch from Niko Tyni fixing debugperl crashes with XS
diff -Nru perl-5.20.2/debian/patches/fixes/perl.git-f8a7ccebba5637bf0cf5a23cea563b2ccd62312d.patch perl-5.20.2/debian/patches/fixes/perl.git-f8a7ccebba5637bf0cf5a23cea563b2ccd62312d.patch
--- perl-5.20.2/debian/patches/fixes/perl.git-f8a7ccebba5637bf0cf5a23cea563b2ccd62312d.patch 1970-01-01 03:00:00.000000000 +0300
+++ perl-5.20.2/debian/patches/fixes/perl.git-f8a7ccebba5637bf0cf5a23cea563b2ccd62312d.patch 2016-05-28 18:33:37.000000000 +0300
@@ -0,0 +1,70 @@
+From f8a7ccebba5637bf0cf5a23cea563b2ccd62312d Mon Sep 17 00:00:00 2001
+From: Father Chrysostomos <sprout at cpan.org>
+Date: Fri, 3 Oct 2014 22:40:36 -0700
+Subject: [PATCH] Fix assertion failure/hang with / (?{(^{})/
+MIME-Version: 1.0
+Content-Type: text/plain; charset=utf8
+Content-Transfer-Encoding: 8bit
+
+When this invalid construct is parsed, the resulting op tree for the
+pattern has a code block with no constant item following it, breaking
+the assumptions made by pmruntime.
+
+Fixing this was not so easy.
+
+You canâ??t just adjust the assertions, because the hang that non-debug-
+ging builds exhibited is still there.
+
+You canâ??t just return NULL from pmruntime when encounting the bad op
+tree, because the parser will crash on the null pointer.
+
+You canâ??t just return the empty pmop, because the wrong pad is
+active, and other functions in op.c will try to access nonexistent
+pad entries.
+
+You canâ??t just LEAVE_SCOPE and return the pmop, because then PL_parser
+will be null in yyerror. Changing yyerror to account is not suffi-
+cient, because then you get double-freed SVs. At that point I gave up
+with that approach.
+
+The easiest solution turned out to be to fake up the op that we were
+expecting to see.
+---
+ op.c | 10 +++++++++-
+ t/re/re_tests | 1 +
+ 2 files changed, 10 insertions(+), 1 deletion(-)
+
+Bug-Debian: https://bugs.debian.org/825378
+
+Index: perl-5.20.2/op.c
+===================================================================
+--- perl-5.20.2.orig/op.c
++++ perl-5.20.2/op.c
+@@ -4846,7 +4846,14 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bo
+ for (o = cLISTOPx(expr)->op_first; o; o = o->op_sibling) {
+ if (o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL)) {
+ has_code = 1;
+- assert(!o->op_next && o->op_sibling);
++ assert(!o->op_next);
++ if (UNLIKELY(!o->op_sibling)) {
++ assert(PL_parser && PL_parser->error_count);
++ /* This can happen with qr/ (?{(^{})/. Just fake up
++ the op we were expecting to see, to avoid crashing
++ elsewhere. */
++ o->op_sibling = newSVOP(OP_CONST, 0, &PL_sv_no);
++ }
+ o->op_next = o->op_sibling;
+ }
+ else if (o->op_type != OP_CONST && o->op_type != OP_PUSHMARK)
+Index: perl-5.20.2/t/re/re_tests
+===================================================================
+--- perl-5.20.2.orig/t/re/re_tests
++++ perl-5.20.2/t/re/re_tests
+@@ -538,6 +538,7 @@ foo\w*\d{4}baz foobar1234baz y $& foobar
+ a(?{})b cabd y $& ab
+ a(?{f()+ - c - Missing right curly or square bracket
+ a(?{{1}+ - c - Missing right curly or square bracket
++ (?{(^{}) - c - syntax error
+ a(?{}})b - c -
+ a(?{"{"})b ab y - -
+ a(?{"\{"})b cabd y $& ab
diff -Nru perl-5.20.2/debian/patches/fixes/perl.git-f8a7ccebba5637bf0cf5a23cea563b2ccd62312d.patch.save perl-5.20.2/debian/patches/fixes/perl.git-f8a7ccebba5637bf0cf5a23cea563b2ccd62312d.patch.save
--- perl-5.20.2/debian/patches/fixes/perl.git-f8a7ccebba5637bf0cf5a23cea563b2ccd62312d.patch.save 1970-01-01 03:00:00.000000000 +0300
+++ perl-5.20.2/debian/patches/fixes/perl.git-f8a7ccebba5637bf0cf5a23cea563b2ccd62312d.patch.save 2016-05-28 17:53:39.000000000 +0300
@@ -0,0 +1,72 @@
+From f8a7ccebba5637bf0cf5a23cea563b2ccd62312d Mon Sep 17 00:00:00 2001
+From: Father Chrysostomos <sprout at cpan.org>
+Date: Fri, 3 Oct 2014 22:40:36 -0700
+Subject: [PATCH] Fix assertion failure/hang with / (?{(^{})/
+MIME-Version: 1.0
+Content-Type: text/plain; charset=utf8
+Content-Transfer-Encoding: 8bit
+
+When this invalid construct is parsed, the resulting op tree for the
+pattern has a code block with no constant item following it, breaking
+the assumptions made by pmruntime.
+
+Fixing this was not so easy.
+
+You canâ??t just adjust the assertions, because the hang that non-debug-
+ging builds exhibited is still there.
+
+You canâ??t just return NULL from pmruntime when encounting the bad op
+tree, because the parser will crash on the null pointer.
+
+You canâ??t just return the empty pmop, because the wrong pad is
+active, and other functions in op.c will try to access nonexistent
+pad entries.
+
+You canâ??t just LEAVE_SCOPE and return the pmop, because then PL_parser
+will be null in yyerror. Changing yyerror to account is not suffi-
+cient, because then you get double-freed SVs. At that point I gave up
+with that approach.
+
+The easiest solution turned out to be to fake up the op that we were
+expecting to see.
+---
+ op.c | 10 +++++++++-
+ t/re/re_tests | 1 +
+ 2 files changed, 10 insertions(+), 1 deletion(-)
+
+diff --git a/op.c b/op.c
+index 930df2d..c864a26 100644
+--- a/op.c
++++ b/op.c
+@@ -4922,7 +4922,15 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg, I32 floor)
+ for (o = cLISTOPx(expr)->op_first; o; o = OP_SIBLING(o)) {
+ if (o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL)) {
+ has_code = 1;
+- assert(!o->op_next && OP_HAS_SIBLING(o));
++ assert(!o->op_next);
++ if (UNLIKELY(!OP_HAS_SIBLING(o))) {
++ assert(PL_parser && PL_parser->error_count);
++ /* This can happen with qr/ (?{(^{})/. Just fake up
++ the op we were expecting to see, to avoid crashing
++ elsewhere. */
++ op_sibling_splice(expr, o, 0,
++ newSVOP(OP_CONST, 0, &PL_sv_no));
++ }
+ o->op_next = OP_SIBLING(o);
+ }
+ else if (o->op_type != OP_CONST && o->op_type != OP_PUSHMARK)
+diff --git a/t/re/re_tests b/t/re/re_tests
+index 964360d..2c40e85 100644
+--- a/t/re/re_tests
++++ b/t/re/re_tests
+@@ -539,6 +539,7 @@ foo\w*\d{4}baz foobar1234baz y $& foobar1234baz
+ a(?{})b cabd y $& ab
+ a(?{f()+ - c - Missing right curly or square bracket
+ a(?{{1}+ - c - Missing right curly or square bracket
++ (?{(^{}) - c - syntax error
+ a(?{}})b - c -
+ a(?{"{"})b ab y - -
+ a(?{"\{"})b cabd y $& ab
+--
+2.9.0-rc0-220-g588f76c
+
diff -Nru perl-5.20.2/debian/patches/series perl-5.20.2/debian/patches/series
--- perl-5.20.2/debian/patches/series 2016-05-24 01:41:19.000000000 +0300
+++ perl-5.20.2/debian/patches/series 2016-05-28 17:56:15.000000000 +0300
@@ -79,3 +79,4 @@
fixes/5.20.3/docs/perlunicook_typos.diff
fixes/5.20.3/docs/ook_example.diff
fixes/5.20.3/docs/study_noop.diff
+fixes/perl.git-f8a7ccebba5637bf0cf5a23cea563b2ccd62312d.patch
More information about the Perl-maintainers
mailing list