diff options
| -rw-r--r-- | lib/Config/Tree.pm | 34 | ||||
| -rw-r--r-- | lib/Config/Tree/Node/Section.pm | 55 | ||||
| -rw-r--r-- | t/01conf12.t | 9 |
3 files changed, 77 insertions, 21 deletions
diff --git a/lib/Config/Tree.pm b/lib/Config/Tree.pm index 45b934b..f8d6903 100644 --- a/lib/Config/Tree.pm +++ b/lib/Config/Tree.pm @@ -1,5 +1,5 @@ # Configuration parser for Sourceyard -*- perl -*- -# Copyright (C) 2017 Sergey Poznyakoff <gray@gnu.org> +# Copyright (C) 2017, 2018 Sergey Poznyakoff <gray@gnu.org> # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -177,6 +177,9 @@ must issue an appropriate error message using B<$cfg-E<gt>error>, and return 0. =back +In taint mode, any value that matched B<re> expression or passed the B<check> +function will be automatically untainted. + To define a section, use the B<section> keyword, e.g.: core => { @@ -531,6 +534,9 @@ sub _get_section_synt { return } +use constant TAINT => eval '${^TAINT}'; +use constant TESTS => TAINT && defined eval 'require Taint::Util'; + =head2 add_node($path, $node) =cut @@ -609,6 +615,7 @@ sub add_node { # FIXME: is_value? $prev_val = $tree->subtree($name)->value; } + my $nchecks; # Number of checks passed if (exists($x->{re})) { if ($v !~ /$x->{re}/) { $self->error("invalid value for $name", @@ -616,6 +623,7 @@ sub add_node { $self->{_error_count}++; return; } + $nchecks++; } if (my $ck = $x->{check}) { @@ -623,6 +631,10 @@ sub add_node { $self->{_error_count}++; return; } + $nchecks++; + } + if ($nchecks && TESTS) { + $v = Taint::Util::untaint($v); } if ($x->{array}) { @@ -827,25 +839,7 @@ example: sub as_hash { my $self = shift; - my $map = shift // sub { shift; @_ }; - my $hroot = {}; - my @ar; - - push @ar, [ '', $self->tree, $hroot ]; - while (my $elt = shift @ar) { - if ($elt->[1]->is_section) { - my $hr0 = {}; - my ($name, $hr) = &{$map}('section', $elt->[0], $hr0); - $elt->[2]{$name} = $hr0; - while (my ($kw, $val) = each %{$elt->[1]->subtree}) { - push @ar, [ $kw, $val, $hr ]; - } - } else { - my ($name, $value) = &{$map}('value', $elt->[0], $elt->[1]->value); - $elt->[2]{$name} = $value; - } - } - return $hroot->{''}; + $self->tree->as_hash(@_); } sub __lint { diff --git a/lib/Config/Tree/Node/Section.pm b/lib/Config/Tree/Node/Section.pm index 8fec46b..25b1bd5 100644 --- a/lib/Config/Tree/Node/Section.pm +++ b/lib/Config/Tree/Node/Section.pm @@ -57,6 +57,61 @@ sub merge { } } +=head2 $h = $cfg->as_hash + +=head2 $h = $cfg->as_hash($map) + +Returns parse tree converted to a hash reference. If B<$map> is supplied, +it must be a reference to a function. For each I<$key>/I<$value> +pair, this function will be called as: + + ($newkey, $newvalue) = &{$map}($what, $key, $value) + +where B<$what> is C<section> or C<value>, depending on the type of the +hash entry being processed. Upon successful return, B<$newvalue> will be +inserted in the hash slot for the key B<$newkey>. + +If B<$what> is C<section>, B<$value> is always a reference to an empty +hash (since the parse tree is traversed in pre-order fashion). In that +case, the B<$map> function is supposed to do whatever initialization that +is necessary for the new subtree and return as B<$newvalue> either B<$value> +itself, or a reference to a hash available inside the B<$value>. For +example: + + sub map { + my ($what, $name, $val) = @_; + if ($name eq 'section') { + $val->{section} = {}; + $val = $val->{section}; + } + ($name, $val); + } + +=cut + +sub as_hash { + my $self = shift; + my $map = shift // sub { shift; @_ }; + my $hroot = {}; + my @ar; + + push @ar, [ '', $self, $hroot ]; + while (my $elt = shift @ar) { + if ($elt->[1]->is_section) { + my $hr0 = {}; + my ($name, $hr) = &{$map}('section', $elt->[0], $hr0); + $elt->[2]{$name} = $hr0; + while (my ($kw, $val) = each %{$elt->[1]->subtree}) { + push @ar, [ $kw, $val, $hr ]; + } + } else { + my ($name, $value) = &{$map}('value', $elt->[0], $elt->[1]->value); + $elt->[2]{$name} = $value; + } + } + return $hroot->{''}; +} + sub as_string { '(section)' } our $AUTOLOAD; diff --git a/t/01conf12.t b/t/01conf12.t index 8c0655b..1435a70 100644 --- a/t/01conf12.t +++ b/t/01conf12.t @@ -5,7 +5,7 @@ use Test; use TestConfig; use Data::Dumper; -plan(tests => 1); +plan(tests => 2); my $t = new TestConfig( config => [ @@ -29,3 +29,10 @@ ok(Data::Dumper->new([$t->as_hash]) ->Dump, '{"base" => "/etc","core" => {"file" => "passwd","group" => "group","home" => "/home"},"file" => {"passwd" => {"mode" => "0644","root" => {"dir" => "/root","uid" => 0}}}}'); +ok(Data::Dumper->new([$t->tree->File->as_hash]) + ->Sortkeys(1) + ->Useqq(1) + ->Terse(1) + ->Indent(0) + ->Dump, + '{"passwd" => {"mode" => "0644","root" => {"dir" => "/root","uid" => 0}}}'); |