Dne Po 29.úno.2016 02:31:30, neuron napsal(a):
Show quoted text> Blast from the past. We found it by fuzzing and two hours with
> valgrind and dissassembler led to this patch. It's against perl 5.20,
> I haven't checked how the latest and greatest version looks like. But
> hopefully it's at least starting pointer.
>
Thanks for the fix. The attached patches add a test and fix for this bug.
From 6f0604e0a4e20d0f25dfb9881fa6216b93964352 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
Date: Mon, 29 Feb 2016 11:04:04 +0100
Subject: [PATCH 2/2] Check for -n argument length
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
If a2p's -n argument is long enough, a static 2-KB array overflows in
the parser:
$ a2p -n"$(perl -e 'print q{a}x25000')" < /dev/null
<vlmarek@volny.cz> provided the fix, I wrote the test.
https://rt.cpan.org/Public/Bug/Display.html?id=100361
https://bugs.debian.org/769606
Signed-off-by: Petr PÃsaÅ <ppisar@redhat.com>
---
t/10-basics.t | 5 +++++
walk.c | 5 ++++-
2 files changed, 9 insertions(+), 1 deletion(-)
diff --git a/t/10-basics.t b/t/10-basics.t
index d1f2026..8f45ec2 100644
--- a/t/10-basics.t
+++ b/t/10-basics.t
@@ -34,6 +34,11 @@ open my $self, '<', $0;
chomp(my @expected = grep { /awk2perl/ } <$self>);
is_deeply([ split /\n/, $output ], \@expected, 'Output is identical to ⦠code');
+spew($input_awk, '');
+my (undef, $error) = runa2p(progfile => $input_awk,
+ args => [ '-n' . q{a} x 25000 ] );
+like($error, qr{Internal error:}, 'Too long -n argument raises an error');
+
done_testing;
sub run_command {
diff --git a/walk.c b/walk.c
index 82d5346..26b378f 100644
--- a/walk.c
+++ b/walk.c
@@ -72,8 +72,11 @@ walk(int useval, int level, int node, int *numericptr, int minprec)
if (namelist) {
while (isALPHA(*namelist)) {
for (d = tokenbuf,s=namelist;
- isWORDCHAR(*s);
+ d - tokenbuf < sizeof(tokenbuf) && isWORDCHAR(*s);
*d++ = *s++) ;
+ if (d - tokenbuf == sizeof(tokenbuf))
+ fatal("Internal error: argument longer than %d: %s",
+ sizeof(tokenbuf) - 1, namelist);
*d = '\0';
while (*s && !isALPHA(*s)) s++;
namelist = s;
--
2.5.0
From b8bdc6e201a203e3e340c8c277904e030bba0288 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
Date: Mon, 29 Feb 2016 10:40:39 +0100
Subject: [PATCH 1/2] Capture stderr in tests
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Signed-off-by: Petr PÃsaÅ <ppisar@redhat.com>
---
t/10-basics.t | 17 +++++++++++------
1 file changed, 11 insertions(+), 6 deletions(-)
diff --git a/t/10-basics.t b/t/10-basics.t
index d0c59dd..d1f2026 100644
--- a/t/10-basics.t
+++ b/t/10-basics.t
@@ -7,7 +7,8 @@ use Test::More 0.89;
use Config;
use Devel::FindPerl 'find_perl_interpreter';
-use IPC::Open2;
+use IPC::Open3;
+use Symbol;
use File::Spec::Functions 'catfile';
use File::Temp 'tempdir';
@@ -24,11 +25,11 @@ my $input_perl = catfile($tempdir, 'input.perl');
#mkdir $tempdir or die "Couldn't mkdir $tempdir: $!";
spew($input_awk, "/awk2perl/\n");
-my $program = runa2p(progfile => $input_awk);
+my ($program, undef) = runa2p(progfile => $input_awk);
like($program, qr{print \$_ if /awk2perl/;}, 'Output looks like expected output');
spew($input_perl, $program);
-my $output = runperl(progfile => $input_perl, args => [ $0 ]);
+my ($output, $undef) = runperl(progfile => $input_perl, args => [ $0 ]);
open my $self, '<', $0;
chomp(my @expected = grep { /awk2perl/ } <$self>);
is_deeply([ split /\n/, $output ], \@expected, 'Output is identical to ⦠code');
@@ -38,11 +39,15 @@ done_testing;
sub run_command {
my %args = @_;
my @command = @{ $args{command} };
- my $pid = open2(my ($in, $out), @command) or die "Couldn't open2($?): $!";
+ my ($in, $out, $err);
+ $err = Symbol::gensym;
+ my $pid = open3($in, $out, $err, @command) or die "Couldn't open2($?): $!";
binmode $in, ':crlf' if $^O eq 'MSWin32';
- my $ret = do { local $/; <$in> };
+ my @ret;
+ $ret[0] = do { local $/; <$out> };
+ $ret[1] = do { local $/; <$err> };
waitpid $pid, 0;
- return $ret;
+ return @ret;
}
sub runa2p {
--
2.5.0
