Skip to content

Commit

Permalink
GH16319: avoid recursion parsing 'pack' template
Browse files Browse the repository at this point in the history
A template with many open brackets or open parentheses could
overflow the stack, modify the parsing loop to avoid that.
  • Loading branch information
hvds authored and khwilliamson committed May 28, 2022
1 parent dae8ab8 commit f24623d
Show file tree
Hide file tree
Showing 3 changed files with 26 additions and 8 deletions.
5 changes: 5 additions & 0 deletions pod/perldiag.pod
Original file line number Diff line number Diff line change
Expand Up @@ -3704,6 +3704,11 @@ See L</500 Server error>.
by a missing delimiter on a string or pattern, because it eventually
ended earlier on the current line.

=item Mismatched brackets in template

(F) A pack template could not be parsed because pairs of C<[...]> or
C<(...)> could not be matched up. See L<perlfunc/pack>.

=item Misplaced _ in number

(W syntax) An underscore (underbar) in a numeric constant did not
Expand Down
16 changes: 9 additions & 7 deletions pp_pack.c
Original file line number Diff line number Diff line change
Expand Up @@ -541,22 +541,24 @@ STATIC const char *
S_group_end(pTHX_ const char *patptr, const char *patend, char ender)
{
PERL_ARGS_ASSERT_GROUP_END;
Size_t opened = 0; /* number of pending opened brackets */

while (patptr < patend) {
const char c = *patptr++;

if (isSPACE(c))
continue;
else if (c == ender)
if (opened == 0 && c == ender)
return patptr-1;
else if (c == '#') {
while (patptr < patend && *patptr != '\n')
patptr++;
continue;
} else if (c == '(')
patptr = group_end(patptr, patend, ')') + 1;
else if (c == '[')
patptr = group_end(patptr, patend, ']') + 1;
} else if (c == '(' || c == '[')
++opened;
else if (c == ')' || c == ']') {
if (opened == 0)
Perl_croak(aTHX_ "Mismatched brackets in template");
--opened;
}
}
Perl_croak(aTHX_ "No group ending character '%c' found in template",
ender);
Expand Down
13 changes: 12 additions & 1 deletion t/op/pack.t
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@ BEGIN {
set_up_inc(qw '../lib ../cpan/Math-BigInt/lib');
}

plan tests => 14720;
plan tests => 14722;

use strict;
use warnings qw(FATAL all);
Expand Down Expand Up @@ -2044,3 +2044,14 @@ SKIP:
fresh_perl_is('0.0 + unpack("u", "ab")', "", { stderr => 1 },
"ensure unpack u of invalid data nul terminates result");
}

{
# [GH #16319] SEGV caused by recursion
my $x = eval { pack "[" x 1_000_000 };
like("$@", qr{No group ending character \Q']'\E found in template},
"many opening brackets should not smash the stack");

$x = eval { pack "[(][)]" };
like("$@", qr{Mismatched brackets in template},
"should match brackets correctly even without recursion");
}

0 comments on commit f24623d

Please sign in to comment.