summaryrefslogtreecommitdiff
path: root/lib/Config/Tree.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Config/Tree.pm')
-rw-r--r--lib/Config/Tree.pm34
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 {

Return to:

Send suggestions and report system problems to the System administrator.