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.
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+deb...@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 <spr...@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 <spr...@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
