import torrus 1.0.9

3 files changed, 2272 insertions, 0 deletions

diff --git a/torrus/perllib/Torrus/ConfigTree/Validator.pm b/torrus/perllib/Torrus/ConfigTree/Validator.pm
new file mode 100644
index 000000000..96923d032
--- /dev/null
+++ b/torrus/perllib/Torrus/ConfigTree/Validator.pm
@@ -0,0 +1,969 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  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
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Validator.pm,v 1.1 2010-12-27 00:03:45 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+
+package Torrus::ConfigTree::Validator;
+
+use Torrus::ConfigTree;
+use Torrus::Log;
+use Torrus::RPN;
+use Torrus::SiteConfig;
+use strict;
+
+Torrus::SiteConfig::loadStyling();
+
+%Torrus::ConfigTree::Validator::reportedErrors = ();
+
+my %rrd_params =
+    (
+     'leaf-type' => {'rrd-def' => {'rrd-ds' => undef,
+                                   'rrd-cf' => {'AVERAGE' => undef,
+                                                'MIN'     => undef,
+                                                'MAX'     => undef,
+                                                'LAST'    => undef},
+                                   'data-file' => undef,
+                                   'data-dir'  => undef},
+                     'rrd-cdef' => {'rpn-expr' => undef}},
+     );
+
+my %rrdmulti_params = ( 'ds-names' => undef );
+
+# Plugins might need to add a new storage type
+our %collector_params =
+    (
+     'collector-type'  => undef,
+     '@storage-type'   => {
+         'rrd' => {
+             'data-file'              => undef,
+             'data-dir'               => undef,
+             'leaf-type'              => {
+                 'rrd-def'  => {'rrd-ds' => undef,
+                                'rrd-cf' => {'AVERAGE' => undef,
+                                             'MIN'     => undef,
+                                             'MAX'     => undef,
+                                             'LAST'    => undef},
+                                'rrd-create-dstype' => {'GAUGE' => undef,
+                                                        'COUNTER' => undef,
+                                                        'DERIVE'  => undef,
+                                                        'ABSOLUTE' => undef },
+                                'rrd-create-rra'         => undef,
+                                'rrd-create-heartbeat'   => undef,
+                                '+rrd-hwpredict'         => {
+                                    'enabled' => {
+                                        'rrd-create-hw-rralen' => undef},
+                                    'disabled' => undef,
+                                }}}},
+         'ext' => {
+             'ext-dstype' => {
+                 'GAUGE' => undef,
+                 'COUNTER32' => undef,
+                 'COUNTER64' => undef },
+             'ext-service-id' => undef,
+             '+ext-service-units' => {
+                 'bytes' => undef }}},
+     'collector-period'      => undef,
+     'collector-timeoffset'  => undef,
+     '+collector-scale'      => undef,
+     '+collector-dispersed-timeoffset' => {
+         'no' => undef,
+         'yes' => undef }
+     # collector-timeoffset-min, max, step, and hashstring are validated
+     # during post-processing
+     );
+
+
+# Plugins might in theory create new datasource types
+our %leaf_params =
+    ('ds-type' => {'rrd-file' => \%rrd_params,
+                   'rrd-multigraph' => \%rrdmulti_params,
+                   'collector' => \%collector_params},
+     'rrgraph-views'             => undef,
+     '+rrd-scaling-base'         => {'1000' => undef, '1024' => undef},
+     '+graph-logarithmic'        => {'yes'  => undef, 'no' => undef},
+     '+graph-rigid-boundaries'   => {'yes'  => undef, 'no' => undef},
+     '+graph-ignore-decorations' => {'yes'  => undef, 'no' => undef});
+
+
+my %monitor_params =
+    ('monitor-type' => {'expression' => {'rpn-expr' => undef},
+                        'failures' => undef},
+     'action'       => undef,
+     'expires'      => undef
+     );
+
+my %action_params =
+    ('action-type' => {'tset' => {'tset-name' => undef},
+                       'exec' => {'command' => undef} }
+     );
+
+my %view_params =
+    ('expires' => undef,
+     'view-type' => {'rrgraph' => {'width' => undef,
+                                   'height' => undef,
+                                   'start' => undef,
+                                   'line-style' => undef,
+                                   'line-color' => undef,
+                                   '+ignore-limits' => {
+                                       'yes'=>undef, 'no'=>undef },
+                                   '+ignore-lower-limit' => {
+                                       'yes'=>undef, 'no'=>undef },
+                                   '+ignore-upper-limit' => {
+                                       'yes'=>undef, 'no'=>undef }},
+                     'rrprint' => {'start' => undef,
+                                   'print-cf' => undef},
+                     'html' => {'html-template' => undef},
+                     'adminfo' => undef}
+     );
+
+
+# Load additional validation, configurable from
+# torrus-config.pl and torrus-siteconfig.pl
+
+foreach my $mod ( @Torrus::Validator::loadLeafValidators )
+{
+    eval( 'require ' . $mod );
+    die( $@ ) if $@;
+    eval( '&' . $mod . '::initValidatorLeafParams( \%leaf_params )' );
+    die( $@ ) if $@;
+}
+
+
+sub validateNodes
+{
+    my $config_tree = shift;
+    my $token = $config_tree->token('/');
+
+    if( defined($token) )
+    {
+        return validateNode($config_tree, $token);
+    }
+    else
+    {
+        Error("The datasource tree is empty");
+        return 0;
+    }
+}
+
+sub validateNode
+{
+    my $config_tree = shift;
+    my $token = shift;
+
+    &Torrus::DB::checkInterrupted();
+
+    my $ok = 1;
+
+    if( $config_tree->isLeaf($token) )
+    {
+        # Verify the default view
+        my $view = $config_tree->getNodeParam( $token, 'default-leaf-view' );
+        if( not defined( $view ) )
+        {
+            my $path = $config_tree->path( $token );
+            Error("Default view is not defined for leaf $path");
+            $ok = 0;
+        }
+        elsif( not $config_tree->{'validator'}{'viewExists'}{$view} and
+               not $config_tree->viewExists( $view ) )
+        {
+            my $path = $config_tree->path( $token );
+            Error("Non-existent view is defined as default for leaf $path");
+            $ok = 0;
+        }
+        else
+        {
+            # Cache the view name
+            $config_tree->{'validator'}{'viewExists'}{$view} = 1;
+        }
+
+        # Verify parameters
+        $ok = validateInstanceParams($config_tree, $token,
+                                     'node', \%leaf_params);
+
+        if( $ok )
+        {
+            my $rrviewslist =
+                $config_tree->getNodeParam( $token, 'rrgraph-views' );
+
+            # Check the cache first
+            if( not $config_tree->{'validator'}{'graphviews'}{$rrviewslist} )
+            {
+                my @rrviews = split( ',', $rrviewslist );
+
+                if( scalar(@rrviews) != 5 )
+                {
+                    my $path = $config_tree->path( $token );
+                    Error('rrgraph-views sould refer 5 views in' . $path);
+                    $ok = 0;
+                }
+                else
+                {
+                    foreach my $view ( @rrviews )
+                    {
+                        if( not $config_tree->viewExists( $view ) )
+                        {
+                            my $path = $config_tree->path( $token );
+                            Error("Non-existent view ($view) is defined in " .
+                                  "rrgraph-views for $path");
+                            $ok = 0;
+                        }
+                        elsif( $config_tree->getParam($view, 'view-type') ne
+                               'rrgraph' )
+                        {
+                            my $path = $config_tree->path( $token );
+                            Error("View $view is not of type rrgraph in " .
+                                  "rrgraph-views for $path");
+                            $ok = 0;
+                        }
+                    }
+                }
+
+                if( $ok )
+                {
+                    # Store the cache
+                    $config_tree->{'validator'}{'graphviews'}{$rrviewslist}=1;
+                }
+            }
+        }
+
+        # Verify monitor references
+        my $mlist = $config_tree->getNodeParam( $token, 'monitor' );
+        if( defined $mlist )
+        {
+            foreach my $param ( 'monitor-period', 'monitor-timeoffset' )
+            {
+                if( not defined( $config_tree->getNodeParam( $token,
+                                                             $param ) ) )
+                {
+                    my $path = $config_tree->path( $token );
+                    Error('Mandatory parameter ' . $param .
+                          ' is not defined in ' . $path);
+                    $ok = 0;
+                }
+            }
+            
+            foreach my $monitor ( split(',', $mlist) )
+            {
+                if( not $config_tree->{'validator'}{'monitorExists'}{$monitor}
+                    and
+                    not $config_tree->monitorExists( $monitor ) )
+                {
+                    my $path = $config_tree->path( $token );
+                    Error("Non-existent monitor: $monitor in $path");
+                    $ok = 0;
+                }
+                else
+                {
+                    $config_tree->{'validator'}{'monitorExists'}{$monitor} = 1;
+                }
+            }
+            
+            my $varstring =
+                $config_tree->getNodeParam( $token, 'monitor-vars' );
+            if( defined $varstring )
+            {
+                foreach my $pair ( split( '\s*;\s*', $varstring ) )
+                {
+                    if( $pair !~ /^\w+\s*\=\s*[0-9\-+.eU]+$/o )
+                    {
+                        Error("Syntax error in monitor variables: $pair");
+                        $ok = 0;
+                    }
+                }
+            }
+
+            my $action_target =
+                $config_tree->getNodeParam($token, 'monitor-action-target');
+            if( defined( $action_target ) )
+            {
+                my $target = $config_tree->getRelative($token, $action_target);
+                if( not defined( $target ) )
+                {
+                    my $path = $config_tree->path( $token );
+                    Error('monitor-action-target points to an invalid path: ' .
+                          $action_target . ' in ' . $path);
+                    $ok = 0;
+                }
+                elsif( not $config_tree->isLeaf( $target ) )
+                {
+                    my $path = $config_tree->path( $token );
+                    Error('monitor-action-target must point to a leaf: ' .
+                          $action_target . ' in ' . $path);
+                    $ok = 0;
+                }
+            }
+        }
+
+        # Verify if the data-dir exists
+        my $datadir = $config_tree->getNodeParam( $token, 'data-dir' );
+        if( defined $datadir )
+        {
+            if( not $config_tree->{'validator'}{'dirExists'}{$datadir} and
+                not ( -d $datadir ) and
+                not $Torrus::ConfigTree::Validator::reportedErrors{$datadir} )
+            {
+                my $path = $config_tree->path( $token );
+                Error("Directory does not exist: $datadir in $path");
+                $ok = 0;
+                $Torrus::ConfigTree::Validator::reportedErrors{$datadir} = 1;
+            }
+            else
+            {
+                # Store the cache
+                $config_tree->{'validator'}{'dirExists'}{$datadir} = 1;
+            }
+        }
+
+        # Verify type-specific parameters
+        my $dsType = $config_tree->getNodeParam( $token, 'ds-type' );
+        if( not defined( $dsType ) )
+        {
+            # Writer has already complained
+            return 0;
+        }
+
+        if( $dsType eq 'rrd-multigraph' )
+        {
+            my @dsNames =
+                split(',', $config_tree->getNodeParam( $token, 'ds-names' ) );
+
+            if( scalar(@dsNames) == 0 )
+            {
+                my $path = $config_tree->path( $token );
+                Error("ds-names list is empty in $path");
+                $ok = 0;
+            }
+            foreach my $dname ( @dsNames )
+            {
+                my $param = 'ds-expr-' . $dname;
+                my $expr = $config_tree->getNodeParam( $token, $param );
+                if( not defined( $expr ) )
+                {
+                    my $path = $config_tree->path( $token );
+                    Error("Parameter $param is not defined in $path");
+                    $ok = 0;
+                }
+                else
+                {
+                    $ok = validateRPN( $token, $expr, $config_tree ) ? $ok : 0;
+                }
+
+                foreach my $paramprefix ( 'graph-legend-', 'line-style-',
+                                          'line-color-', 'line-order-' )
+                {
+                    my $param = $paramprefix.$dname;
+                    my $value = $config_tree->getNodeParam($token, $param);
+                    if( not defined( $value ) )
+                    {
+                        my $path = $config_tree->path( $token );
+                        Error('Parameter ' . $param .
+                              ' is not defined in ' . $path);
+                        $ok = 0;
+                    }
+                    elsif( $param eq 'line-style-' and
+                           not validateLine( $value ) )
+                    {
+                        my $path = $config_tree->path( $token );
+                        Error('Parameter ' . $param .
+                              ' is defined incorrectly in ' . $path);
+                        $ok = 0;
+                    }
+                    elsif( $param eq 'line-color-' and
+                           not validateColor( $value ) )
+                    {
+                        my $path = $config_tree->path( $token );
+                        Error('Parameter ' . $param .
+                              ' is defined incorrectly in ' . $path);
+                        $ok = 0;
+                    }
+                }
+            }
+        }
+        elsif( $dsType eq 'rrd-file' and
+               $config_tree->getNodeParam( $token, 'leaf-type' ) eq 'rrd-cdef')
+        {
+            my $expr = $config_tree->getNodeParam( $token, 'rpn-expr' );
+            if( defined( $expr ) )
+            {
+                $ok = validateRPN( $token, $expr, $config_tree ) ? $ok : 0;
+            }
+            # Otherwise already reported by  validateInstanceParams()
+        }
+        elsif($dsType eq 'collector' and
+              $config_tree->getNodeParam( $token, 'collector-type' ) eq 'snmp')
+        {
+            # Check the OID syntax
+            my $oid = $config_tree->getNodeParam( $token, 'snmp-object' );
+            if( defined($oid) and $oid =~ /^\./o )
+            {
+                my $path = $config_tree->path( $token );
+                Error("Invalid syntax for snmp-object in " .
+                      $path . ": OID must not start with dot");
+                $ok = 0;
+            }
+        }
+    }
+    else
+    {
+        # This is subtree
+        my $view = $config_tree->getNodeParam( $token,
+                                               'default-subtree-view' );
+
+        if( not defined( $view ) )
+        {
+            my $path = $config_tree->path( $token );
+            Error("Default view is not defined for subtree $path");
+            $ok = 0;
+        }
+        elsif( not $config_tree->{'validator'}{'viewExists'}{$view} and
+               not $config_tree->viewExists( $view ) )
+        {
+            my $path = $config_tree->path( $token );
+            Error("Non-existent view is defined as default for subtree $path");
+            $ok = 0;
+        }
+        else
+        {
+            # Store the cache
+            $config_tree->{'validator'}{'viewExists'}{$view} = 1;
+        }
+
+        foreach my $ctoken ( $config_tree->getChildren($token) )
+        {
+            if( not $config_tree->isAlias($ctoken) )
+            {
+                $ok = validateNode($config_tree, $ctoken)
+                    ? $ok:0;
+            }
+        }
+    }
+    return $ok;
+}
+
+my %validFuntcionNames =
+    ( 'AVERAGE' => 1,
+      'MIN'     => 1,
+      'MAX'     => 1,
+      'LAST'    => 1,
+      'T'       => 1 );
+
+
+sub validateRPN
+{
+    my $token = shift;
+    my $expr  = shift;
+    my $config_tree = shift;
+    my $timeoffset_supported = shift;
+
+    &Torrus::DB::checkInterrupted();
+    
+    my $ok = 1;
+
+    # There must be at least one DS reference
+    my $ds_couter = 0;
+
+    my $rpn = new Torrus::RPN;
+
+    # The callback for RPN translation
+    my $callback = sub
+    {
+        my ($noderef, $timeoffset) = @_;
+
+        my $function;
+        if( $noderef =~ s/^(.+)\@//o )
+        {
+            $function = $1;
+        }
+
+        if( defined( $function ) and not $validFuntcionNames{$function} )
+        {
+            my $path = $config_tree->path($token);
+            Error('Invalid function name ' . $function .
+                  ' in node reference at ' . $path);
+            $ok = 0;
+            return undef;
+        }            
+        
+        my $leaf = length($noderef) > 0 ?
+            $config_tree->getRelative($token, $noderef) : $token;
+
+        if( not defined $leaf )
+        {
+            my $path = $config_tree->path($token);
+            Error("Cannot find relative reference $noderef at $path");
+            $ok = 0;
+            return undef;
+        }
+        if( not $config_tree->isLeaf( $leaf ) )
+        {
+            my $path = $config_tree->path($token);
+            Error("Relative reference $noderef at $path is not a leaf");
+            $ok = 0;
+            return undef;
+        }
+        if( $config_tree->getNodeParam($leaf, 'leaf-type') ne 'rrd-def' )
+        {
+            my $path = $config_tree->path($token);
+            Error("Relative reference $noderef at $path must point to a ".
+                  "leaf of type rrd-def");
+            $ok = 0;
+            return undef;
+        }
+        if( defined( $timeoffset ) and not $timeoffset_supported )
+        {
+            my $path = $config_tree->path($token);
+            Error("Time offsets are not supported at $path");
+            $ok = 0;
+            return undef;
+        }
+
+        $ds_couter++;
+        return 'TESTED';
+    };
+
+    $rpn->translate( $expr, $callback );
+    if( $ok and $ds_couter == 0 )
+    {
+        my $path = $config_tree->path($token);
+        Error("RPN must contain at least one DS reference at $path");
+        $ok = 0;
+    }
+    return $ok;
+}
+
+
+
+sub validateViews
+{
+    my $config_tree = shift;
+    my $ok = 1;
+
+    foreach my $view ($config_tree->getViewNames())
+    {
+        &Torrus::DB::checkInterrupted();
+        
+        $ok = validateInstanceParams($config_tree, $view,
+                                     'view', \%view_params) ? $ok:0;
+        if( $ok and $config_tree->getParam($view, 'view-type') eq 'rrgraph' )
+        {
+            my $hrulesList = $config_tree->getParam($view, 'hrules');
+            if( defined( $hrulesList ) )
+            {
+                foreach my $hrule ( split(',', $hrulesList ) )
+                {
+                    my $valueParam =
+                        $config_tree->getParam($view, 'hrule-value-' . $hrule);
+                    if( not defined( $valueParam ) or $valueParam !~ /^\S+$/o )
+                    {
+                        Error('Mandatory parameter hrule-value-' . $hrule .
+                              ' is not defined or incorrect for view ' .
+                              $view);
+                        $ok = 0;
+                    }
+                    my $color =
+                        $config_tree->getParam($view, 'hrule-color-'.$hrule);
+                    if( not defined( $color ) )
+                    {
+                        Error('Mandatory parameter hrule-color-' . $hrule .
+                              ' is not defined for view ' . $view);
+                        $ok = 0;
+                    }
+                    else
+                    {
+                        $ok = validateColor( $color ) ? $ok:0;
+                    }
+                }
+            }
+
+            my $decorList = $config_tree->getParam($view, 'decorations');
+            if( defined( $decorList ) )
+            {
+                foreach my $decorName ( split(',', $decorList ) )
+                {
+                    foreach my $paramName ( qw(order style color expr) )
+                    {
+                        my $param = 'dec-' . $paramName . '-' . $decorName;
+                        if( not defined( $config_tree->
+                                         getParam($view, $param) ) )
+                        {
+                            Error('Missing parameter: ' . $param .
+                                  ' in view ' . $view);
+                            $ok = 0;
+                        }
+                    }
+
+                    $ok = validateLine( $config_tree->
+                                        getParam($view,
+                                                 'dec-style-' . $decorName) )
+                        ? $ok:0;
+                    $ok = validateColor( $config_tree->
+                                         getParam($view,
+                                                  'dec-color-' . $decorName) )
+                        ? $ok:0;
+                }
+            }
+
+            $ok = validateColor( $config_tree->getParam($view, 'line-color') )
+                ? $ok:0;
+            $ok = validateLine( $config_tree->getParam($view, 'line-style') )
+                ? $ok:0;
+
+            my $gprintValues = $config_tree->getParam($view, 'gprint-values');
+            if( defined( $gprintValues ) and length( $gprintValues ) > 0 )
+            {
+                foreach my $gprintVal ( split(',', $gprintValues ) )
+                {
+                    my $format =
+                        $config_tree->getParam($view,
+                                               'gprint-format-' . $gprintVal);
+                    if( not defined( $format ) or length( $format ) == 0 )
+                    {
+                        Error('GPRINT format for ' . $gprintVal .
+                              ' is not defined for view ' .  $view);
+                        $ok = 0;
+                    }
+                }
+            }
+        }
+    }
+    return $ok;
+}
+
+
+sub validateColor
+{
+    my $color = shift;
+    my $ok = 1;
+
+    if( $color !~ /^\#[0-9a-fA-F]{6}$/o )
+    {
+        if( $color =~ /^\#\#(\S+)$/o )
+        {
+            if( not $Torrus::Renderer::graphStyles{$1}{'color'} )
+            {
+                Error('Incorrect color reference: ' . $color);
+                $ok = 0;
+            }
+        }
+        else
+        {
+            Error('Incorrect color syntax: ' . $color);
+            $ok = 0;
+        }
+    }
+
+    return $ok;
+}
+
+
+sub validateLine
+{
+    my $line = shift;
+    my $ok = 1;
+
+    if( $line =~ /^\#\#(\S+)$/o )
+    {
+        if( not $Torrus::Renderer::graphStyles{$1}{'line'} )
+        {
+            Error('Incorrect line style reference: ' . $line);
+            $ok = 0;
+        }
+    }
+    elsif( not $Torrus::SiteConfig::validLineStyles{$line} )
+    {
+        Error('Incorrect line syntax: ' . $line);
+        $ok = 0;
+    }
+
+    return $ok;
+}
+
+
+sub validateMonitors
+{
+    my $config_tree = shift;
+    my $ok = 1;
+
+    foreach my $action ($config_tree->getActionNames())
+    {        
+        $ok = validateInstanceParams($config_tree, $action,
+                                     'action', \%action_params) ? $ok:0;
+        my $atype = $config_tree->getParam($action, 'action-type');
+        if( $atype eq 'tset' )
+        {
+            my $tset = $config_tree->getParam($action, 'tset-name');
+            if( defined $tset )
+            {
+                $tset = 'S'.$tset;
+                if( not $config_tree->tsetExists( $tset ) )
+                {
+                    Error("Token-set does not exist: $tset in action $action");
+                    $ok = 0;
+                }
+            }
+            # Otherwise the error is already reported by validateInstanceParams
+        }
+        elsif( $atype eq 'exec' )
+        {
+            my $launch_when = $config_tree->getParam($action, 'launch-when');
+            if( defined $launch_when )
+            {
+                foreach my $when ( split(',', $launch_when) )
+                {
+                    my $matched = 0;
+                    foreach my $event ('set', 'repeat', 'clear', 'forget')
+                    {
+                        if( $when eq $event )
+                        {
+                            $matched = 1;
+                        }
+                    }
+                    if( not $matched )
+                    {
+                        if( $when eq 'throw' )
+                        {
+                            Error('Event type "throw" is no longer ' .
+                                  'supported. Replace with "set".');
+                        }
+                        else
+                        {
+                            Error("Invalid value in parameter launch-when " .
+                                  "in action $action: $when");
+                        }
+                        $ok = 0;
+                    }
+                }
+            }
+
+            my $setenv_dataexpr =
+                $config_tree->getParam( $action, 'setenv-dataexpr' );
+
+            if( defined( $setenv_dataexpr ) )
+            {
+                # <param name="setenv_dataexpr"
+                #        value="ENV1=expr1, ENV2=expr2"/>
+
+                foreach my $pair ( split( ',', $setenv_dataexpr ) )
+                {
+                    my ($env, $param) = split( '=', $pair );
+                    if( not $param )
+                    {
+                        Error("Syntax error in setenv-dataexpr in action " .
+                              $action . ": \"" . $pair . "\"");
+                        $ok = 0;
+                    }
+                    elsif( $env =~ /\W/o )
+                    {
+                        Error("Illegal characters in environment variable ".
+                              "name in setenv-dataexpr in action " . $action .
+                              ": \"" . $env . "\"");
+                        $ok = 0;
+                    }
+                    elsif( not defined ($config_tree->getParam( $action,
+                                                                $param ) ) )
+                    {
+                        Error("Parameter referenced in setenv-dataexpr is " .
+                              "not defined in action " .
+                              $action . ": " . $param);
+                        $ok = 0;
+                    }
+                }
+            }
+        }
+    }
+
+    foreach my $monitor ($config_tree->getMonitorNames())
+    {
+        $ok = validateInstanceParams($config_tree, $monitor,
+                                     'monitor', \%monitor_params) ? $ok:0;
+        my $alist = $config_tree->getParam( $monitor, 'action' );
+        foreach my $action ( split(',', $alist ) )
+        {
+            if( not $config_tree->actionExists( $action ) )
+            {
+                Error("Non-existent action: $action in monitor $monitor");
+                $ok = 0;
+            }
+        }
+    }
+    return $ok;
+}
+
+
+sub validateTokensets
+{
+    my $config_tree = shift;
+    my $ok = 1;
+
+    my $view = $config_tree->getParam( 'SS', 'default-tsetlist-view' );
+    if( not defined( $view ) )
+    {
+        Error("View is not defined for tokensets list");
+        $ok = 0;
+    }
+    elsif( not $config_tree->viewExists( $view ) )
+    {
+        Error("Non-existent view is defined for tokensets list");
+        $ok = 0;
+    }
+
+    foreach my $tset ($config_tree->getTsets())
+    {
+        &Torrus::DB::checkInterrupted();
+        
+        $view = $config_tree->getParam($tset, 'default-tset-view');
+        if( not defined( $view ) )
+        {
+            $view = $config_tree->getParam('SS', 'default-tset-view');
+        }
+
+        if( not defined( $view ) )
+        {
+            Error("Default view is not defined for tokenset $tset");
+            $ok = 0;
+        }
+        elsif( not $config_tree->viewExists( $view ) )
+        {
+            Error("Non-existent view is defined for tokenset $tset");
+            $ok = 0;
+        }
+    }
+    return $ok;
+}
+
+
+
+
+sub validateInstanceParams
+{
+    my $config_tree = shift;
+    my $inst_name = shift;
+    my $inst_type = shift;
+    my $mapref = shift;
+
+    &Torrus::DB::checkInterrupted();
+    
+    # Debug("Validating $inst_type $inst_name");
+
+    my $ok = 1;
+    my @namemaps = ($mapref);
+
+    while( $ok and scalar(@namemaps) > 0 )
+    {
+        my @next_namemaps = ();
+
+        foreach my $namemap (@namemaps)
+        {
+            foreach my $paramkey (keys %{$namemap})
+            {
+                # Debug("Checking param: $pname");
+
+                my $pname = $paramkey;
+                my $mandatory = 1;
+                if( $pname =~ s/^\+//o )
+                {
+                    $mandatory = 0;
+                }
+
+                my $listval = 0;
+                if( $pname =~ s/^\@//o )
+                {
+                    $listval = 1;
+                }
+                
+                my $pvalue =
+                    $config_tree->getInstanceParam($inst_type,
+                                                   $inst_name, $pname);
+
+                my @pvalues;
+                if( $listval )
+                {
+                    @pvalues = split(',', $pvalue);
+                }
+                else
+                {
+                    @pvalues = ( $pvalue );
+                }
+                
+                if( not defined( $pvalue ) )
+                {
+                    if( $mandatory )
+                    {
+                        my $msg;
+                        if( $inst_type eq 'node' )
+                        {
+                            $msg = $config_tree->path( $inst_name );
+                        }
+                        else
+                        {
+                            $msg = "$inst_type $inst_name";
+                        }
+                        Error("Mandatory parameter $pname is not ".
+                              "defined for $msg");
+                        $ok = 0;
+                    }
+                }
+                else
+                {
+                    if( ref( $namemap->{$paramkey} ) )
+                    {
+                        foreach my $pval ( @pvalues )
+                        {
+                            if( exists $namemap->{$paramkey}->{$pval} )
+                            {
+                                if( defined $namemap->{$paramkey}->{$pval} )
+                                {
+                                    push( @next_namemaps,
+                                          $namemap->{$paramkey}->{$pval} );
+                                }
+                            }
+                            else
+                            {
+                                my $msg;
+                                if( $inst_type eq 'node' )
+                                {
+                                    $msg = $config_tree->path( $inst_name );
+                                }
+                                else
+                                {
+                                    $msg = "$inst_type $inst_name";
+                                }
+                                Error("Parameter $pname has ".
+                                      "unknown value: $pval for $msg");
+                                $ok = 0;
+                            }
+                        }
+                    }
+                }
+            }
+        }
+        @namemaps = @next_namemaps;
+    }
+    return $ok;
+}
+
+
+
+1;
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/ConfigTree/Writer.pm b/torrus/perllib/Torrus/ConfigTree/Writer.pm
new file mode 100644
index 000000000..9c1af8f86
--- /dev/null
+++ b/torrus/perllib/Torrus/ConfigTree/Writer.pm
@@ -0,0 +1,755 @@
+#  Copyright (C) 2002-2007  Stanislav Sinyagin
+#
+#  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
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: Writer.pm,v 1.1 2010-12-27 00:03:45 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+#
+# Write access for ConfigTree
+#
+
+package Torrus::ConfigTree::Writer;
+
+use Torrus::ConfigTree;
+our @ISA=qw(Torrus::ConfigTree);
+
+use Torrus::Log;
+use Torrus::TimeStamp;
+use Torrus::SiteConfig;
+use Torrus::ServiceID;
+    
+use strict;
+use Digest::MD5 qw(md5); # needed as hash function
+
+
+our %multigraph_remove_space =
+    ('ds-expr-' => 1,
+     'graph-legend-' => 0);
+
+
+# instance of Torrus::ServiceID object, if needed
+my $srvIdParams;
+
+# tree names where we initialized service IDs
+my %srvIdInitialized;
+
+
+sub new
+{
+    my $proto = shift;
+    my %options = @_;
+    my $class = ref($proto) || $proto;
+    $options{'-WriteAccess'} = 1;
+    my $self  = $class->SUPER::new( %options );
+    if( not defined( $self ) )
+    {
+        return undef;
+    }
+    
+    bless $self, $class;
+
+    $self->{'viewparent'} = {};
+    $self->{'mayRunCollector'} =
+        Torrus::SiteConfig::mayRunCollector( $self->treeName() );
+
+    $self->{'collectorInstances'} =
+        Torrus::SiteConfig::collectorInstances( $self->treeName() );
+
+    $self->{'db_collectortokens'} = [];
+    foreach my $instance ( 0 .. ($self->{'collectorInstances'} - 1) )
+    {
+        $self->{'db_collectortokens'}->[$instance] =
+            new Torrus::DB( 'collector_tokens' . '_' .
+                            $instance . '_' . $self->{'ds_config_instance'},
+                            -Subdir => $self->treeName(),
+                            -WriteAccess => 1,
+                            -Truncate    => 1 );
+    }
+
+    # delay writing of frequently changed values
+    $self->{'db_dsconfig'}->delay();
+    $self->{'db_otherconfig'}->delay();    
+    return $self;
+}
+
+
+sub newToken
+{
+    my $self = shift;
+    my $token = $self->{'next_free_token'};
+    $token = 1 unless defined( $token );
+    $self->{'next_free_token'} = $token + 1;
+    return sprintf('T%.4d', $token);
+}
+
+
+sub setParam
+{
+    my $self  = shift;
+    my $name  = shift;
+    my $param = shift;
+    my $value = shift;
+
+    if( $self->getParamProperty( $param, 'remspace' ) )
+    {
+        $value =~ s/\s+//go;
+    }
+
+    $self->{'paramcache'}{$name}{$param} = $value;
+    $self->{'db_otherconfig'}->put( 'P:'.$name.':'.$param, $value );
+    $self->{'db_otherconfig'}->addToList('Pl:'.$name, $param);
+}
+
+sub setNodeParam
+{
+    my $self  = shift;
+    my $name  = shift;
+    my $param = shift;
+    my $value = shift;
+
+    if( $self->getParamProperty( $param, 'remspace' ) )
+    {
+        $value =~ s/\s+//go;
+    }
+
+    $self->{'paramcache'}{$name}{$param} = $value;
+    $self->{'db_dsconfig'}->put( 'P:'.$name.':'.$param, $value );
+    $self->{'db_dsconfig'}->addToList('Pl:'.$name, $param);
+}
+
+
+sub setParamProperty
+{
+    my $self = shift;
+    my $param = shift;
+    my $prop = shift;
+    my $value = shift;
+
+    $self->{'paramprop'}{$prop}{$param} = $value;
+    $self->{'db_paramprops'}->put( $param . ':' . $prop, $value );
+}
+
+
+sub initRoot
+{
+    my $self  = shift;
+    if( not defined( $self->token('/') ) )
+    {
+        my $token = $self->newToken();
+        $self->{'db_dsconfig'}->put( 'pt:/', $token );
+        $self->{'db_dsconfig'}->put( 'tp:'.$token, '/' );
+        $self->{'db_dsconfig'}->put( 'n:'.$token, 0 );
+        $self->{'nodetype_cache'}{$token} = 0;
+    }
+}
+
+sub addChild
+{
+    my $self = shift;
+    my $token = shift;
+    my $childname = shift;
+    my $isAlias = shift;
+
+    if( not $self->isSubtree( $token ) )
+    {
+        Error('Cannot add a child to a non-subtree node: ' .
+              $self->path($token));
+        return undef;
+    }
+
+    my $path = $self->path($token) . $childname;
+
+    # If the child already exists, do nothing
+
+    my $ctoken = $self->token($path);
+    if( not defined($ctoken) )
+    {
+        $ctoken = $self->newToken();
+
+        $self->{'db_dsconfig'}->put( 'pt:'.$path, $ctoken );
+        $self->{'db_dsconfig'}->put( 'tp:'.$ctoken, $path );
+
+        $self->{'db_dsconfig'}->addToList( 'c:'.$token, $ctoken );
+        $self->{'db_dsconfig'}->put( 'p:'.$ctoken, $token );
+        $self->{'parentcache'}{$ctoken} = $token;
+
+        my $nodeType;
+        if( $isAlias )
+        {
+            $nodeType = 2; # alias
+        }
+        elsif( $childname =~ /\/$/o )
+        {
+            $nodeType = 0; # subtree
+        }
+        else
+        {
+            $nodeType = 1; # leaf
+        }
+        $self->{'db_dsconfig'}->put( 'n:'.$ctoken, $nodeType );
+        $self->{'nodetype_cache'}{$ctoken} = $nodeType;
+    }
+    return $ctoken;
+}
+
+sub setAlias
+{
+    my $self = shift;
+    my $token = shift;
+    my $apath = shift;
+
+    my $ok = 1;
+
+    my $iamLeaf = $self->isLeaf($token);
+
+    # TODO: Add more verification here
+    if( not defined($apath) or $apath !~ /^\//o or
+        ( not $iamLeaf and $apath !~ /\/$/o ) or
+        ( $iamLeaf and $apath =~ /\/$/o ) )
+    {
+        my $path = $self->path($token);
+        Error("Incorrect alias at $path: $apath"); $ok = 0;
+    }
+    elsif( $self->token( $apath ) )
+    {
+        my $path = $self->path($token);
+        Error("Alias already exists: $apath at $path"); $ok = 0;
+    }
+    else
+    {
+        # Go through the alias and create subtrees if neccessary
+
+        my @pathelements = $self->splitPath($apath);
+        my $aliasChildName = pop @pathelements;
+
+        my $nodepath = '';
+        my $parent_token = $self->token('/');
+
+        foreach my $nodename ( @pathelements )
+        {
+            $nodepath .= $nodename;
+            my $child_token = $self->token( $nodepath );
+            if( not defined( $child_token ) )
+            {
+                $child_token = $self->addChild( $parent_token, $nodename );
+                if( not defined( $child_token ) )
+                {
+                    return 0;
+                }
+            }
+            $parent_token = $child_token;
+        }
+
+        my $alias_token = $self->addChild( $parent_token, $aliasChildName, 1 );
+        if( not defined( $alias_token ) )
+        {
+            return 0;
+        }
+
+        $self->{'db_dsconfig'}->put( 'a:'.$alias_token, $token );
+        $self->{'db_dsconfig'}->addToList( 'ar:'.$token, $alias_token );
+        $self->{'db_aliases'}->put( $apath, $token );
+    }
+    return $ok;
+}
+
+sub addView
+{
+    my $self = shift;
+    my $vname = shift;
+    my $parent = shift;
+    $self->{'db_otherconfig'}->addToList('V:', $vname);
+    if( defined( $parent ) )
+    {
+        $self->{'viewparent'}{$vname} = $parent;
+    }
+}
+
+
+sub addMonitor
+{
+    my $self = shift;
+    my $mname = shift;
+    $self->{'db_otherconfig'}->addToList('M:', $mname);
+}
+
+
+sub addAction
+{
+    my $self = shift;
+    my $aname = shift;
+    $self->{'db_otherconfig'}->addToList('A:', $aname);
+}
+
+
+sub addDefinition
+{
+    my $self = shift;
+    my $name = shift;
+    my $value = shift;
+    $self->{'db_dsconfig'}->put( 'd:'.$name, $value );
+    $self->{'db_dsconfig'}->addToList('D:', $name);
+}
+
+
+sub setVar
+{
+    my $self = shift;
+    my $token = shift;
+    my $name = shift;
+    my $value = shift;
+    
+    $self->{'setvar'}{$token}{$name} = $value;
+}
+
+
+sub isTrueVar
+{
+    my $self = shift;
+    my $token = shift;
+    my $name = shift;
+
+    my $ret = 0;
+
+    while( defined( $token ) and
+           not defined( $self->{'setvar'}{$token}{$name} ) )
+    {
+        $token = $self->getParent( $token );
+    }
+
+    if( defined( $token ) )
+    {
+        my $value = $self->{'setvar'}{$token}{$name};
+        if( defined( $value ) )
+        {
+            if( $value eq 'true' or
+                $value =~ /^\d+$/o and $value )
+            {
+                $ret = 1;
+            }
+        }
+    }
+    
+    return $ret;
+}
+
+sub finalize
+{
+    my $self = shift;
+    my $status = shift;
+
+    if( $status )
+    {
+        # write delayed data
+        $self->{'db_dsconfig'}->commit();
+        $self->{'db_otherconfig'}->commit();    
+        
+        Verbose('Configuration has compiled successfully. Switching over to ' .
+             'DS config instance ' . $self->{'ds_config_instance'} .
+             ' and Other config instance ' .
+             $self->{'other_config_instance'} );
+
+        $self->setReady(1);
+        if( not $self->{'-NoDSRebuild'} )
+        {
+            $self->{'db_config_instances'}->
+                put( 'ds:' . $self->treeName(),
+                     $self->{'ds_config_instance'} );
+        }
+
+        $self->{'db_config_instances'}->
+            put( 'other:' . $self->treeName(),
+                 $self->{'other_config_instance'} );
+
+        Torrus::TimeStamp::init();
+        Torrus::TimeStamp::setNow($self->treeName() . ':configuration');
+        Torrus::TimeStamp::release();
+    }
+}
+
+
+sub postProcess
+{
+    my $self = shift;
+
+    my $ok = $self->postProcessNodes();
+
+    # Propagate view inherited parameters
+    $self->{'viewParamsProcessed'} = {};
+    foreach my $vname ( $self->getViewNames() )
+    {
+        &Torrus::DB::checkInterrupted();
+        
+        $self->propagateViewParams( $vname );
+    }
+    return $ok;
+}
+
+
+
+sub postProcessNodes
+{
+    my $self = shift;
+    my $token = shift;
+
+    &Torrus::DB::checkInterrupted();
+
+    my $ok = 1;
+
+    if( not defined( $token ) )
+    {
+        $token = $self->token('/');
+    }
+
+    my $nodeid = $self->getNodeParam( $token, 'nodeid', 1 );
+    if( defined( $nodeid ) )
+    {
+        # verify the uniqueness of nodeid
+        
+        my $oldToken = $self->{'db_nodeid'}->get($nodeid);
+        if( defined($oldToken) )
+        {
+            Error('Non-unique nodeid ' . $nodeid .
+                  ' in ' . $self->path($token) .
+                  ' and ' . $self->path($oldToken));
+            $ok = 0;
+        }
+        else
+        {
+            $self->{'db_nodeid'}->put($nodeid, $token);
+        }
+    }
+
+    
+    if( $self->isLeaf($token) )
+    {
+        # Process static tokenset members
+
+        my $tsets = $self->getNodeParam( $token, 'tokenset-member' );
+        if( defined( $tsets ) )
+        {
+            foreach my $tset ( split(/,/o, $tsets) )
+            {
+                my $tsetName = 'S'.$tset;
+                if( not $self->tsetExists( $tsetName ) )
+                {
+                    my $path = $self->path( $token );
+                    Error("Referenced undefined token set $tset in $path");
+                    $ok = 0;
+                }
+                else
+                {
+                    $self->tsetAddMember( $tsetName, $token, 'static' );
+                }
+            }
+        }
+
+        my $dsType = $self->getNodeParam( $token, 'ds-type' );
+        if( defined( $dsType ) )
+        {
+            if( $dsType eq 'rrd-multigraph' )
+            {
+                # Expand parameter substitutions in multigraph leaves
+                
+                my @dsNames =
+                    split(/,/o, $self->getNodeParam($token, 'ds-names') );
+                
+                foreach my $dname ( @dsNames )
+                {
+                    foreach my $param ( 'ds-expr-', 'graph-legend-' )
+                    {
+                        my $dsParam = $param . $dname;
+                        my $value = $self->getNodeParam( $token, $dsParam );
+                        if( defined( $value ) )
+                        {
+                            my $newValue = $value;
+                            if( $multigraph_remove_space{$param} )
+                            {
+                                $newValue =~ s/\s+//go;
+                            }
+                            $newValue =
+                                $self->expandSubstitutions( $token, $dsParam,
+                                                            $newValue );
+                            if( $newValue ne $value )
+                            {
+                                $self->setNodeParam( $token, $dsParam,
+                                                     $newValue );
+                            }
+                        }
+                    }
+                }
+            }
+            elsif( $dsType eq 'collector' and $self->{'mayRunCollector'} )
+            {
+                # Split the collecting job between collector instances
+                my $instance = 0;
+                my $nInstances = $self->{'collectorInstances'};
+
+                my $oldOffset =
+                    $self->getNodeParam($token, 'collector-timeoffset');
+                my $newOffset = $oldOffset;
+                
+                my $period =
+                    $self->getNodeParam($token, 'collector-period');
+                
+                if( $nInstances > 1 )
+                {
+                    my $hashString =
+                        $self->getNodeParam($token,
+                                            'collector-instance-hashstring');
+                    if( not defined( $hashString ) )
+                    {
+                        Error('collector-instance-hashstring is not defined ' .
+                              'in ' . $self->path( $token ));
+                        $hashString = '';
+                    }
+                    
+                    $instance =
+                        unpack( 'N', md5( $hashString ) ) % $nInstances;
+                }          
+
+                $self->setNodeParam( $token,
+                                     'collector-instance',
+                                     $instance );
+                
+                my $dispersed =
+                    $self->getNodeParam($token,
+                                        'collector-dispersed-timeoffset');
+                if( defined( $dispersed ) and $dispersed eq 'yes' )
+                {
+                    # Process dispersed collector offsets
+                    
+                    my %p;
+                    foreach my $param ( 'collector-timeoffset-min',
+                                        'collector-timeoffset-max',
+                                        'collector-timeoffset-step',
+                                        'collector-timeoffset-hashstring' )
+                    {
+                        my $val = $self->getNodeParam( $token, $param );
+                        if( not defined( $val ) )
+                        {
+                            Error('Mandatory parameter ' . $param . ' is not '.
+                                  ' defined in ' . $self->path( $token ));
+                            $ok = 0;
+                        }
+                        else
+                        {
+                            $p{$param} = $val;
+                        }
+                    }
+
+                    if( $ok )
+                    {
+                        my $min = $p{'collector-timeoffset-min'};
+                        my $max = $p{'collector-timeoffset-max'};
+                        if( $max < $min )
+                        {
+                            Error('collector-timeoffset-max is less than ' .
+                                  'collector-timeoffset-min in ' .
+                                  $self->path( $token ));
+                            $ok = 0;
+                        }
+                        else
+                        {
+                            my $step = $p{'collector-timeoffset-step'};
+                            my $hashString =
+                                $p{'collector-timeoffset-hashstring'};
+                            
+                            my $bucketSize = int( ($max - $min) / $step );
+                            $newOffset =
+                                $min
+                                +
+                                $step * ( unpack( 'N', md5( $hashString ) ) %
+                                          $bucketSize )
+                                +
+                                $instance * int( $step / $nInstances );
+                        }
+                    }
+                }
+                else
+                {
+                    $newOffset += $instance * int( $period / $nInstances ); 
+                } 
+
+                $newOffset %= $period;
+                
+                if( $newOffset != $oldOffset )
+                {
+                    $self->setNodeParam( $token,
+                                         'collector-timeoffset',
+                                         $newOffset );
+                }
+
+                $self->{'db_collectortokens'}->[$instance]->put
+                    ( $token, sprintf('%d:%d', $period, $newOffset) );
+
+                my $storagetypes =
+                    $self->getNodeParam( $token, 'storage-type' );
+                foreach my $stype ( split(/,/o, $storagetypes) )
+                {
+                    if( $stype eq 'ext' )
+                    {
+                        if( not defined( $srvIdParams ) )
+                        {
+                            $srvIdParams =
+                                new Torrus::ServiceID( -WriteAccess => 1 );
+                        }
+
+                        my $srvTrees =
+                            $self->getNodeParam($token, 'ext-service-trees');
+
+                        if( not defined( $srvTrees ) or
+                            length( $srvTrees ) == 0 )
+                        {
+                            $srvTrees = $self->treeName();
+                        }
+                                                
+                        my $serviceid =
+                            $self->getNodeParam($token, 'ext-service-id');
+
+                        foreach my $srvTree (split(/\s*,\s*/o, $srvTrees))
+                        {
+                            if( not Torrus::SiteConfig::treeExists($srvTree) )
+                            {
+                                Error
+                                    ('Error processing ext-service-trees' .
+                                     'for ' . $self->path( $token ) .
+                                     ': tree ' . $srvTree .
+                                     ' does not exist');
+                                $ok = 0;
+                            }
+                            else
+                            {
+                                if( not $srvIdInitialized{$srvTree} )
+                                {
+                                    $srvIdParams->cleanAllForTree
+                                        ( $srvTree );
+                                    $srvIdInitialized{$srvTree} = 1;
+                                }
+                                else
+                                {
+                                    if( $srvIdParams->idExists( $serviceid,
+                                                                $srvTree ) )
+                                    {
+                                        Error('Duplicate ServiceID: ' .
+                                              $serviceid . ' in tree ' .
+                                              $srvTree);
+                                        $ok = 0;
+                                    }
+                                }
+                            }
+                        }
+
+                        if( $ok )
+                        {
+                            # sorry for ackward Emacs auto-indent
+                            my $params = {
+                                'trees' => $srvTrees,
+                                'token' => $token,
+                                'dstype' =>
+                                    $self->getNodeParam($token,
+                                                        'ext-dstype'),
+                                    'units' =>
+                                    $self->getNodeParam
+                                    ($token, 'ext-service-units')
+                                };
+                            
+                            $srvIdParams->add( $serviceid, $params );
+                        }
+                    }
+                }
+            }
+        }
+        else
+        {
+            my $path = $self->path( $token );
+            Error("Mandatory parameter 'ds-type' is not defined for $path");
+            $ok = 0;
+        }            
+    }
+    else
+    {
+        foreach my $ctoken ( $self->getChildren( $token ) )
+        {
+            if( not $self->isAlias( $ctoken ) )
+            {
+                $ok = $self->postProcessNodes( $ctoken ) ? $ok:0;
+            }
+        }
+    }
+    return $ok;
+}
+
+
+sub propagateViewParams
+{
+    my $self = shift;
+    my $vname = shift;
+
+    # Avoid processing the same view twice
+    if( $self->{'viewParamsProcessed'}{$vname} )
+    {
+        return;
+    }
+
+    # First we do the same for parent
+    my $parent = $self->{'viewparent'}{$vname};
+    if( defined( $parent ) )
+    {
+        $self->propagateViewParams( $parent );
+
+        my $parentParams = $self->getParams( $parent );
+        foreach my $param ( keys %{$parentParams} )
+        {
+            if( not defined( $self->getParam( $vname, $param ) ) )
+            {
+                $self->setParam( $vname, $param, $parentParams->{$param} );
+            }
+        }
+    }
+
+    # mark this view as processed
+    $self->{'viewParamsProcessed'}{$vname} = 1;
+}
+
+
+sub validate
+{
+    my $self = shift;
+
+    my $ok = 1;
+
+    $self->{'is_writing'} = undef;
+
+    if( not $self->{'-NoDSRebuild'} )
+    {
+        $ok = Torrus::ConfigTree::Validator::validateNodes($self);
+    }
+    $ok = Torrus::ConfigTree::Validator::validateViews($self) ? $ok:0;
+    $ok = Torrus::ConfigTree::Validator::validateMonitors($self) ? $ok:0;
+    $ok = Torrus::ConfigTree::Validator::validateTokensets($self) ? $ok:0;
+
+    return $ok;
+}
+
+
+1;
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
diff --git a/torrus/perllib/Torrus/ConfigTree/XMLCompiler.pm b/torrus/perllib/Torrus/ConfigTree/XMLCompiler.pm
new file mode 100644
index 000000000..0874270da
--- /dev/null
+++ b/torrus/perllib/Torrus/ConfigTree/XMLCompiler.pm
@@ -0,0 +1,548 @@
+#  Copyright (C) 2002  Stanislav Sinyagin
+#
+#  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
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: XMLCompiler.pm,v 1.1 2010-12-27 00:03:45 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+
+package Torrus::ConfigTree::XMLCompiler;
+
+use Torrus::ConfigTree::Writer;
+our @ISA=qw(Torrus::ConfigTree::Writer);
+
+use Torrus::ConfigTree;
+use Torrus::ConfigTree::Validator;
+use Torrus::SiteConfig;
+use Torrus::Log;
+use Torrus::TimeStamp;
+
+use XML::LibXML;
+use strict;
+
+sub new
+{
+    my $proto = shift;
+    my %options = @_;
+    my $class = ref($proto) || $proto;
+
+    $options{'-Rebuild'} = 1;
+
+    my $self  = $class->SUPER::new( %options );
+    if( not defined( $self ) )
+    {
+        return undef;
+    }
+
+    bless $self, $class;
+
+    if( $options{'-NoDSRebuild'} )
+    {
+        $self->{'-NoDSRebuild'} = 1;
+    }
+
+    $self->{'files_processed'} = {};
+
+    return $self;
+}
+
+
+sub compile
+{
+    my $self = shift;
+    my $filename = shift;
+
+    &Torrus::DB::checkInterrupted();
+    
+    $filename = Torrus::SiteConfig::findXMLFile($filename);
+    if( not defined( $filename ) )
+    {
+        return 0;
+    }
+                    
+    # Make sure we process each file only once
+    if( $self->{'files_processed'}{$filename} )
+    {
+        return 1;
+    }
+    else
+    {
+        $self->{'files_processed'}{$filename} = 1;
+    }
+
+    Verbose('Compiling ' . $filename);
+
+    my $ok = 1;
+    my $parser = new XML::LibXML;
+    my $doc;
+    eval { $doc = $parser->parse_file( $filename );  };
+    if( $@ )
+    {
+        Error("Failed to parse $filename: $@");
+        return 0;
+    }
+
+    my $root = $doc->documentElement();
+
+    # Initialize the '/' element
+    $self->initRoot();
+
+    my $node;
+
+    # First of all process all pre-required files
+    foreach $node ( $root->getElementsByTagName('include') )
+    {
+        my $incfile = $node->getAttribute('filename');
+        if( not $incfile )
+        {
+            Error("No filename given in include statement in $filename");
+            $ok = 0;
+        }
+        else
+        {
+            $ok = $self->compile( $incfile ) ? $ok:0;
+        }
+    }
+
+    foreach $node ( $root->getElementsByTagName('param-properties') )
+    {
+        $ok = $self->compile_paramprops( $node ) ? $ok:0;
+    }
+
+    if( not $self->{'-NoDSRebuild'} )
+    {
+        foreach $node ( $root->getElementsByTagName('definitions') )
+        {
+            $ok = $self->compile_definitions( $node ) ? $ok:0;
+        }
+
+        foreach $node ( $root->getElementsByTagName('datasources') )
+        {
+            $ok = $self->compile_ds( $node ) ? $ok:0;
+        }
+    }
+
+    foreach $node ( $root->getElementsByTagName('monitors') )
+    {
+        $ok = $self->compile_monitors( $node ) ? $ok:0;
+    }
+
+    foreach $node ( $root->getElementsByTagName('token-sets') )
+    {
+        $ok = $self->compile_tokensets( $node ) ? $ok:0;
+    }
+
+    foreach $node ( $root->getElementsByTagName('views') )
+    {
+        $ok = $self->compile_views( $node ) ? $ok:0;
+    }
+
+    return $ok;
+}
+
+
+sub compile_definitions
+{
+    my $self = shift;
+    my $node = shift;
+    my $ok = 1;
+
+    foreach my $def ( $node->getChildrenByTagName('def') )
+    {
+        &Torrus::DB::checkInterrupted();
+        
+        my $name = $def->getAttribute('name');
+        my $value = $def->getAttribute('value');
+        if( not $name )
+        {
+            Error("Definition without a name"); $ok = 0;
+        }
+        elsif( not $value )
+        {
+            Error("Definition without value: $name"); $ok = 0;
+        }
+        elsif( defined $self->getDefinition($name) )
+        {
+            Error("Duplicate definition: $name"); $ok = 0;
+        }
+        else
+        {
+            $self->addDefinition($name, $value);
+        }
+    }
+    return $ok;
+}
+
+
+sub compile_paramprops
+{
+    my $self = shift;
+    my $node = shift;
+    my $ok = 1;
+
+    foreach my $def ( $node->getChildrenByTagName('prop') )
+    {
+        &Torrus::DB::checkInterrupted();
+          
+        my $param = $def->getAttribute('param'); 
+        my $prop = $def->getAttribute('prop');
+        my $value = $def->getAttribute('value');
+        if( not $param or not $prop or not defined($value) )
+        {
+            Error("Property definition error"); $ok = 0;
+        }
+        else
+        {
+            $self->setParamProperty($param, $prop, $value);
+        }
+    }
+    return $ok;
+}
+
+
+
+# Process <param name="name" value="value"/> and put them into DB.
+# Usage: $self->compile_params($node, $name);
+
+sub compile_params
+{
+    my $self = shift;
+    my $node = shift;
+    my $name = shift;
+    my $isDS = shift;
+
+    &Torrus::DB::checkInterrupted();
+          
+    my $ok = 1;
+    foreach my $p_node ( $node->getChildrenByTagName('param') )
+    {
+        my $param = $p_node->getAttribute('name');
+        my $value = $p_node->getAttribute('value');
+        if( not defined($value) )
+        {
+            $value = $p_node->textContent();
+        }
+        if( not $param )
+        {
+            Error("Parameter without name in $name"); $ok = 0;
+        }
+        else
+        {
+            # Remove spaces in the head and tail.
+            $value =~ s/^\s+//om;
+            $value =~ s/\s+$//om;
+
+            if( $isDS )
+            {
+                $self->setNodeParam($name, $param, $value);
+            }
+            else
+            {
+                $self->setParam($name, $param, $value);
+            }
+        }
+    }
+    return $ok;
+}
+
+
+sub compile_ds
+{
+    my $self = shift;
+    my $ds_node = shift;
+    my $ok = 1;
+
+    # First, process templates. We expect them to be direct children of
+    # <datasources>
+
+    foreach my $template ( $ds_node->getChildrenByTagName('template') )
+    {
+        my $name = $template->getAttribute('name');
+        if( not $name )
+        {
+            Error("Template without a name"); $ok = 0;
+        }
+        elsif( defined $self->{'Templates'}->{$name} )
+        {
+            Error("Duplicate template names: $name"); $ok = 0;
+        }
+        else
+        {
+            $self->{'Templates'}->{$name} = $template;
+        }
+    }
+
+    # Recursively traverse the tree
+    $ok = $self->compile_subtrees( $ds_node, $self->token('/') ) ? $ok:0;
+
+    return $ok;
+}
+
+
+
+
+sub validate_nodename
+{
+    my $self = shift;
+    my $name = shift;
+
+    return ( $name =~ /^[0-9A-Za-z_\-\.\:]+$/o and
+             $name !~ /\.\./o );
+}
+
+sub compile_subtrees
+{
+    my $self = shift;
+    my $node = shift;
+    my $token = shift;
+    my $iamLeaf = shift;
+    
+    my $ok = 1;
+
+    # Apply templates
+
+    foreach my $templateapp ( $node->getChildrenByTagName('apply-template') )
+    {
+        my $name = $templateapp->getAttribute('name');
+        if( not $name )
+        {
+            my $path = $self->path($token);
+            Error("Template application without a name at $path"); $ok = 0;
+        }
+        else
+        {
+            my $template = $self->{'Templates'}->{$name};
+            if( not defined $template )
+            {
+                my $path = $self->path($token);
+                Error("Cannot find template named $name at $path"); $ok = 0;
+            }
+            else
+            {
+                $ok = $self->compile_subtrees
+                    ($template, $token, $iamLeaf) ? $ok:0;
+            }
+        }
+    }
+
+    $ok = $self->compile_params($node, $token, 1);
+
+    # Handle aliases -- we are still in compile_subtrees()
+
+    foreach my $alias ( $node->getChildrenByTagName('alias') )
+    {
+        my $apath = $alias->textContent();
+        $apath =~ s/\s+//mgo;
+        $ok = $self->setAlias($token, $apath) ? $ok:0;
+    }
+
+    foreach my $setvar ( $node->getChildrenByTagName('setvar') )        
+    {
+        my $name = $setvar->getAttribute('name');
+        my $value = $setvar->getAttribute('value');
+        if( not defined( $name ) or not defined( $value ) )
+        {
+            my $path = $self->path($token);
+            Error("Setvar statement without name or value in $path"); $ok = 0;
+        }
+        else
+        {
+            $self->setVar( $token, $name, $value );
+        }
+    }
+
+    # Compile-time variables
+    
+    foreach my $iftrue ( $node->getChildrenByTagName('iftrue') )        
+    {
+        my $var = $iftrue->getAttribute('var');
+        if( not defined( $var ) )
+        {
+            my $path = $self->path($token);
+            Error("Iftrue statement without variable name in $path"); $ok = 0;
+        }
+        elsif( $self->isTrueVar( $token, $var ) )
+        {
+            $ok = $self->compile_subtrees( $iftrue, $token, $iamLeaf ) ? $ok:0;
+        }
+    }
+
+    foreach my $iffalse ( $node->getChildrenByTagName('iffalse') )        
+    {
+        my $var = $iffalse->getAttribute('var');
+        if( not defined( $var ) )
+        {
+            my $path = $self->path($token);
+            Error("Iffalse statement without variable name in $path"); $ok = 0;
+        }
+        elsif( not $self->isTrueVar( $token, $var ) )
+        {
+            $ok = $self->compile_subtrees
+                ( $iffalse, $token, $iamLeaf ) ? $ok:0;
+        }
+    }
+
+    
+    # Compile child nodes -- the last part of compile_subtrees()
+
+    if( not $iamLeaf )
+    {
+        foreach my $subtree ( $node->getChildrenByTagName('subtree') )
+        {
+            my $name = $subtree->getAttribute('name');
+            if( not defined( $name ) or length( $name ) == 0 )
+            {
+                my $path = $self->path($token);
+                Error("Subtree without a name at $path"); $ok = 0;
+            }
+            else
+            {
+                if( $self->validate_nodename( $name ) )
+                {
+                    my $stoken = $self->addChild($token, $name.'/');
+                    $ok = $self->compile_subtrees( $subtree, $stoken ) ? $ok:0;
+                }
+                else
+                {
+                    my $path = $self->path($token);
+                    Error("Invalid subtree name: $name at $path"); $ok = 0;
+                }
+            }
+        }
+
+        foreach my $leaf ( $node->getChildrenByTagName('leaf') )
+        {
+            my $name = $leaf->getAttribute('name');
+            if( not defined( $name ) or length( $name ) == 0 )
+            {
+                my $path = $self->path($token);
+                Error("Leaf without a name at $path"); $ok = 0;
+            }
+            else
+            {
+                if( $self->validate_nodename( $name ) )
+                {
+                    my $ltoken = $self->addChild($token, $name);
+                    $ok = $self->compile_subtrees( $leaf, $ltoken, 1 ) ? $ok:0;
+                }
+                else
+                {
+                    my $path = $self->path($token);
+                    Error("Invalid leaf name: $name at $path"); $ok = 0;
+                }
+            }
+        }
+    }
+    return $ok;
+}
+
+
+sub compile_monitors
+{
+    my $self = shift;
+    my $mon_node = shift;
+    my $ok = 1;
+
+    foreach my $monitor ( $mon_node->getChildrenByTagName('monitor') )
+    {
+        my $mname = $monitor->getAttribute('name');
+        if( not $mname )
+        {
+            Error("Monitor without a name"); $ok = 0;
+        }
+        else
+        {
+            $ok = $self->addMonitor( $mname );
+            $ok = $self->compile_params($monitor, $mname) ? $ok:0;
+        }
+    }
+
+    foreach my $action ( $mon_node->getChildrenByTagName('action') )
+    {
+        my $aname = $action->getAttribute('name');
+        if( not $aname )
+        {
+            Error("Action without a name"); $ok = 0;
+        }
+        else
+        {
+            $self->addAction( $aname );
+            $ok = $self->compile_params($action, $aname);
+        }
+    }
+    return $ok;
+}
+
+
+sub compile_tokensets
+{
+    my $self = shift;
+    my $tsets_node = shift;
+    my $ok = 1;
+
+    $ok = $self->compile_params($tsets_node, 'SS') ? $ok:0;
+
+    foreach my $tokenset ( $tsets_node->getChildrenByTagName('token-set') )
+    {
+        my $sname = $tokenset->getAttribute('name');
+        if( not $sname )
+        {
+            Error("Token-set without a name"); $ok = 0;
+        }
+        else
+        {
+            $sname = 'S'. $sname;
+            $ok = $self->addTset( $sname );
+            $ok = $self->compile_params($tokenset, $sname) ? $ok:0;
+        }
+    }
+    return $ok;
+}
+
+
+sub compile_views
+{
+    my $self = shift;
+    my $vw_node = shift;
+    my $parentname = shift;
+    my $ok = 1;
+
+    foreach my $view ( $vw_node->getChildrenByTagName('view') )
+    {
+        my $vname = $view->getAttribute('name');
+        if( not $vname )
+        {
+            Error("View without a name"); $ok = 0;
+        }
+        else
+        {
+            $self->addView( $vname, $parentname );
+            $ok = $self->compile_params( $view, $vname ) ? $ok:0;
+            # Process child views
+            $ok = $self->compile_views( $view, $vname ) ? $ok:0;
+        }
+    }
+    return $ok;
+}
+
+
+
+1;
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End: