I've extracted a subroutine from some perl code I've written. (I also included the use enum
line for easy reference.) Its purpose is to parse the given code, returning a string with an error message if the code is malformed. The purpose of the whole program is to check code for errors, so the 'normal' path where undef
is returned is less interesting than the paths where errors are given.
The code passed to this sub is C-like with strings like "First line of string\nSecond line of string"
and comments like /* block comment */
and \\ line comments use backslashes
. The code comes from a priori untrusted sources and is run in taint mode. (I don't actually expect malicious code -- it's run strictly offline, and with code that has been human-checked -- but if you see any gaping security holes that would be worth pointing out.)
I have two main issues (and any number of subsidiary issues). First, should I be coding this directly or using a module? I looked at various parsing modules like Marpa::R2
, Parse-RecDescent
, Parse-Yapp
, Parser-MGC
, Regexp-Grammars
, etc., but they all seemed cumbersome and more trouble than just coding a simple parser. Second, a lot of code is repeated here, and I'm not comfortable with that. For example, the four lines with Unbalanced parentheses, ) without matching (
are repeated three times, once for each of Normal
, NormalSlash
, and NormalBackslash
.
Secondary goals include efficiency (each run of the program will require parsing 50,000 to 100,000 blocks of code) and using idiomatic perl code.
Apologies for the poor code formatting -- despite identifying the block as lang-perl
it formats //
as a comment. (lang-pl
does the same.)
use enum qw(Normal NormalSlash NormalBackslash BlockComment BlockCommentStar LineComment String StringEscape);
sub parse {
my $code = shift;
my $level = 0; # Depth of nested parentheses
my $status = Normal;
for my $c (split //, $code) {
if ($status == Normal) {
if ($c eq '/') {
$status = NormalSlash;
} elsif ($c eq '\\') {
$status = NormalBackslash;
} elsif ($c eq '"') {
$status = String;
} elsif ($c eq '(') {
$level++;
} elsif ($c eq ')') {
my $parens = $code;
$parens =~ tr/()//cd;
return "Unbalanced parentheses, ) without matching (, had $parens" if $level == 0;
$level--;
}
} elsif ($status == NormalSlash) {
if ($c eq '*') {
$status = BlockComment;
} elsif ($c eq '\\') {
$status = NormalBackslash;
} elsif ($c eq '"') {
$status = String;
} elsif ($c eq '(') {
$level++;
$status = Normal;
} elsif ($c eq ')') {
my $parens = $code;
$parens =~ tr/()//cd;
return "Unbalanced parentheses, ) without matching (, had $parens" if $level == 0;
$level--;
$status = Normal;
} else {
$status = Normal;
}
} elsif ($status == NormalBackslash) {
if ($c eq '\\') {
$status = LineComment;
} elsif ($c eq '"') {
$status = String;
} elsif ($c eq '(') {
$level++;
$status = Normal;
} elsif ($c eq ')') {
my $parens = $code;
$parens =~ tr/()//cd;
return "Unbalanced parentheses, ) without matching (, had $parens" if $level == 0;
$level--;
$status = Normal;
} else {
$status = Normal;
}
} elsif ($status == BlockComment) {
if ($c eq '*') {
$status = BlockCommentStar;
}
} elsif ($status == BlockCommentStar) {
if ($c eq '/') {
$status = Normal;
} elsif ($c ne '*') {
$status = BlockComment;
}
} elsif ($status == LineComment) {
if ($c eq '\n') {
$status = Normal;
}
} elsif ($status == String) {
if ($c eq '"') {
$status = Normal;
} elsif ($c eq '\\') {
$status = StringEscape;
}
} elsif ($status == StringEscape) {
$status = String;
}
}
if ($level > 0) {
my $parens = $code;
$parens =~ tr/()//cd;
return "Unbalanced parentheses, ( without matching ), had $parens";
}
return 'Trailing slash' if $status == NormalSlash;
return 'Trailing backslash' if $status == NormalBackslash;
return 'Block comment still open' if $status == BlockComment || $status == BlockCommentStar;
return 'Unterminated string' if $status == String || $status == StringEscape;
return undef if $status == Normal || $status == LineComment;
return 'Bug, unknown status';
}
/ /x
for//
,chr(47)
for'/'
, andtr{()}{}cd
fortr/()//cd
. It would be better to strip the highlighting somehow. \$\endgroup\$