summaryrefslogtreecommitdiffabout
authorSergey Poznyakoff <gray@gnu.org.ua>2018-05-04 09:56:40 (GMT)
committer Sergey Poznyakoff <gray@gnu.org.ua>2018-05-04 09:56:40 (GMT)
commit66965159ef993c4886f8eb2c7b3395c75df4e763 (patch) (side-by-side diff)
treec721d28e7dbcd31fafce8f96da04e115373f4cc4
parent783e1a2e76f1bdc90fd72557b9117c4a5101a36f (diff)
downloadconfig-ast-66965159ef993c4886f8eb2c7b3395c75df4e763.tar.gz
config-ast-66965159ef993c4886f8eb2c7b3395c75df4e763.tar.bz2
Implement as_hash in Config::Tree::Node::Section
* lib/Config/Tree.pm (add_node): Untaint values that matched re or passed the check function. (as_hash): Delegate to tree->as_hash * lib/Config/Tree/Node/Section.pm (as_hash): New method. * t/01conf12.t: Test Section::as_hash.
Diffstat (more/less context) (ignore whitespace changes)
-rw-r--r--lib/Config/Tree.pm34
-rw-r--r--lib/Config/Tree/Node/Section.pm55
-rw-r--r--t/01conf12.t9
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}}}');

Return to:

Send suggestions and report system problems to the System administrator.