diff options
Diffstat (limited to 'lib/Config/Tree.pm')
-rw-r--r-- | lib/Config/Tree.pm | 34 |
1 files changed, 14 insertions, 20 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 { |