Copyright Notice
This text is copyright by InfoStrada Communications, Inc., and is used with their permission. Further distribution or use is not permitted.This text has appeared in an edited form in Linux Magazine magazine. However, the version you are reading here is as the author originally submitted the article for publication, not after their editors applied their creativity.
Please read all the information in the table of contents before using this article.
 |
Download this listing! |  |
 |
 |
Linux Magazine Column 29 (Oct 2001)
[suggested title: Safe Undumping]
Recently on the Perl Monestary at http://www.perlmonks.org/, the
user known as ton asked about parsing a Perl-style double-quoted
string, as part of a project to construct a safe Data::Dumper
parser that would take the output and interpret it rather than handing
the result directly to eval as is typically done. A few postings
later, the work in progress for their Undumper was posted, and I commented
that there was probably a simpler way to do some of the things,
and that it didn't handle blessed references.
Well, me and my big mouth. Or was it my continuing curiousity to
tinker with Damian Conway's excellent Parse::RecDescent module? I'm
not sure, but I found myself over the next dozen hours or so staring
at Data::Dumper source code, output, test cases, and
Parse::RecDescent traces and documentation. I also pounded my head
on the desk for better than a day trying to figure out how to break a
left-recursion loop, and came up with a nice obvious (now!) solution.
The point of this is to be able to take the output of Data::Dumper
and reconstruct the original data, but not open ourselves to the
possibility of being fed dangerous constructs, like backticks or
symbol-table-manipulating code. Sure, you could also do this with the
right use of the Safe module, but I was already committed to
finishing this version before I thought of that. Maybe another column
someday.
But anyway, that brings us to the program in [listing one, below].
Most of this program is input to Parse::RecDescent, so I'll start
by setting that aside and describing the Perl support structure first.
Lines 1 through 3 start nearly every program I write, turning on
warnings, compiler restrictions, and disabling the buffering on
STDOUT.
Lines 5 and 6 control the behaviour of Parse::RecDescent. When
tracing is enabled (although commented out here), I can see how the
parse is progressing. The number 80 trims the ``to-be-parsed'' string
dumping to its first 80 characters, which is usually plenty for me to
see what's going on. I left hints enabled, because the error messages
that result from a hint were often helpful in debugging the grammar.
Lines 8 and 9 pull in the Parse::RecDescent (found in the CPAN) and
Data::Dumper (part of the core Perl distribution) modules.
Lines 13 to 81 form the input grammar for Parse::RecDescent,
included as a single-quoted string using q{} for delimiters. Damian
Conway seems to prefer this quoting style for sending stuff to
Parse::RecDescent, so I've copied it at least here. In other
places, I might have used a ``here-document'' instead. The result of
feeding this grammar to Parse::RecDescent is a parser object that
we can then call on to parse the output of Data::Dumper to ``undump''
it. If the grammar is bad, we die in line 81. At that point
Parse::RecDescent has already printed its own diagnostics, expanded
by the enabled ``hint'' flag earlier.
During development, I probably changed this grammar over 50 times, constantly tweaking it to recognize each new thing that I encountered in the input source. The hints were often useful, although the ``left recursion'' problem (that I'll describe later) had me stumped for the better part of two days.
Once we have a parser object (in $parser), the action to ``undump'' a
string containing Perl code is simple. Skipping down quickly to the
test subroutine starting at line 177, we can see the use of this
$parser to take a given $input and transform it to a hashref
response (saved as $symbol here). The keys of the hashref contain
the top-level scalar variable names, which default to $VAR1,
$VAR2 and so on, unless overridden during the dumping. The values
of this hashref are then the corresponding values of those variables
from the original dump, as best can be reconstructed.
The test subroutine here uses Data::Dumper to convert an
existing collection of values (passed in as arguments) into a string,
shows the string as the input to the undumper, then parses the string
with the constructed parser object. The output of this undumping
process is then dumped once again and shown. The comparison process
has to be a manual one, because it is sensitive to the order in which
the items are presented to Data::Dumper.
Above the definition of this testing routine is a series of tests that
I used to develop and verify the undumper. I started with the
included tests found in the Perl 5.6.1 distribution to verify Perl on
initial installation. I actually didn't include the entire test, but
took the data structure for each applicable test and copied that into
this program. I skipped over the tests that included symbol-table
references (using globs) or coderefs, because I chose to ignore that
for this program. Each test provides an arrayref containing the
references to be dumped, and most tests also provide a label list to
keep the variables from simply being named $VAR1, $VAR2 and so
on.
I enclosed each test in a conditional that I could switch between ``if (0)'' and ``if (1)'' to either run the test or skip it. When I was focussing on a new feature, I enabled only one test until it worked, but once I got a good run, I reenabled all previous tests to ensure that I didn't break something else in the process.
The ``Extreme Programming'' technique relies on this strategy of creating tests first and driving the development from those tests, and it worked nicely for the development of this program. Other than a few snippets of code that I used for scaffolding to test some initial grammar ideas, all of the code that I used to develop and test this code is thereby archived along with the routines, for later maintenance to take place easily.
Any one of the tests can be switched to invoke timetest rather than
test, as I've done on the final test (starting in line 171). This
final test, by the way, exercises blessed references (objects), which
none of the distribution tests even approach. (Maybe a patch to the
distribution's t/dumper.t is in order?) Using timetest, we pop
down to the routine beginning in line 184, which runs a quick
benchmark comparing a straight eval with our safe undumping parser.
I'm using the timethese routine from Benchmark (a standard Perl
module), giving it the default ``0 times'', which attempts to run each
routine for slighly over 3 CPU seconds to compute an interations per
second for each type.
The bad news is that my code clocks in at 1/100th of the speed of
eval. Ahh, the price to pay for safety. The good news is that the
speed difference is probably negligible for typical applications, and
pennies to pay for the dollars saved in having a safe evaluation of
what should be good Data::Dumper output.
Well, what little Perl code there is (outside of the grammar), that's it. So let's pick apart the grammar now, starting back up at line 13.
Line 15 declares a variable local to the parser for the ``symbol table'' we'll be creating. The keys will be the full variable names as given in the dump. The values will be the constructed value for that key. Yes, this is the hash that is returned upon a successful parse.
Line 17 defines the top-level rule for the parse. A ``file'' is zero or
more ``assignments''. Howver, we also have to clear out the possibly
leftover values from the previous run, and this is handled by the
action block immediately preceding the assignment. We also have to
verify that we've parsed the entire input string, which I'll do by
matching /\z/, which matches only at the end of the string. If all
went well, we'll return the hashref.
Line 19 defines an assignment. Currently, I'm handling only a scalar
assignment, although Data::Dumper can also generate array and hash
assignments under some circumstances. Gotta leave something for
``release 2.0''.
Lines 21 and 22 define a scalar assignment, and the action to take for
that. A scalar assignment consists of an ``lvalue'' (like a variable)
and an ``rvalue'' (like an expression). Both lvalues and rvalues are
references, so we dereference each of them in the action, and perform
the requested assignment to keep our ``virtual Perl symbol table'' up to
date. The action returns a constant 1 to let the parent rule know
that this rule succeeded. Without that, an undef value being
assigned would have caused that rule to fail (one of my debugging
attempts revealed such, with much head-banging-on-desk until I
realized what I was doing).
Lvalues are defined starting in line 24. The most complex lvalue is a
dereferenced scalar reference, handled in lines 26 to 47. This is
because Data::Dumper can generate a reference path to a specific
entry in the data structure to patch it up so that it points to a
proper place for complex data interelationships. For example, if an
element of @a points to @b, but an element of @b points to
@a, the ``chicken-and-egg'' tie is broken by first generating @a
without the @b reference, then @b with the @a reference, then
patching up @a finally to point to @b.
The definition starting in line 26 uses a deref_head to be a simple
scalar, followed by an optional deref_chain which is one or more
array-element or hash element dereferences. Let's look at the syntax
before we study the actions taken. Line 39 shows us that
deref_head is either a simple_scalar_lvalue or
simple_scalar_rvalue.
Further down in lines 49 and 53, we see that a simple_scalar_lvalue
can be either a scalar variable or a scalar reference dereference.
And that would form the head of the chain. If it's a scalar variable,
we take a reference to a hash element in our ``symbol table'', and
return that. The key is the name of the variable, including the
dollar sign. This permits eventual expansion to include arrays and
hashes in our ``symbol table'', again for version 2.0. For the
dereference of the scalar reference, we emulate the same steps in our
virtual world, again returning a reference for all lvalues.
Once we have the chain head, we then look for a dereference chain (line 40), starting with the mandatory arrow then a hash or array subscript expression. This may be followed with additional arrow-optional hash or array subscript expressions (line 42). Each subscript is returned as a two-element arrayref, with either the keyword ``hash'' or ``array'' followed by the scalar constant selecting the particular element (lines 45 and 47). The action in line 41 rolls up the deref chain as a reference to an array of those two-element arrayrefs.
Back in line 26, we thus have a reference to a starting point for the
deref_head, and possible one or more dereferences to apply to it.
The action in lines 27 to 37 walk the dereference chain to get to the
final target lvalue, and return it (as a reference to a scalar
somewhere in our virtual Perl symbol space).
On the other side of the equation, we've got rvalues of various
shapes, defined in line 58 to be either a simple_scalar_rvalue or a
scalar_lvalue. The loop back to scalar_value is necessary
because any variable reference is also itself a source of values.
Lines 60 to 66 define the only scalar constants that Data::Dumper
seems to emit: undef, simple signed integers, and quoted strings.
These values are returned as references to those values so that
undef can be a valid return value: again, something I figured out
the hard way after my rule for undef kept breaking.
Lines 68 to 75 handle the reference values: scalar references, array
references, and hash references. Again, the syntax is very narrow:
just the types of things I was able to see Data::Dumper generate,
both by trying some sample data, and by lightly examining the source
code to Data::Dumper. I may have missed a form or two, in which
case this grammar will make it easy to add additional forms.
The grammar is nicely recursive: an array reference in turn contains
one or more scalar_rvalue items, which brings us right back to the
same place in the hierarchy, but at a nested level.
Lines 76 to 79 handle blessed references. Again, the syntax is very
specific to what I was able to determine about Data::Dumper's
behavior.
And that's pretty much it. The grammar looks for a series of assignments, each of which is an lvalue being given an rvalue. Some of the lvalues ultimately lead to symbol table entries, which then populate our symbol table hash with keys and values when assigned. Rvalues can be constants, or pointers into existing data in the symbol table. OK, it is somewhat full of smoke and mirrors, and I was rather pleased when the whole thing worked. And on some rainy Oregon afternoon, I hope to extend it to handle arrays and hashes as well, just to make it extremely flexible and universal. I even have some ideas about how to get it to handle globs. But that's for another day: until next time, enjoy!
Listing
=1= #!/usr/bin/perl -w
=2= use strict;
=3= $|++;
=4=
=5= # $::RD_TRACE = 80;
=6= $::RD_HINT = 1;
=7=
=8= use Parse::RecDescent;
=9= use Data::Dumper;
=10=
=11= ## define grammar
=12=
=13= my $parser = Parse::RecDescent->new(q{
=14=
=15= { my %TABLE; }
=16=
=17= file: { %TABLE = (); } assignment(s?) /\z/ { \%TABLE }
=18=
=19= assignment: scalar_assignment | <error>
=20=
=21= scalar_assignment: scalar_lvalue '=' scalar_rvalue ';'
=22= { ${$item{scalar_lvalue}} = ${$item{scalar_rvalue}}; 1; }
=23=
=24= ## lvalues, indicated as reference to value, so we can assign to them
=25=
=26= scalar_lvalue: deref_head deref_chain(?) {
=27= my $return = $item{deref_head};
=28= if ($item{deref_chain}) {
=29= for (@{$item{deref_chain}[0]}) {
=30= if ($_->[0] eq "hash") {
=31= $return = \$$return->{${$_->[1]}};
=32= } elsif ($_->[0] eq "array") {
=33= $return = \$$return->[${$_->[1]}];
=34= } else { die "what is $_->[0]?" }
=35= }
=36= }
=37= $return;
=38= }
=39= deref_head: simple_scalar_lvalue | simple_scalar_rvalue
=40= deref_chain: "->" hash_or_array_subscript deref_chain_more(s?)
=41= { [$item[2], @{$item[3]}] }
=42= deref_chain_more: "->" hash_or_array_subscript | hash_or_array_subscript
=43= hash_or_array_subscript: hash_subscript | array_subscript
=44= hash_subscript: "{" scalar_constant "}"
=45= { ["hash", $item{scalar_constant}] }
=46= array_subscript: "[" scalar_constant "]"
=47= { ["array", $item{scalar_constant}] }
=48=
=49= simple_scalar_lvalue: '$' ident
=50= { \ $TABLE{'$' . $item{ident}} }
=51= ident: /[^\W\d]\w*/
=52=
=53= simple_scalar_lvalue: '$' '{' scalar_rvalue '}'
=54= { \ ${${$item{scalar_rvalue}}} }
=55=
=56= ## rvalues, indicated as reference to value, because "undef" is legal
=57=
=58= scalar_rvalue: simple_scalar_rvalue | scalar_lvalue
=59=
=60= simple_scalar_rvalue: scalar_constant
=61= scalar_constant: 'undef'
=62= { \ undef }
=63= scalar_constant: /-?[1-9]\d*|0/
=64= { \ $item[1] }
=65= scalar_constant: <perl_quotelike>
=66= { \ $item[1][2] }
=67=
=68= simple_scalar_rvalue: "\x5C" scalar_rvalue
=69= { \ $item{scalar_rvalue} }
=70= simple_scalar_rvalue: '[' scalar_rvalue(s? /,/) ']'
=71= { \ [map $$_, @{$item[2]}] }
=72= simple_scalar_rvalue: '{' hashpair(s? /,/) '}'
=73= { \ {map @$_, @{$item[2]}} }
=74= hashpair: scalar_constant '=>' scalar_rvalue
=75= { [${$item{scalar_constant}}, ${$item{scalar_rvalue}}] }
=76= simple_scalar_rvalue: 'bless' '(' scalar_rvalue ',' scalar_constant ')'
=77= { \ bless( ${$item{scalar_rvalue}}, ${$item{scalar_constant}} ) }
=78= simple_scalar_rvalue: 'do' '{' "\x5C" '(' 'my' '$o' '=' scalar_rvalue ')' '}'
=79= { \ do { \ (my $o = ${$item{scalar_rvalue}})} }
=80=
=81= }) or die "compile";
=82=
=83= ## following tests from t/dumper.t in 5.6.1 distribution
=84=
=85= if (0) {
=86= my @c = ('c');
=87= my $c = \@c;
=88= my $b = {};
=89= my $a = [1, $b, $c];
=90= $b->{a} = $a;
=91= $b->{b} = $a->[1];
=92= $b->{c} = $a->[2];
=93=
=94= test([$a, $b, $c], [qw(a b c)]);
=95= }
=96=
=97= if (0) {
=98= my $foo = { "abc\000\'\efg" => "mno\000",
=99= "reftest" => \\1,
=100= };
=101=
=102= test([$foo], [qw($foo)]);
=103= }
=104=
=105= if (0) {
=106= my $foo = 5;
=107= my @foo = (-10,\$foo);
=108= my %foo = (a=>1,b=>\$foo,c=>\@foo);
=109= $foo{d} = \%foo;
=110= $foo[2] = \%foo;
=111=
=112= test([\%foo],[qw($foo)]);
=113= }
=114=
=115= if (0) {
=116= my @dogs = ( 'Fido', 'Wags' );
=117= my %kennel = (
=118= First => \$dogs[0],
=119= Second => \$dogs[1],
=120= );
=121= $dogs[2] = \%kennel;
=122= my $mutts = \%kennel;
=123= test([\@dogs, \%kennel, $mutts], [qw($dogs $kennel $mutts)]);
=124= }
=125=
=126= if (0) {
=127= my $a = [];
=128= $a->[1] = \$a->[0];
=129= test([$a], [qw($a)]);
=130= }
=131=
=132= if (0) {
=133= my $a = \\\\\'foo';
=134= my $b = $$$a;
=135= test([$a, $b], [qw($a $b)]);
=136= }
=137=
=138= if (1) {
=139= my $b;
=140= my $a = [{ a => \$b }, { b => undef }];
=141= $b = [{ c => \$b }, { d => \$a }];
=142= timetest([$a, $b], [qw($a $b)]);
=143= }
=144=
=145= if (0) {
=146= my $a = [[[[\\\\\'foo']]]];
=147= my $b = $a->[0][0];
=148= my $c = $${$b->[0][0]};
=149= test([$a, $b, $c], [qw($a $b $c)]);
=150= }
=151=
=152= if (0) {
=153= my $f = "pearl";
=154= my $e = [ $f ];
=155= my $d = { 'e' => $e };
=156= my $c = [ $d ];
=157= my $b = { 'c' => $c };
=158= my $a = { 'b' => $b };
=159= test([$a, $b, $c, $d, $e, $f], [qw($a $b $c $d $e $f)]);
=160= }
=161=
=162= if (0) {
=163= my $a;
=164= $a = \$a;
=165= my $b = [$a];
=166= test([$b], [qw($b)]);
=167= }
=168=
=169= ## end of tests from t/dumper.t, now some of my own
=170=
=171= if (0) {
=172= my $x = bless {fred => 'flintstone'}, 'x';
=173= my $y = bless \$x, 'y';
=174= timetest([$x, $y], [qw($x $y)]);
=175= }
=176=
=177= sub test {
=178= my $input = Data::Dumper->new(@_)->Purity(1)->Dumpxs;
=179= print "=" x 60, "\ninput:\n$input\n==>\noutput:\n";
=180= my $symbol = $parser->file($input) or die "execute";
=181= print Data::Dumper->new([values %$symbol], [keys %$symbol])->Purity(1)->Dumpxs;
=182= }
=183=
=184= sub timetest {
=185= require Benchmark;
=186=
=187= my $input = Data::Dumper->new(@_)->Purity(1)->Dumpxs;
=188= print "=" x 60, "\ninput:\n$input\n==>\noutput:\n";
=189= Benchmark::timethese(0, {
=190= PRD => sub {
=191= package Dummy;
=192= no strict;
=193= my $symbol = $parser->file($input)
=194= or die "execute";
=195= },
=196= EVAL => sub {
=197= package Dummy;
=198= no strict;
=199= eval $input;
=200= },
=201= });
=202= }