From 32cefc2d846f9946bf6e5b84cd914b5e2959dbfa Mon Sep 17 00:00:00 2001 From: Stephen Hemminger Date: Fri, 21 Nov 2008 17:09:30 -0800 Subject: Convert VyattaConfig (et al) to Vyatta::Config Use hierarchal directory structure --- Makefile.am | 15 +- lib/Vyatta/Config.pm | 603 +++++++++++++++++++++++++++++++++ lib/Vyatta/ConfigDOMTree.pm | 372 ++++++++++++++++++++ lib/Vyatta/ConfigLoad.pm | 424 +++++++++++++++++++++++ lib/Vyatta/ConfigOutput.pm | 374 ++++++++++++++++++++ lib/Vyatta/Misc.pm | 486 ++++++++++++++++++++++++++ lib/Vyatta/TypeChecker.pm | 229 +++++++++++++ scripts/VyattaConfig.pm | 603 --------------------------------- scripts/VyattaConfigDOMTree.pm | 370 -------------------- scripts/VyattaConfigLoad.pm | 421 ----------------------- scripts/VyattaConfigOutput.pm | 371 -------------------- scripts/VyattaIpTablesAddressFilter.pm | 207 ----------- scripts/VyattaMisc.pm | 486 -------------------------- scripts/VyattaTypeChecker.pm | 228 ------------- scripts/vyatta-check-typeless-node.pl | 6 +- scripts/vyatta-cli-expand-var.pl | 4 +- scripts/vyatta-config-gen-sets.pl | 4 +- scripts/vyatta-config-loader.pl | 4 +- scripts/vyatta-find-type.pl | 4 +- scripts/vyatta-interfaces.pl | 26 +- scripts/vyatta-load-config.pl | 6 +- scripts/vyatta-output-config.pl | 12 +- scripts/vyatta-save-config.pl | 8 +- scripts/vyatta-validate-type.pl | 4 +- 24 files changed, 2534 insertions(+), 2733 deletions(-) create mode 100755 lib/Vyatta/Config.pm create mode 100755 lib/Vyatta/ConfigDOMTree.pm create mode 100755 lib/Vyatta/ConfigLoad.pm create mode 100755 lib/Vyatta/ConfigOutput.pm create mode 100755 lib/Vyatta/Misc.pm create mode 100755 lib/Vyatta/TypeChecker.pm delete mode 100755 scripts/VyattaConfig.pm delete mode 100755 scripts/VyattaConfigDOMTree.pm delete mode 100755 scripts/VyattaConfigLoad.pm delete mode 100755 scripts/VyattaConfigOutput.pm delete mode 100755 scripts/VyattaIpTablesAddressFilter.pm delete mode 100755 scripts/VyattaMisc.pm delete mode 100755 scripts/VyattaTypeChecker.pm mode change 100644 => 100755 scripts/vyatta-check-typeless-node.pl mode change 100644 => 100755 scripts/vyatta-config-gen-sets.pl mode change 100644 => 100755 scripts/vyatta-interfaces.pl diff --git a/Makefile.am b/Makefile.am index 7de4e17..9e60f85 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1,5 +1,5 @@ cfgdir = $(datadir)/vyatta-cfg/templates -share_perl5dir = /opt/vyatta/share/perl5 +share_perl5dir = /opt/vyatta/share/perl5/Vyatta completiondir = /etc/bash_completion.d initddir = /etc/init.d defaultdir = /etc/default @@ -45,13 +45,12 @@ sbin_SCRIPTS += scripts/vyatta-interfaces.pl sbin_SCRIPTS += scripts/vyatta-irqaffin sbin_SCRIPTS += scripts/vyatta-check-typeless-node.pl -share_perl5_SCRIPTS = scripts/VyattaConfig.pm -share_perl5_SCRIPTS += scripts/VyattaConfigDOMTree.pm -share_perl5_SCRIPTS += scripts/VyattaConfigOutput.pm -share_perl5_SCRIPTS += scripts/VyattaConfigLoad.pm -share_perl5_SCRIPTS += scripts/VyattaMisc.pm -share_perl5_SCRIPTS += scripts/VyattaTypeChecker.pm -share_perl5_SCRIPTS += scripts/VyattaIpTablesAddressFilter.pm +share_perl5_DATA = lib/Vyatta/Config.pm +share_perl5_DATA += lib/Vyatta/Misc.pm +share_perl5_DATA += lib/Vyatta/TypeChecker.pm +share_perl5_DATA += lib/Vyatta/ConfigDOMTree.pm +share_perl5_DATA += lib/Vyatta/ConfigOutput.pm +share_perl5_DATA += lib/Vyatta/ConfigLoad.pm default_DATA = etc/default/vyatta-cfg diff --git a/lib/Vyatta/Config.pm b/lib/Vyatta/Config.pm new file mode 100755 index 0000000..7074d9c --- /dev/null +++ b/lib/Vyatta/Config.pm @@ -0,0 +1,603 @@ +#!/usr/bin/perl + +# Author: An-Cheng Huang +# Date: 2007 +# Description: vyatta configuration parser + +# **** License **** +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License version 2 as +# published by the Free Software Foundation. +# +# 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. +# +# This code was originally developed by Vyatta, Inc. +# Portions created by Vyatta are Copyright (C) 2006, 2007, 2008 Vyatta, Inc. +# All Rights Reserved. +# **** End License **** + +package Vyatta::Config; + +use strict; + +use Vyatta::ConfigDOMTree; + +my %fields = ( + _changes_only_dir_base => $ENV{VYATTA_CHANGES_ONLY_DIR}, + _new_config_dir_base => $ENV{VYATTA_TEMP_CONFIG_DIR}, + _active_dir_base => $ENV{VYATTA_ACTIVE_CONFIGURATION_DIR}, + _vyatta_template_dir => $ENV{VYATTA_CONFIG_TEMPLATE}, + _current_dir_level => "/", + _level => undef, +); + +sub new { + my $that = shift; + my $class = ref ($that) || $that; + my $self = { + %fields, + }; + + bless $self, $class; + return $self; +} + +sub _set_current_dir_level { + my ($self) = @_; + my $level = $self->{_level}; + + $level =~ s/\//%2F/g; + $level =~ s/\s+/\//g; + + $self->{_current_dir_level} = "/$level"; + return $self->{_current_dir_level}; +} + +## setLevel("level") +# if "level" is supplied, set the current level of the hierarchy we are working on +# return the current level +sub setLevel { + my ($self, $level) = @_; + + $self->{_level} = $level if defined($level); + $self->_set_current_dir_level(); + + return $self->{_level}; +} + +## listNodes("level") +# return array of all nodes at "level" +# level is relative +sub listNodes { + my ($self, $path) = @_; + my @nodes = (); + + if (defined $path) { + $path =~ s/\//%2F/g; + $path =~ s/\s+/\//g; + $path = $self->{_new_config_dir_base} . $self->{_current_dir_level} . "/" . $path; + } + else { + $path = $self->{_new_config_dir_base} . $self->{_current_dir_level}; + } + + #print "DEBUG Vyatta::Config->listNodes(): path = $path\n"; + opendir DIR, "$path" or return (); + @nodes = grep !/^\./, readdir DIR; + closedir DIR; + + my @nodes_modified = (); + while (@nodes) { + my $tmp = pop (@nodes); + $tmp =~ s/\n//g; + $tmp =~ s/%2F/\//g; + #print "DEBUG Vyatta::Config->listNodes(): node = $tmp\n"; + push @nodes_modified, $tmp; + } + + return @nodes_modified; +} + +## listOrigNodes("level") +# return array of all original nodes (i.e., before any current change; i.e., +# in "working") at "level" +# level is relative +sub listOrigNodes { + my ($self, $path) = @_; + my @nodes = (); + + if (defined $path) { + $path =~ s/\//%2F/g; + $path =~ s/\s+/\//g; + $path = $self->{_active_dir_base} . $self->{_current_dir_level} . "/" + . $path; + } + else { + $path = $self->{_active_dir_base} . $self->{_current_dir_level}; + } + + #print "DEBUG Vyatta::Config->listNodes(): path = $path\n"; + opendir DIR, "$path" or return (); + @nodes = grep !/^\./, readdir DIR; + closedir DIR; + + my @nodes_modified = (); + while (@nodes) { + my $tmp = pop (@nodes); + $tmp =~ s/\n//g; + $tmp =~ s/%2F/\//g; + #print "DEBUG Vyatta::Config->listNodes(): node = $tmp\n"; + push @nodes_modified, $tmp; + } + + return @nodes_modified; +} + +## listOrigNodes("level") +# return array of all original nodes (i.e., before any current change; i.e., +# in "working") at "level" +# level is relative +sub listOrigNodesNoDef { + my ($self, $path) = @_; + my @nodes = (); + + if (defined $path) { + $path =~ s/\//%2F/g; + $path =~ s/\s+/\//g; + $path = $self->{_active_dir_base} . $self->{_current_dir_level} . "/" + . $path; + } + else { + $path = $self->{_active_dir_base} . $self->{_current_dir_level}; + } + + #print "DEBUG Vyatta::Config->listNodes(): path = $path\n"; + opendir DIR, "$path" or return (); + @nodes = grep !/^\./, readdir DIR; + closedir DIR; + + my @nodes_modified = (); + while (@nodes) { + my $tmp = pop (@nodes); + $tmp =~ s/\n//g; + $tmp =~ s/%2F/\//g; + #print "DEBUG Vyatta::Config->listNodes(): node = $tmp\n"; + if ($tmp ne 'def') { + push @nodes_modified, $tmp; + } + } + + return @nodes_modified; +} + +## returnParent("level") +# return the name of parent node relative to the current hierarchy +# in this case "level" is set to the parent dir ".. .." +# for example +sub returnParent { + my ($self, $node) = @_; + my @x, my $tmp; + + # split our hierarchy into vars on a stack + my @level = split /\s+/, $self->{_level}; + + # count the number of parents we need to lose + # and then pop 1 less + @x = split /\s+/, $node; + for ($tmp = 1; $tmp < @x; $tmp++) { + pop @level; + } + + # return the parent + $tmp = pop @level; + return $tmp; +} + +## returnValue("node") +# returns the value of "node" or undef if the node doesn't exist . +# node is relative +sub returnValue { + my ( $self, $node ) = @_; + my $tmp; + + $node =~ s/\//%2F/g; + $node =~ s/\s+/\//g; + + if ( -f "$self->{_new_config_dir_base}$self->{_current_dir_level}/$node/node.val" ) { + open FILE, "$self->{_new_config_dir_base}$self->{_current_dir_level}/$node/node.val" || return undef; + read FILE, $tmp, 16384; + close FILE; + + $tmp =~ s/\n$//; + return $tmp; + } + else { + return undef; + } +} + + +## returnOrigValue("node") +# returns the original value of "node" (i.e., before the current change; i.e., +# in "working") or undef if the node doesn't exist. +# node is relative +sub returnOrigValue { + my ( $self, $node ) = @_; + my $tmp; + + $node =~ s/\//%2F/g; + $node =~ s/\s+/\//g; + my $filepath = "$self->{_active_dir_base}$self->{_current_dir_level}/$node"; + if ( -f "$filepath/node.val") { + open FILE, "$filepath/node.val" || return undef; + read FILE, $tmp, 16384; + close FILE; + + $tmp =~ s/\n$//; + return $tmp; + } else { + return undef; + } +} + +## returnValues("node") +# returns an array of all the values of "node", or an empty array if the values do not exist. +# node is relative +sub returnValues { + my $val = returnValue(@_); + my @values = (); + if (defined($val)) { + @values = split("\n", $val); + } + return @values; +} + +## returnOrigValues("node") +# returns an array of all the original values of "node" (i.e., before the +# current change; i.e., in "working"), or an empty array if the values do not +# exist. +# node is relative +sub returnOrigValues { + my $val = returnOrigValue(@_); + my @values = (); + if (defined($val)) { + @values = split("\n", $val); + } + return @values; +} + +## exists("node") +# Returns true if the "node" exists. +sub exists { + my ( $self, $node ) = @_; + $node =~ s/\//%2F/g; + $node =~ s/\s+/\//g; + + if ( -d "$self->{_new_config_dir_base}$self->{_current_dir_level}/$node" ) { + #print "DEBUG: the dir is there\n"; + return !0; + } else { + return undef; + } +} + +## existsOrig("node") +# Returns true if the "original node" exists. +sub existsOrig { + my ( $self, $node ) = @_; + $node =~ s/\//%2F/g; + $node =~ s/\s+/\//g; + + if ( -d "$self->{_active_dir_base}$self->{_current_dir_level}/$node" ) { + return 1; + } else { + return undef; + } +} + +## isDeleted("node") +# is the "node" deleted. node is relative. returns true or false +sub isDeleted { + my ($self, $node) = @_; + $node =~ s/\//%2F/g; + $node =~ s/\s+/\//g; + + my $filepathAct + = "$self->{_active_dir_base}$self->{_current_dir_level}/$node"; + my $filepathNew + = "$self->{_new_config_dir_base}$self->{_current_dir_level}/$node"; + + if ((-e $filepathAct) && !(-e $filepathNew)) { + return 1; + } + return 0; +} + +## listDeleted("level") +# return array of deleted nodes in the "level" +# "level" defaults to current +sub listDeleted { + my ($self, $path) = @_; + my @new_nodes = $self->listNodes("$path"); + my @orig_nodes = $self->listOrigNodes("$path"); + my %new_hash = map { $_ => 1 } @new_nodes; + my @deleted = grep { !defined($new_hash{$_}) } @orig_nodes; + return @deleted; +} + +## isChanged("node") +# will check the change_dir to see if the "node" has been changed from a previous +# value. returns true or false. +sub isChanged { + my ($self, $node) = @_; + + # let's setup the filepath for the change_dir + $node =~ s/\//%2F/g; + $node =~ s/\s+/\//g; + my $filepath = "$self->{_changes_only_dir_base}$self->{_current_dir_level}/$node"; + + # if the node exists in the change dir, it's modified. + if (-e "$filepath") { return 1; } + else { return 0; } +} + +## isChangedOrDeleted("node") +# is the "node" changed or deleted. node is relative. returns true or false +sub isChangedOrDeleted { + my ($self, $node) = @_; + + $node =~ s/\//%2F/g; + $node =~ s/\s+/\//g; + + my $filepathChg + = "$self->{_changes_only_dir_base}$self->{_current_dir_level}/$node"; + if (-e $filepathChg) { + return 1; + } + + my $filepathAct + = "$self->{_active_dir_base}$self->{_current_dir_level}/$node"; + my $filepathNew + = "$self->{_new_config_dir_base}$self->{_current_dir_level}/$node"; + + if ((-e $filepathAct) && !(-e $filepathNew)) { + return 1; + } + + return 0; +} + +## isAdded("node") +# will compare the new_config_dir to the active_dir to see if the "node" has +# been added. returns true or false. +sub isAdded { + my ($self, $node) = @_; + + #print "DEBUG Vyatta::Config->isAdded(): node $node\n"; + # let's setup the filepath for the modify dir + $node =~ s/\//%2F/g; + $node =~ s/\s+/\//g; + my $filepathNewConfig = "$self->{_new_config_dir_base}$self->{_current_dir_level}/$node"; + + #print "DEBUG Vyatta::Config->isAdded(): filepath $filepathNewConfig\n"; + + # if the node doesn't exist in the modify dir, it's not + # been added. so short circuit and return false. + if (! -e $filepathNewConfig) { return 0; } + + # now let's setup the path for the working dir + my $filepathActive = "$self->{_active_dir_base}$self->{_current_dir_level}/$node"; + + # if the node is in the active_dir it's not new + if (-e $filepathActive) { return 0; } + else { return 1; } +} + +## listNodeStatus("level") +# return a hash of the status of nodes at the current config level +# node name is the hash key. node status is the hash value. +# node status can be one of deleted, added, changed, or static +sub listNodeStatus { + my ($self, $path) = @_; + my @nodes = (); + my %nodehash = (); + + # find deleted nodes first + @nodes = $self->listDeleted("$path"); + foreach my $node (@nodes) { + if ($node =~ /.+/) { $nodehash{$node} = "deleted" }; + } + + @nodes = (); + @nodes = $self->listNodes("$path"); + foreach my $node (@nodes) { + if ($node =~ /.+/) { + #print "DEBUG Vyatta::Config->listNodeStatus(): node $node\n"; + # No deleted nodes -- added, changed, ot static only. + if ($self->isAdded("$path $node")) { $nodehash{$node} = "added"; } + elsif ($self->isChanged("$path $node")) { $nodehash{$node} = "changed"; } + else { $nodehash{$node} = "static"; } + } + } + + return %nodehash; +} + +############ DOM Tree ################ + +#Create active DOM Tree +sub createActiveDOMTree { + + my $self = shift; + + my $tree = new Vyatta::Config::DOMTree($self->{_active_dir_base} . $self->{_current_dir_level},"active"); + + return $tree; +} + +#Create changes only DOM Tree +sub createChangesOnlyDOMTree { + + my $self = shift; + + my $tree = new Vyatta::Config::DOMTree($self->{_changes_only_dir_base} . $self->{_current_dir_level}, + "changes_only"); + + return $tree; +} + +#Create new config DOM Tree +sub createNewConfigDOMTree { + + my $self = shift; + my $level = $self->{_new_config_dir_base} . $self->{_current_dir_level}; + + return new Vyatta::Config::DOMTree($level, "new_config"); +} + + +###### functions for templates ###### + +# $1: array representing the config node path. +# returns the filesystem path to the template of the specified node, +# or undef if the specified node path is not valid. +sub getTmplPath { + my $self = shift; + my @cfg_path = @{$_[0]}; + my $tpath = $self->{_vyatta_template_dir}; + for my $p (@cfg_path) { + if (-d "$tpath/$p") { + $tpath .= "/$p"; + next; + } + if (-d "$tpath/node.tag") { + $tpath .= "/node.tag"; + next; + } + # the path is not valid! + return undef; + } + return $tpath +} + +sub isTagNode { + my $self = shift; + my $cfg_path_ref = shift; + my $tpath = $self->getTmplPath($cfg_path_ref); + return undef if (!defined($tpath)); + if (-d "$tpath/node.tag") { + return 1; + } + return 0; +} + +sub hasTmplChildren { + my $self = shift; + my $cfg_path_ref = shift; + my $tpath = $self->getTmplPath($cfg_path_ref); + return undef if (!defined($tpath)); + opendir(TDIR, $tpath) or return 0; + my @tchildren = grep !/^node\.def$/, (grep !/^\./, (readdir TDIR)); + closedir TDIR; + if (scalar(@tchildren) > 0) { + return 1; + } + return 0; +} + +# $cfg_path_ref: ref to array containing the node path. +# returns ($is_multi, $is_text, $default), +# or undef if specified node is not valid. +sub parseTmpl { + my $self = shift; + my $cfg_path_ref = shift; + my ($is_multi, $is_text, $default) = (0, 0, undef); + my $tpath = $self->getTmplPath($cfg_path_ref); + return undef if (!defined($tpath)); + if (! -r "$tpath/node.def") { + return ($is_multi, $is_text); + } + open(TMPL, "<$tpath/node.def") or return ($is_multi, $is_text); + foreach () { + if (/^multi:/) { + $is_multi = 1; + } + if (/^type:\s+txt\s*$/) { + $is_text = 1; + } + if (/^default:\s+(\S+)\s*$/) { + $default = $1; + } + } + close TMPL; + return ($is_multi, $is_text, $default); +} + +###### misc functions ###### + +# compare two value lists and return "deleted" and "added" lists. +# since this is for multi-value nodes, there is no "changed" (if a value's +# ordering changed, it is deleted then added). +# $0: \@orig_values +# $1: \@new_values +sub compareValueLists { + my $self = shift; + my @ovals = @{$_[0]}; + my @nvals = @{$_[1]}; + my %comp_hash = ( + 'deleted' => [], + 'added' => [], + ); + my $idx = 0; + my %ohash = map { $_ => ($idx++) } @ovals; + $idx = 0; + my %nhash = map { $_ => ($idx++) } @nvals; + my $min_changed_idx = 2**31; + my %dhash = (); + foreach (@ovals) { + if (!defined($nhash{$_})) { + push @{$comp_hash{'deleted'}}, $_; + $dhash{$_} = 1; + if ($ohash{$_} < $min_changed_idx) { + $min_changed_idx = $ohash{$_}; + } + } + } + foreach (@nvals) { + if (defined($ohash{$_})) { + if ($ohash{$_} != $nhash{$_}) { + if ($ohash{$_} < $min_changed_idx) { + $min_changed_idx = $ohash{$_}; + } + } + } + } + foreach (@nvals) { + if (defined($ohash{$_})) { + if ($ohash{$_} != $nhash{$_}) { + if (!defined($dhash{$_})) { + push @{$comp_hash{'deleted'}}, $_; + $dhash{$_} = 1; + } + push @{$comp_hash{'added'}}, $_; + } elsif ($ohash{$_} >= $min_changed_idx) { + # ordering unchanged, but something before it is changed. + if (!defined($dhash{$_})) { + push @{$comp_hash{'deleted'}}, $_; + $dhash{$_} = 1; + } + push @{$comp_hash{'added'}}, $_; + } else { + # this is before any changed value. do nothing. + } + } else { + push @{$comp_hash{'added'}}, $_; + } + } + return %comp_hash; +} + +1; diff --git a/lib/Vyatta/ConfigDOMTree.pm b/lib/Vyatta/ConfigDOMTree.pm new file mode 100755 index 0000000..865f17b --- /dev/null +++ b/lib/Vyatta/ConfigDOMTree.pm @@ -0,0 +1,372 @@ +#!/usr/bin/perl + +# +# Module: vyatta-cfg +# +# **** License **** +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License version 2 as +# published by the Free Software Foundation. +# +# 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. +# +# A copy of the GNU General Public License is available as +# `/usr/share/common-licenses/GPL' in the Debian GNU/Linux distribution +# or on the World Wide Web at `http://www.gnu.org/copyleft/gpl.html'. +# You can also obtain it by writing to the Free Software Foundation, +# Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, +# MA 02110-1301, USA. +# +# This code was originally developed by Vyatta, Inc. +# Portions created by Vyatta are Copyright (C) 2005, 2006, 2007 Vyatta, Inc. +# All Rights Reserved. +# +# Author: Oleg Moskalenko +# Date: 2007 +# Description: +# +# **** End License **** +# +# + +package Vyatta::ConfigDOMTree; + +use strict; + +my %fields = ( + _dir => undef, + _name => undef, + _value => undef, + _subnodes => undef + ); + +sub new { + + my $that = shift; + my $dir = shift; + my $name = shift; + + my $class = ref ($that) || $that; + + my $self = { + %fields + }; + + bless $self, $class; + + $self->{_dir} = $dir; + $self->{_name} = $name; + + return $self->_construct_dom_tree(); +} + +#Simple DOM Tree iteration and screen output +#$1 - left screen offset (optional) +sub print { + + my $self = shift; + my $level = shift; + + my $tree = $self; + + if(!(defined $level)) { + $level=""; + } + + if(defined $tree) { + + print("$level name=",$tree->getNodeName(),"\n"); + + my $value = $tree->getNodeValue(); + + if(defined $value) { + + print("$level value=$value\n"); + + } + + my @subnodes = $tree->getSubNodes(); + + while(@subnodes) { + + my $subnode = shift @subnodes; + $subnode->print($level . " "); + } + } +} + +#Return value of the tree node +sub getNodeValue { + + my $self = shift; + my $tree = $self; + + my $ret = undef; + + if(defined $tree) { + + $ret = $tree->{_value}; + } + + return $ret; +} + +#Return value of the tree node. +#If the value is nor defined, return empty string. +sub getNodeValueAsString { + + my $self = shift; + my $tree = $self; + + my $ret = undef; + + if(defined $tree) { + + $ret = $tree->getNodeValue(); + } + + if(!defined $ret) { + $ret = ""; + } + + return $ret; +} + +#Return name of the tree node +sub getNodeName { + + my $self = shift; + my $tree = $self; + + my $ret = undef; + + if(defined $tree) { + + $ret = $tree->{_name}; + } + + return $ret; +} + +#Return array of subnodes of the tree node +sub getSubNodes { + + my $self = shift; + my $tree = $self; + + my @ret = (); + + if(defined $tree) { + + my $subnodes = $tree->{_subnodes}; + + if(defined $subnodes) { + + @ret = values %{$subnodes}; + + } + } + + return @ret; +} + +sub isLeafNode { + + my $self = shift; + my $tree = $self; + + my $ret=undef; + + if(defined $tree) { + + if(defined $tree->{_value}) { + + if(! defined $tree->{_subnodes}) { + + $ret="true"; + } + } + } + + return $ret; +} + +#Return subtree of the tree according to the path list +#$1, $2, ... - path to the subtree +sub getSubNode { + + my $self = shift; + my $tree = $self; + + my $ret = undef; + + while(@_ && $tree) { + + my $subnode = shift (@_); + + my $subnodes = $tree->{_subnodes}; + + if(defined $subnodes) { + + $tree = $subnodes->{$subnode}; + + } else { + + $tree = undef; + + } + } + + $ret=$tree; + + return $ret; +} + +#Return value of the subnode of the tree according to the path list +#$1, $2, ... - path to the subtree +sub getSubNodeValue { + + my $self = shift; + my $tree = $self; + + my $ret = undef; + + if(defined $tree) { + + my $node = $tree->getSubNode(@_); + + if(defined $node) { + + $ret=$node->getNodeValue(); + } + } + + return $ret; +} + +#Return value of the subnode of the tree according to the path list. +#If the value is not defined, return empty string. +#$1, $2, ... - path to the subtree +sub getSubNodeValueAsString { + + my $self = shift; + my $tree = $self; + + my $ret = undef; + + if(defined $tree) { + + my $node = $tree->getSubNode(@_); + + if(defined $node) { + + $ret=$node->getNodeValue(); + } + } + + if(! defined $ret) { + $ret = ""; + } + + return $ret; +} + +#Check if there is a subnode with the specified path. +#$1, $2, ... - path to the subtree +sub subNodeExist { + + my $self = shift; + my $tree = $self; + + my $ret = undef; + + if(defined $tree) { + + my $node = $tree->getSubNode(@_); + + if(defined $node) { + + $ret="true"; + } + } + + return $ret; +} + +#Return of the children of the node +#$1, $2, ... - path to the subtree +sub getSubNodesNumber { + + my $self = shift; + my $tree = $self; + + my $ret = 0; + + if(defined $tree) { + + my $node = $tree->getSubNode(@_); + + if(defined $node) { + + my @subs = $node->getSubNodes(); + + if(@subs) { + $ret = $#subs + 1; + } + } + } + + return $ret; +} + +#private method: costruct DOM Tree according to the absolute path provided +sub _construct_dom_tree { + + my $self = shift; + + my $subnodesNum=0; + my $valuePresent=0; + + if(!(defined $self)) {return undef;} + + opendir DIR, $self->{_dir} or return undef; + my @entries = grep !/^\./, readdir DIR; + closedir DIR; + + while(@entries) { + + my $entry = shift @entries; + + if($entry) { + my $fn = $self->{_dir} . "/" . $entry; + if( -f $fn) { + if($entry eq "node.val") { + my $value=`cat $fn`; + while(chomp $value) {}; + $self->{_value} = $value; + $valuePresent++; + } + } elsif (-d $fn) { + my $subnode = new Vyatta::ConfigDOMTree($fn,$entry); + if(defined $subnode) { + if(! defined $self->{_subnodes} ) { + $self->{_subnodes} = {}; + } + $self->{_subnodes}->{$entry} = $subnode; + $subnodesNum++; + } + } + } + } + + if($valuePresent<1 && $subnodesNum<1) { + return undef; + } + + return $self; +} + +1; diff --git a/lib/Vyatta/ConfigLoad.pm b/lib/Vyatta/ConfigLoad.pm new file mode 100755 index 0000000..f7c0154 --- /dev/null +++ b/lib/Vyatta/ConfigLoad.pm @@ -0,0 +1,424 @@ +#!/usr/bin/perl + +# Author: An-Cheng Huang +# Date: 2007 +# Description: Perl module for loading configuration. + +# **** License **** +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License version 2 as +# published by the Free Software Foundation. +# +# 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. +# +# This code was originally developed by Vyatta, Inc. +# Portions created by Vyatta are Copyright (C) 2006, 2007, 2008 Vyatta, Inc. +# All Rights Reserved. + +package Vyatta::ConfigLoad; + +our @EXPORT = qw(getStartupConfigStatements loadConfigHierarchy getConfigDiff); +use base qw(Exporter); + +use strict; +use sort 'stable'; +use lib "/opt/vyatta/share/perl5"; +use XorpConfigParser; +use Vyatta::Config; + +# configuration ordering. higher rank configured before lower rank. +my $default_rank = 0; +my %config_rank = ( + 'qos-policy' => 1100, + 'firewall' => 1020, + 'service nat' => 1010, + 'system host-name' => 1005, + 'interfaces' => 1000, + 'interfaces bridge' => 990, + 'interfaces bonding' => 995, + 'interfaces ethernet' => 980, + 'interfaces tunnel' => 910, + 'system gateway-address' => 890, + 'system name-server' => 880, + 'system login user' => 870, + 'system' => 860, + 'protocols static' => 850, + 'service ssh' => 840, + 'service telnet' => 830, + 'policy' => 820, + 'protocols bgp' => 790, + 'protocols ospf parameters' => 785, + 'protocols ospf' => 780, + 'protocols rip' => 770, + 'vpn' => 600, + +); + +my %regex_rank = ( + 'interfaces ethernet \S* vrrp' => 500, + 'interfaces ethernet \S* vif \S* vrrp' => 500, + 'interfaces ethernet \S* pppo[ea]' => 400, + 'protocols bgp \d+ parameters' => 810, + 'protocols bgp \d+ neighbor \d+\.\d+\.\d+\.\d+' => 800, + 'protocols bgp \d+ neighbor \w+' => 801, +); + +my @all_nodes = (); +my @all_naked_nodes = (); + +sub match_regex { + my ($pattern, $str) = @_; + $pattern =~ s/^(.*)$/\^$1\$/; + return ($str =~ m/$pattern/) ? 1 : 0; +} + +sub get_regex_rank { + my ($str) = @_; + foreach (keys %regex_rank) { + if (match_regex($_, $str)) { + return $regex_rank{$_}; + } + } + return undef; +} + +sub get_config_rank { + # longest prefix match + my @path = @_; + while ((scalar @path) > 0) { + my $path_str = join ' ', @path; + if (defined($config_rank{$path_str})) { + return ($config_rank{$path_str}); + } + my $wrank = get_regex_rank($path_str); + return $wrank if (defined($wrank)); + pop @path; + } + return $default_rank; +} + +sub applySingleQuote { + my @return = (); + foreach (@_) { + # change all single quotes to "'\''" since we're going to single-quote + # every component of the command + if (/^'(.*)'$/) { + $_ = $1; + } + $_ =~ s/'/'\\''/g; + # single-quote every component of the command + if (/^'.*'$/) { + push @return, $_; + } elsif (/^"(.*)"$/) { + push @return, "'$1'"; + } else { + push @return, "'$_'"; + } + } + return @return; +} + +sub enumerate_branch { + my $cur_node = shift; + my @cur_path = @_; + # name not defined at root level + if (defined($cur_node->{'name'})) { + my $name = $cur_node->{'name'}; + if ($name =~ /^\s*(\S+)\s+(\S.*)$/) { + push @cur_path, ($1, $2); + } else { + push @cur_path, $name; + } + } + my $terminal = 0; + if (!defined($cur_node->{'children'})) { + $terminal = 1; + } else { + foreach (@{$cur_node->{'children'}}) { + if (defined($_->{'name'})) { + enumerate_branch($_, @cur_path); + $terminal = 0; + } + } + } + if ($terminal) { + my $val = $cur_node->{'value'}; + if (defined($val)) { + push @cur_path, $val; + } + push @all_naked_nodes, [ @cur_path ]; + my @qpath = applySingleQuote(@cur_path); + push @all_nodes, [\@qpath, get_config_rank(@cur_path)]; + } +} + +# $0: config file to load +# return: list of all config statement sorted by rank +sub getStartupConfigStatements { + # clean up the lists first + @all_nodes = (); + @all_naked_nodes = (); + + my $load_cfg = shift; + if (!defined($load_cfg)) { + return (); + } + + my $xcp = new XorpConfigParser(); + $xcp->parse($load_cfg); + my $root = $xcp->get_node( () ); + if (!defined($root)) { + return (); + } + enumerate_branch($root, ( )); + + @all_nodes = sort { ${$b}[1] <=> ${$a}[1] } @all_nodes; + return @all_nodes; +} + +my %node_order = (); + +# $0: ref of list of parsed naked statements. +# return: hash containing the config hierarchy. +sub generateHierarchy { + my @node_list = @{$_[0]}; + my %hash = (); + %node_order = (); + my $order = 0; + foreach my $node (@node_list) { + my @path = @{$node}; + my $path_str = join ' ', @path; + $node_order{$path_str} = $order; + $order++; + my $cur_ref = \%hash; + foreach (@path) { + if (!defined($cur_ref->{$_})) { + $cur_ref->{$_} = { }; + } + $cur_ref = $cur_ref->{$_}; + } + } + return %hash; +} + +# $0: config file to load. +# return: hash containing the config hierarchy. +sub loadConfigHierarchy { + # clean up the lists first + @all_nodes = (); + @all_naked_nodes = (); + + my $load_cfg = shift; + if (!defined($load_cfg)) { + return (); + } + + my $xcp = new XorpConfigParser(); + $xcp->parse($load_cfg); + my $root = $xcp->get_node( () ); + if (!defined($root)) { + return (); + } + enumerate_branch($root, ( )); + + return generateHierarchy(\@all_naked_nodes); +} + +# $0: ref of hierarchy root. +# $1: display prefix. +sub printHierarchy { + my $cur_ref = shift; + my $prefix = shift; + foreach (sort keys %{$cur_ref}) { + print "$prefix$_"; + if (scalar(keys %{$cur_ref->{$_}}) == 0) { + print " (terminal)\n"; + next; + } else { + print "\n"; + } + printHierarchy($cur_ref->{$_}, "$prefix "); + } +} + +# $0: hash ref representing a "multi:" node. +# $1: array ref representing current config path. +# returns the list of node values sorted by the original order. +sub getSortedMultiValues { + my $nref = $_[0]; + my @npath = @{$_[1]}; + my $path_str = join ' ', @npath; + my @list = (); + foreach (keys %{$nref}) { + my $key = "$path_str $_"; + push @list, [ $_, $node_order{$key} ]; + } + my @slist = sort { ${$a}[1] <=> ${$b}[1] } @list; + @slist = map { ${$_}[0] } @slist; + return @slist; +} + +my $active_cfg = undef; +my $new_cfg_ref = undef; + +my @delete_list = (); + +# find specified node's values in active config that have been deleted from +# new config. +# $0: hash ref at the current hierarchy level (new config) +# $1: array ref representing current config path (active config) +sub findDeletedValues { + my $new_ref = $_[0]; + my @active_path = @{$_[1]}; + my ($is_multi, $is_text) = $active_cfg->parseTmpl(\@active_path); + $active_cfg->setLevel(join ' ', @active_path); + if ($is_multi) { + # for "multi:" nodes, need to sort the values by the original order. + my @nvals = getSortedMultiValues($new_ref, \@active_path); + if ($is_text) { + @nvals = map { /^"(.*)"$/ ? $1 : $_ }@nvals; + } + my @ovals = $active_cfg->returnOrigValues(''); + my %comp_hash = $active_cfg->compareValueLists(\@ovals, \@nvals); + foreach (@{$comp_hash{'deleted'}}) { + my @plist = applySingleQuote(@active_path, $_); + push @delete_list, [\@plist, get_config_rank(@active_path, $_)]; + } + } else { + # do nothing. if a single-value leaf node is deleted, it should have + # been detected at the previous level. since we are already at node.val, + # it can only be "added" or "changed", handled later. + } +} + +# find nodes in active config that have been deleted from new config. +# $0: hash ref at the current hierarchy level (new config) +# $1: array ref representing current config path (active config) +sub findDeletedNodes { + my $new_ref = $_[0]; + my @active_path = @{$_[1]}; + $active_cfg->setLevel(join ' ', @active_path); + my @active_nodes = $active_cfg->listOrigNodes(); + foreach (@active_nodes) { + if ($_ eq 'def') { + next; + } + if ($_ eq 'node.val') { + findDeletedValues($new_ref, \@active_path); + next; + } + if (!defined($new_ref->{$_})) { + my @plist = applySingleQuote(@active_path, $_); + push @delete_list, [\@plist, get_config_rank(@active_path, $_)]; + } else { + findDeletedNodes($new_ref->{$_}, [ @active_path, $_ ]); + } + } +} + +my @set_list = (); + +# find specified node's values in active config that are set +# (added or changed). +# $0: hash ref at the current hierarchy level (new config) +# $1: array ref representing current config path (active config) +sub findSetValues { + my $new_ref = $_[0]; + my @active_path = @{$_[1]}; + my ($is_multi, $is_text) = $active_cfg->parseTmpl(\@active_path); + $active_cfg->setLevel(join ' ', @active_path); + if ($is_multi) { + # for "multi:" nodes, need to sort the values by the original order. + my @nvals = getSortedMultiValues($new_ref, \@active_path); + if ($is_text) { + @nvals = map { /^"(.*)"$/ ? $1 : $_ } @nvals; + } + my @ovals = $active_cfg->returnOrigValues(''); + my %comp_hash = $active_cfg->compareValueLists(\@ovals, \@nvals); + foreach (@{$comp_hash{'added'}}) { + my @plist = applySingleQuote(@active_path, $_); + push @set_list, [\@plist, get_config_rank(@active_path, $_)]; + } + } else { + my @nvals = keys %{$new_ref}; + my $nval = $nvals[0]; + if ($is_text) { + $nval =~ s/^"(.*)"$/$1/; + } + my $oval = $active_cfg->returnOrigValue(''); + if (!defined($oval) || ($nval ne $oval)) { + my @plist = applySingleQuote(@active_path, $nval); + push @set_list, [\@plist, get_config_rank(@active_path, $nval)]; + } + } +} + +# find nodes in new config that are set (added or changed). +# $0: hash ref at the current hierarchy level (new config) +# $1: array ref representing current config path (active config) +sub findSetNodes { + my $new_ref = $_[0]; + my @active_path = @{$_[1]}; + $active_cfg->setLevel(join ' ', @active_path); + my @active_nodes = $active_cfg->listOrigNodes(); + my %active_hash = map { $_ => 1 } @active_nodes; + if (defined($active_hash{'node.val'})) { + # we are at a leaf node. + findSetValues($new_ref, \@active_path); + return; + } + foreach (sort keys %{$new_ref}) { + if (scalar(keys %{$new_ref->{$_}}) == 0) { + # we are at a non-value leaf node. + # check if we need to add this node. + if (!defined($active_hash{$_})) { + my @plist = applySingleQuote(@active_path, $_); + push @set_list, [\@plist, get_config_rank(@active_path, $_)]; + } else { + # node already present. do nothing. + } + next; + } + # we recur regardless of whether it's in active. all changes will be + # handled when we reach leaf nodes (above). + findSetNodes($new_ref->{$_}, [ @active_path, $_ ]); + } +} + +# compare the current active config with the specified hierarchy and return +# the "diff". +# $0: hash ref of config hierarchy. +# return: hash containing the diff. +sub getConfigDiff { + $active_cfg = new Vyatta::Config; + $new_cfg_ref = shift; + @set_list = (); + @delete_list = (); + findDeletedNodes($new_cfg_ref, [ ]); + findSetNodes($new_cfg_ref, [ ]); + # don't really need to sort the lists by rank since we have to commit + # everything together anyway. + @delete_list = sort { ${$a}[1] <=> ${$b}[1] } @delete_list; + @set_list = sort { ${$b}[1] <=> ${$a}[1] } @set_list; + + # need to filter out deletions of nodes with default values + my @new_delete_list = (); + foreach my $del (@delete_list) { + my @comps = map { s/^'(.*)'$/$1/; $_; } @{${$del}[0]}; + my ($is_multi, $is_text, $default) = $active_cfg->parseTmpl(\@comps); + if (!defined($default)) { + push @new_delete_list, $del; + } + } + + my %diff = ( + 'delete' => \@new_delete_list, + 'set' => \@set_list, + ); + return %diff; +} + +1; diff --git a/lib/Vyatta/ConfigOutput.pm b/lib/Vyatta/ConfigOutput.pm new file mode 100755 index 0000000..c45dff9 --- /dev/null +++ b/lib/Vyatta/ConfigOutput.pm @@ -0,0 +1,374 @@ +#!/usr/bin/perl + +# Author: An-Cheng Huang +# Date: 2007 +# Description: Perl module for generating output of the configuration. + +# **** License **** +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License version 2 as +# published by the Free Software Foundation. +# +# 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. +# +# This code was originally developed by Vyatta, Inc. +# Portions created by Vyatta are Copyright (C) 2006, 2007, 2008 Vyatta, Inc. +# All Rights Reserved. +# **** End License **** + + +# outputNewConfig() +# prints the "new" config, i.e., the active config with any un-committed +# changes. 'diff' notation is also generated to indicate the changes. +# +# outputActiveConfig() +# prints the "active" config. suitable for "saving", for example. + +package Vyatta::ConfigOutput; +our @EXPORT = qw(setshow_all set_hide_password outputActiveConfig outputNewConfig); +use base qw(Exporter); + +use strict; +use lib '/opt/vyatta/share/perl5'; +use Vyatta::Config; + +use Sort::Versions; + +# whether to show default values +my $show_all = 0; +sub set_show_all { + if (shift) { + $show_all = 1; + } +} + +my $hide_password = 0; +sub set_hide_password { + if (shift) { + $hide_password = 1; + } +} + +sub txt_need_quotes { + $_ = shift; + return 1 if (/^$/ || /[\s\*}{;]/); + return 0; +} + +my $config = undef; + +# $0: array ref for path +# $1: display prefix +# $2: node name +# $3: simple show (if defined, don't show diff prefix. used for "don't show as +# deleted" from displayDeletedOrigChildren.) +sub displayValues { + my @cur_path = @{$_[0]}; + my $prefix = $_[1]; + my $name = $_[2]; + my $simple_show = $_[3]; + my ($is_multi, $is_text, $default) = $config->parseTmpl(\@cur_path); + if ($is_text) { + $default =~ /^"(.*)"$/; + my $txt = $1; + if (!txt_need_quotes($txt)) { + $default = $txt; + } + } + my $is_password = ($name =~ /^.*(password|pre-shared-secret)$/); + my $HIDE_PASSWORD = '****************'; + $config->setLevel(join ' ', @cur_path); + if ($is_multi) { + my @ovals = $config->returnOrigValues(''); + my @nvals = $config->returnValues(''); + if ($is_text) { + @ovals = map { (txt_need_quotes($_)) ? "\"$_\"" : "$_"; } @ovals; + @nvals = map { (txt_need_quotes($_)) ? "\"$_\"" : "$_"; } @nvals; + } + my $idx = 0; + my %ohash = map { $_ => ($idx++) } @ovals; + $idx = 0; + my %nhash = map { $_ => ($idx++) } @nvals; + my @dlist = map { if (!defined($nhash{$_})) { $_; } else { undef; } } + @ovals; + if (defined($simple_show)) { + foreach my $oval (@ovals) { + if ($is_password && $hide_password) { + $oval = $HIDE_PASSWORD; + } + print "$prefix$name $oval\n"; + } + return; + } + foreach my $del (@dlist) { + if (defined($del)) { + if ($is_password && $hide_password) { + $del = $HIDE_PASSWORD; + } + print "-$prefix$name $del\n"; + } + } + foreach my $nval (@nvals) { + my $diff = '+'; + if (defined($ohash{$nval})) { + if ($ohash{$nval} != $nhash{$nval}) { + $diff = '>'; + } else { + $diff = ' '; + } + } + if ($is_password && $hide_password) { + $nval = $HIDE_PASSWORD; + } + print "$diff$prefix$name $nval\n"; + } + } else { + my $oval = $config->returnOrigValue(''); + my $nval = $config->returnValue(''); + if ($is_text) { + if (defined($oval) && txt_need_quotes($oval)) { + $oval = "\"$oval\""; + } + if (defined($nval) && txt_need_quotes($nval)) { + $nval = "\"$nval\""; + } + } + + my %cnodes = $config->listNodeStatus(); + my @cnames = sort keys %cnodes; + + if (defined($simple_show)) { + if (!$cnodes{'def'} || $show_all) { + if ($is_password && $hide_password) { + $oval = $HIDE_PASSWORD; + } + print "$prefix$name $oval\n"; + } + return; + } + my $value = $nval; + my $diff = ' '; + if (!defined($oval) && defined($nval)) { + $diff = '+'; + } elsif (!defined($nval) && defined($oval)) { + $diff = '-'; + $value = $oval; + } else { + # both must be defined + if ($oval ne $nval) { + $diff = '>'; + } + } + if (!$cnodes{'def'} || $show_all) { + if ($is_password && $hide_password) { + $value = $HIDE_PASSWORD; + } + print "$diff$prefix$name $value\n"; + } + } +} + +# $0: array ref for path +# $1: display prefix +# $2: don't show as deleted? (if defined, config is shown as normal instead of +# deleted.) +sub displayDeletedOrigChildren { + my @cur_path = @{$_[0]}; + my $prefix = $_[1]; + my $dont_show_as_deleted = $_[2]; + my $dprefix = '-'; + if (defined($dont_show_as_deleted)) { + $dprefix = ''; + } + $config->setLevel(''); + my @children = $config->listOrigNodes(join ' ', @cur_path); + for my $child (sort @children) { + if ($child eq 'node.val') { + # should not happen! + next; + } + my $is_tag = $config->isTagNode([ @cur_path, $child ]); + $config->setLevel(join ' ', (@cur_path, $child)); + my @cnames = sort $config->listOrigNodesNoDef(); + + if ($cnames[0] eq 'node.val') { + displayValues([ @cur_path, $child ], $prefix, $child, + $dont_show_as_deleted); + } elsif ($cnames[0] eq 'def') { + #ignore + } elsif (scalar($#cnames) >= 0) { + if ($is_tag) { + @cnames = sort versioncmp @cnames; + foreach my $cname (@cnames) { + if ($cname eq 'node.val') { + # should not happen + next; + } + print "$dprefix$prefix$child $cname {\n"; + displayDeletedOrigChildren([ @cur_path, $child, $cname ], + "$prefix ", $dont_show_as_deleted); + print "$dprefix$prefix}\n"; + } + } else { + print "$dprefix$prefix$child {\n"; + displayDeletedOrigChildren([ @cur_path, $child ], "$prefix ", + $dont_show_as_deleted); + print "$dprefix$prefix}\n"; + } + } else { + my $has_tmpl_children = $config->hasTmplChildren([ @cur_path, $child ]); + print "$dprefix$prefix$child" + . ($has_tmpl_children ? " {\n$dprefix$prefix}\n" : "\n"); + } + } +} + +# $0: hash ref for children status +# $1: array ref for path +# $2: display prefix +sub displayChildren { + my %child_hash = %{$_[0]}; + my @cur_path = @{$_[1]}; + my $prefix = $_[2]; + for my $child (sort (keys %child_hash)) { + if ($child eq 'node.val') { + # should not happen! + next; + } + my ($diff, $vdiff) = (' ', ' '); + if ($child_hash{$child} eq 'added') { + $diff = '+'; + $vdiff = '+'; + } elsif ($child_hash{$child} eq 'deleted') { + $diff = '-'; + $vdiff = '-'; + } elsif ($child_hash{$child} eq 'changed') { + $vdiff = '>'; + } + my $is_tag = $config->isTagNode([ @cur_path, $child ]); + $config->setLevel(join ' ', (@cur_path, $child)); + my %cnodes = $config->listNodeStatus(); + my @cnames = sort keys %cnodes; + + #if node.val exists and ct == 0 w/o def or ct ==1 w/ def + my $leaf = 0; + if ($cnodes{'def'}) { + if ($#cnames == 1 && $cnodes{'node.val'}) { + $leaf = 1; + } + } else { + if ($#cnames == 0 && $cnodes{'node.val'}) { + $leaf = 1; + } + } + + if ($leaf == 1) { + displayValues([ @cur_path, $child ], $prefix, $child); + } elsif (scalar($#cnames) >= 0) { + if ($is_tag) { + @cnames = sort versioncmp @cnames; + foreach my $cname (@cnames) { + if ($cname eq 'node.val') { + # should not happen + next; + } + my $tdiff = ' '; + if ($cnodes{$cname} eq 'deleted') { + $tdiff = '-'; + } elsif ($cnodes{$cname} eq 'added') { + $tdiff = '+'; + } + print "$tdiff$prefix$child $cname {\n"; + if ($cnodes{$cname} eq 'deleted') { + displayDeletedOrigChildren([ @cur_path, $child, $cname ], + "$prefix "); + } else { + $config->setLevel(join ' ', (@cur_path, $child, $cname)); + my %ccnodes = $config->listNodeStatus(); + displayChildren(\%ccnodes, [ @cur_path, $child, $cname ], + "$prefix "); + } + print "$tdiff$prefix}\n"; + } + } else { + print "$diff$prefix$child {\n"; + if ($child_hash{$child} eq 'deleted') { + # this should not happen + displayDeletedOrigChildren([ @cur_path, $child ], "$prefix "); + } else { + displayChildren(\%cnodes, [ @cur_path, $child ], "$prefix "); + } + print "$diff$prefix}\n"; + } + } else { + if ($child_hash{$child} eq 'deleted') { + $config->setLevel(''); + my @onodes = $config->listOrigNodes(join ' ', (@cur_path, $child)); + if ($#onodes == 0 && $onodes[0] eq 'node.val') { + displayValues([ @cur_path, $child ], $prefix, $child); + } else { + print "$diff$prefix$child {\n"; + displayDeletedOrigChildren([ @cur_path, $child ], "$prefix "); + print "$diff$prefix}\n"; + } + } else { + my $has_tmpl_children + = $config->hasTmplChildren([ @cur_path, $child ]); + print "$diff$prefix$child" + . ($has_tmpl_children ? " {\n$diff$prefix}\n" : "\n"); + } + } + } +} + +# @ARGV: represents the 'root' path. the output starts at this point under +# the new config. +sub outputNewConfig { + $config = new Vyatta::Config; + $config->setLevel(join ' ', @_); + my %rnodes = $config->listNodeStatus(); + if (scalar(keys %rnodes) > 0) { + my @rn = keys %rnodes; + + #if node.val exists and ct == 0 w/o def or ct ==1 w/ def + my $leaf = 0; + if ($rnodes{'def'}) { + if ($#rn == 1 && $rnodes{'node.val'}) { + $leaf = 1; + } + } else { + if ($#rn == 0 && $rnodes{'node.val'}) { + $leaf = 1; + } + } + + if ($leaf == 1) { + # this is a leaf value-node + displayValues([ @_ ], '', $_[$#_]); + } else { + displayChildren(\%rnodes, [ @_ ], ''); + } + } else { + if (defined($config->existsOrig()) && !defined($config->exists())) { + # this is a deleted node + print 'Configuration under "' . (join ' ', @_) . "\" has been deleted\n"; + } elsif (!defined($config->getTmplPath(\@_))) { + print "Specified configuration path is not valid\n"; + } else { + print 'Configuration under "' . (join ' ', @_) . "\" is empty\n"; + } + } +} + +# @ARGV: represents the 'root' path. the output starts at this point under +# the active config. +sub outputActiveConfig { + $config = new Vyatta::Config; + $config->setLevel(join ' ', @_); + displayDeletedOrigChildren([ @_ ], '', 1); +} + +1; diff --git a/lib/Vyatta/Misc.pm b/lib/Vyatta/Misc.pm new file mode 100755 index 0000000..463f5d1 --- /dev/null +++ b/lib/Vyatta/Misc.pm @@ -0,0 +1,486 @@ +#!/usr/bin/perl + +# Module: VyattaMisc.pm +# +# Author: Marat +# Date: 2007 +# Description: Implements miscellaneous commands + +# **** License **** +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License version 2 as +# published by the Free Software Foundation. +# +# 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. +# +# This code was originally developed by Vyatta, Inc. +# Portions created by Vyatta are Copyright (C) 2006, 2007, 2008 Vyatta, Inc. +# All Rights Reserved. +# **** End License **** + +package Vyatta::Misc; +require Exporter; +@ISA = qw(Exporter); +@EXPORT = qw(getNetAddIP isIpAddress is_ip_v4_or_v6); +@EXPORT_OK = qw(getNetAddIP isIpAddress is_ip_v4_or_v6); + + +use strict; + +use Vyatta::Config; + +sub get_sysfs_value { + my ($intf, $name) = @_; + + open (my $statf, '<', "/sys/class/net/$intf/$name") + or die "Can't open statistics file /sys/class/net/$intf/$name"; + + my $value = <$statf>; + chomp $value if defined $value; + close $statf; + return $value; +} + +# check if interace is configured to get an IP address using dhcp +sub is_dhcp_enabled { + my ($intf, $outside_cli) = @_; + + my $config = new Vyatta::Config; + if (!($outside_cli eq '')) { + $config->{_active_dir_base} = "/opt/vyatta/config/active/"; + } + + if ($intf =~ m/^eth/) { + if ($intf =~ m/(\w+)\.(\d+)/) { + $config->setLevel("interfaces ethernet $1 vif $2"); + } else { + $config->setLevel("interfaces ethernet $intf"); + } + } elsif ($intf =~ m/^br/) { + $config->setLevel("interfaces bridge $intf"); + } elsif ($intf =~ m/^bond/) { + if ($intf =~ m/(\w+)\.(\d+)/) { + $config->setLevel("interfaces bonding $1 vif $2"); + } else { + $config->setLevel("interfaces bonding $intf"); + } + } else { + # + # add other interfaces that can be configured to use dhcp above + # + return 0; + } + my @addrs = $config->returnOrigValues("address"); + foreach my $addr (@addrs) { + if (defined $addr && $addr eq "dhcp") { + return 1; + } + } + return 0; +} + +# return dhclient related files for interface +sub generate_dhclient_intf_files { + my $intf = shift; + my $dhclient_dir = '/var/lib/dhcp3/'; + + $intf =~ s/\./_/g; + my $intf_config_file = $dhclient_dir . 'dhclient_' . $intf . '.conf'; + my $intf_process_id_file = $dhclient_dir . 'dhclient_' . $intf . '.pid'; + my $intf_leases_file = $dhclient_dir . 'dhclient_' . $intf . '.leases'; + return ($intf_config_file, $intf_process_id_file, $intf_leases_file); + +} + +# getInterfacesIPadresses() returns IP addresses for the interface type passed to it +# possible type of interfaces : 'broadcast', 'pointopoint', 'multicast', 'all' +# the loopback IP address is never returned with any of the above parameters +sub getInterfacesIPadresses { + + my $interface_type = shift; + if (!($interface_type =~ m/broadcast|pointopoint|multicast|all/)) { + print STDERR "Invalid interface type specified to retrive IP addresses for\n"; + return undef; + } + my @interfaces_on_system = `ifconfig -a | awk '\$2 ~ /Link/ {print \$1}'`; + chomp @interfaces_on_system; + my @intf_ips = (); + my $intf_ips_index = 0; + foreach my $intf_system (@interfaces_on_system) { + if (!($intf_system eq 'lo')) { + my $is_intf_interface_type = 0; + if (!($interface_type eq 'all')) { + $is_intf_interface_type = + `ip link show $intf_system 2>/dev/null | grep -i $interface_type | wc -l`; + } else { + $is_intf_interface_type = 1; + } + if ($is_intf_interface_type > 0) { + $intf_ips[$intf_ips_index] = + `ip addr show $intf_system 2>/dev/null | grep inet | grep -v inet6 | awk '{print \$2}'`; + if (!($intf_ips[$intf_ips_index] eq '')){ + $intf_ips_index++; + } + } + } + } + chomp @intf_ips; + return (@intf_ips); + +} + + +sub getNetAddrIP { + my ($interface); + ($interface) = @_; + + if ($interface eq '') { + print STDERR "Error: No interface specified.\n"; + return undef; + } + + my $ifconfig_out = `ifconfig $interface`; + $ifconfig_out =~ /inet addr:(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/; + my $ip = $1; + if ($ip eq '') { + print STDERR "Error: Unable to determine IP address for interface \'$interface\'.\n"; + return undef; + } + + $ifconfig_out =~ /Mask:(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/; + my $netmask = $1; + if ($netmask eq '') { + print STDERR "Error: Unable to determine netmask for interface \'$interface\'.\n"; + return undef; + } + + use NetAddr::IP; # This library is available via libnetaddr-ip-perl.deb + my $naip = new NetAddr::IP($ip, $netmask); + return $naip; +} + +sub is_ip_v4_or_v6 { + my $addr = shift; + + my $ip = NetAddr::IP->new($addr); + if (defined $ip && $ip->version() == 4) { + # + # the call to IP->new() will accept 1.1 and consider + # it to be 1.1.0.0, so add a check to force all + # 4 octets to be defined + # + if ($addr !~ /\d+\.\d+\.\d+\.\d+/) { + return undef; + } + return 4; + } + $ip = NetAddr::IP->new6($addr); + if (defined $ip && $ip->version() == 6) { + return 6; + } + + return undef; +} + +sub isIpAddress { + my $ip = shift; + + $_ = $ip; + if ( ! /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) { + return 0; + } + else { + my @ips = split /\./, $ip; + my $octet = 0; + my $counter = 0; + + foreach $octet (@ips) { + if (($octet < 0) || ($octet > 255)) { return 0; } + if (($counter == 0) && ($octet < 1)) { return 0; } + $counter++; + } + } + + return 1; +} + +sub isClusterIP { + my ($vc, $ip) = @_; + + if (!(defined($ip))) { + return 0; + } + + my @cluster_groups = $vc->listNodes('cluster group'); + foreach my $cluster_group (@cluster_groups) { + my @services = $vc->returnValues("cluster group $cluster_group service"); + foreach my $service (@services) { + if ($ip eq $service) { + return 1; + } + } + } + + return 0; +} + +sub remove_ip_prefix { + my @addr_nets = @_; + + s/\/\d+$// for @addr_nets; + return @addr_nets; +} + +sub is_ip_in_list { + my ($ip, @list) = @_; + + if (!defined($ip) || scalar(@list) == 0) { + return 0; + } + + @list = remove_ip_prefix(@list); + my %list_hash = map { $_ => 1 } @list; + if (defined($list_hash{$ip})) { + return 1; + } else { + return 0; + } +} + +sub get_eth_ip_addrs { + my ($vc, $eth_path) = @_; + + my @addrs = (); + my @virt_addrs = (); + + $vc->setLevel("interfaces ethernet $eth_path"); + @addrs = $vc->returnValues("address"); + + # + # check for VIPs + # + $vc->setLevel("interfaces ethernet $eth_path vrrp vrrp-group"); + my @vrrp_groups = $vc->listNodes(); + foreach my $group (@vrrp_groups) { + $vc->setLevel("interfaces ethernet $eth_path vrrp vrrp-group $group"); + @virt_addrs = $vc->returnValues("virtual-address"); + } + return (@addrs, @virt_addrs); +} + +sub get_tun_ip_addrs { + my ($vc, $tun_path) = @_; + + my @addrs = (); + my @virt_addrs = (); + + $vc->setLevel("interfaces tunnel $tun_path"); + @addrs = $vc->returnValues("address"); + + # + # check for VIPs + # + $vc->setLevel("interfaces tunnel $tun_path vrrp vrrp-group"); + my @vrrp_groups = $vc->listNodes(); + foreach my $group (@vrrp_groups) { + $vc->setLevel("interfaces tunnel $tun_path vrrp vrrp-group $group"); + @virt_addrs = $vc->returnValues("virtual-address"); + } + return (@addrs, @virt_addrs); +} + +sub get_serial_ip_addrs { + # + # Todo when serial is added + # +} + +sub isIPinInterfaces { + my ($vc, $ip_addr, @interfaces) = @_; + + if (!(defined($ip_addr))) { + return 0; + } + + foreach my $intf (@interfaces) { + # regular ethernet + if ($intf =~ m/^eth\d+$/) { + my @addresses = get_eth_ip_addrs($vc, $intf); + if (is_ip_in_list($ip_addr, @addresses)) { + return 1; + } + } + # ethernet vlan + if ($intf =~ m/^eth(\d+).(\d+)$/) { + my $eth = "eth$1"; + my $vif = $2; + my @addresses = get_eth_ip_addrs($vc, "$eth vif $vif"); + if (is_ip_in_list($ip_addr, @addresses)) { + return 1; + } + } + # tunnel + if ($intf =~ m/^tun\d+$/) { + my @addresses = get_tun_ip_addrs($vc, $intf); + if (is_ip_in_list($ip_addr, @addresses)) { + return 1; + } + } + # serial + if ($intf =~ m/^wan(\d+).(\d+)$/) { + my @addresses = get_serial_ip_addrs($vc, $intf); + if (is_ip_in_list($ip_addr, @addresses)) { + return 1; + } + } + } + + return 0; +} + +sub isClusteringEnabled { + my ($vc) = @_; + + if ($vc->exists('cluster')) { + return 1; + } else { + return 0; + } +} + +# $str: string representing a port number +# returns ($success, $err) +# $success: 1 if success. otherwise undef +# $err: error message if failure. otherwise undef +sub isValidPortNumber { + my $str = shift; + return (undef, "\"$str\" is not a valid port number") + if (!($str =~ /^\d+$/)); + return (undef, "invalid port \"$str\" (must be between 1 and 65535)") + if ($str < 1 || $str > 65535); + return (1, undef); +} + +# $str: string representing a port range +# $sep: separator for range +# returns ($success, $err) +# $success: 1 if success. otherwise undef +# $err: error message if failure. otherwise undef +sub isValidPortRange { + my $str = shift; + my $sep = shift; + return (undef, "\"$str\" is not a valid port range") + if (!($str =~ /^(\d+)$sep(\d+)$/)); + my ($start, $end) = ($1, $2); + my ($success, $err) = isValidPortNumber($start); + return (undef, $err) if (!defined($success)); + ($success, $err) = isValidPortNumber($end); + return (undef, $err) if (!defined($success)); + return (undef, "invalid port range ($end is not greater than $start)") + if ($end <= $start); + return (1, undef); +} + +my %port_name_hash_tcp = (); +my %port_name_hash_udp = (); +sub buildPortNameHash { + open(IF, ") { + s/#.*$//; + my $is_tcp = /\d\/tcp\s/; + my @names = grep (!/\//, (split /\s/)); + foreach my $name (@names) { + if ($is_tcp) { + $port_name_hash_tcp{$name} = 1; + } else { + $port_name_hash_udp{$name} = 1; + } + } + } + close IF; + return 1; +} + +# $str: string representing a port name +# $proto: protocol to check +# returns ($success, $err) +# $success: 1 if success. otherwise undef +# $err: error message if failure. otherwise undef +sub isValidPortName { + my $str = shift; + my $proto = shift; + return (undef, "\"\" is not a valid port name for protocol \"$proto\"") + if ($str eq ''); + buildPortNameHash() if ((keys %port_name_hash_tcp) == 0); + return (1, undef) if ($proto eq 'tcp' && defined($port_name_hash_tcp{$str})); + return (1, undef) if ($proto eq '6' && defined($port_name_hash_tcp{$str})); + return (1, undef) if ($proto eq 'udp' && defined($port_name_hash_udp{$str})); + return (1, undef) if ($proto eq '17' && defined($port_name_hash_udp{$str})); + return (undef, "\"$str\" is not a valid port name for protocol \"$proto\""); +} + +sub getPortRuleString { + my $port_str = shift; + my $can_use_port = shift; + my $prefix = shift; + my $proto = shift; + my $negate = ''; + if ($port_str =~ /^!(.*)$/) { + $port_str = $1; + $negate = '! '; + } + $port_str =~ s/-/:/g; + + my $num_ports = 0; + my @port_specs = split /,/, $port_str; + foreach my $port_spec (@port_specs) { + my ($success, $err) = (undef, undef); + if ($port_spec =~ /:/) { + ($success, $err) = isValidPortRange($port_spec, ':'); + if (defined($success)) { + $num_ports += 2; + next; + } else { + return (undef, $err); + } + } + if ($port_spec =~ /^\d/) { + ($success, $err) = isValidPortNumber($port_spec); + if (defined($success)) { + $num_ports += 1; + next; + } else { + return (undef, $err); + } + } + ($success, $err) = isValidPortName($port_spec, $proto); + if (defined($success)) { + $num_ports += 1; + next; + } else { + return (undef, $err); + } + } + + my $rule_str = ''; + if (($num_ports > 0) && (!$can_use_port)) { + return (undef, "ports can only be specified when protocol is \"tcp\" " + . "or \"udp\" (currently \"$proto\")"); + } + if ($num_ports > 15) { + return (undef, "source/destination port specification only supports " + . "up to 15 ports (port range counts as 2)"); + } + if ($num_ports > 1) { + $rule_str = " -m multiport --${prefix}ports ${negate}${port_str}"; + } elsif ($num_ports > 0) { + $rule_str = " --${prefix}port ${negate}${port_str}"; + } + + return ($rule_str, undef); +} + +1; diff --git a/lib/Vyatta/TypeChecker.pm b/lib/Vyatta/TypeChecker.pm new file mode 100755 index 0000000..124dc17 --- /dev/null +++ b/lib/Vyatta/TypeChecker.pm @@ -0,0 +1,229 @@ +#!/usr/bin/perl + +# Author: An-Cheng Huang +# Date: 2007 +# Description: Type checking script + +# **** License **** +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License version 2 as +# published by the Free Software Foundation. +# +# 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. +# +# This code was originally developed by Vyatta, Inc. +# Portions created by Vyatta are Copyright (C) 2006, 2007, 2008 Vyatta, Inc. +# All Rights Reserved. +# **** End License **** + +# Perl module for type validation. +# Usage 1: validate a value of a specific type. +# use Vyatta::TypeChecker; +# ... +# if (validateType('ipv4', '1.1.1.1')) { +# # valid +# ... +# } else { +# # not valie +# ... +# } +# +# Usage 2: find the type of a value (from a list of candidates), returns +# undef if the value is not valid for any of the candidates. +# $valtype = findType('1.1.1.1', 'ipv4', 'ipv6'); +# if (!defined($valtype)) { +# # neither ipv4 nor ipv6 +# ... +# } else { +# if ($valtype eq 'ipv4') { +# ... +# } else { +# ... +# } +# } + +package Vyatta::TypeChecker; +our @EXPORT = qw(findType validateType); +use base qw(Exporter); + +use strict; + +my %type_handler = ( + 'ipv4' => \&validate_ipv4, + 'ipv4net' => \&validate_ipv4net, + 'ipv4range' => \&validate_ipv4range, + 'ipv4_negate' => \&validate_ipv4_negate, + 'ipv4net_negate' => \&validate_ipv4net_negate, + 'ipv4range_negate' => \&validate_ipv4range_negate, + 'iptables4_addr' => \&validate_iptables4_addr, + 'protocol' => \&validate_protocol, + 'protocol_negate' => \&validate_protocol_negate, + 'macaddr' => \&validate_macaddr, + 'macaddr_negate' => \&validate_macaddr_negate, + 'ipv6' => \&validate_ipv6, + ); + +sub validate_ipv4 { + $_ = shift; + return 0 if (!/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/); + return 0 if ($1 > 255 || $2 > 255 || $3 > 255 || $4 > 255); + return 1; +} + +sub validate_ipv4net { + $_ = shift; + return 0 if (!/^(\d+)\.(\d+)\.(\d+)\.(\d+)\/(\d+)$/); + return 0 if ($1 > 255 || $2 > 255 || $3 > 255 || $4 > 255 || $5 > 32); + return 1; +} + +sub validate_ipv4range { + $_ = shift; + return 0 if (!/^([^-]+)-([^-]+)$/); + my ($a1, $a2) = ($1, $2); + return 0 if (!validate_ipv4($a1) || !validate_ipv4($a2)); + return 1; +} + +sub validate_ipv4_negate { + my $value = shift; + if ($value =~ m/^\!(.*)$/) { + $value = $1; + } + return validate_ipv4($value); +} + +sub validate_ipv4net_negate { + my $value = shift; + if ($value =~ m/^\!(.*)$/) { + $value = $1; + } + return validate_ipv4net($value); +} + +sub validate_ipv4range_negate { + my $value = shift; + if ($value =~ m/^\!(.*)$/) { + $value = $1; + } + return validate_ipv4range($value); +} + +sub validate_iptables4_addr { + my $value = shift; + return 0 if (!validate_ipv4_negate($value) + && !validate_ipv4net_negate($value) + && !validate_ipv4range_negate($value)); + return 1; +} + +sub validate_protocol { + my $value = shift; + $value = lc $value; + return 1 if ($value eq 'all'); + if (!open(IN, ") { + s/^([^#]*)#.*$/$1/; + if ((/^$value\s/) || (/^\S+\s+$value\s/)) { + $ret = 1; + last; + } + } + close IN; + return $ret; +} + +sub validate_protocol_negate { + my $value = shift; + if ($value =~ m/^\!(.*)$/) { + $value = $1; + } + return validate_protocol($value); +} + +sub validate_macaddr { + my $value = shift; + $value = lc $value; + my $byte = '[0-9a-f]{2}'; + return 1 if ($value =~ /^$byte(:$byte){5}$/); +} + +sub validate_macaddr_negate { + my $value = shift; + if ($value =~ m/^\!(.*)$/) { + $value = $1; + } + return validate_macaddr($value); +} + +# IPv6 syntax definition +my $RE_IPV4_BYTE = '((25[0-5])|(2[0-4][0-9])|([01][0-9][0-9])|([0-9]{1,2}))'; +my $RE_IPV4 = "$RE_IPV4_BYTE(\.$RE_IPV4_BYTE){3}"; +my $RE_H16 = '([a-fA-F0-9]{1,4})'; +my $RE_H16_COLON = "($RE_H16:)"; +my $RE_LS32 = "(($RE_H16:$RE_H16)|($RE_IPV4))"; +my $RE_IPV6_P1 = "($RE_H16_COLON)\{6\}$RE_LS32"; +my $RE_IPV6_P2 = "::($RE_H16_COLON)\{5\}$RE_LS32"; +my $RE_IPV6_P3 = "($RE_H16)?::($RE_H16_COLON)\{4\}$RE_LS32"; +my $RE_IPV6_P4 = "(($RE_H16_COLON)\{0,1\}$RE_H16)?" + . "::($RE_H16_COLON)\{3\}$RE_LS32"; +my $RE_IPV6_P5 = "(($RE_H16_COLON)\{0,2\}$RE_H16)?" + . "::($RE_H16_COLON)\{2\}$RE_LS32"; +my $RE_IPV6_P6 = "(($RE_H16_COLON)\{0,3\}$RE_H16)?" + . "::($RE_H16_COLON)\{1\}$RE_LS32"; +my $RE_IPV6_P7 = "(($RE_H16_COLON)\{0,4\}$RE_H16)?::$RE_LS32"; +my $RE_IPV6_P8 = "(($RE_H16_COLON)\{0,5\}$RE_H16)?::$RE_H16"; +my $RE_IPV6_P9 = "(($RE_H16_COLON)\{0,6\}$RE_H16)?::"; +my $RE_IPV6 = "($RE_IPV6_P1)|($RE_IPV6_P2)|($RE_IPV6_P3)|($RE_IPV6_P4)" + . "|($RE_IPV6_P5)|($RE_IPV6_P6)|($RE_IPV6_P7)|($RE_IPV6_P8)" + . "|($RE_IPV6_P9)"; + +sub validate_ipv6 { + $_ = shift; + return 0 if (!/^$RE_IPV6$/); + return 1; +} + +sub validateType { + my ($type, $value, $quiet) = @_; + if (!defined($type) || !defined($value)) { + return 0; + } + if (!defined($type_handler{$type})) { + print "type \"$type\" not defined\n" if (!defined($quiet)); + return 0; + } + if (!&{$type_handler{$type}}($value)) { + print "\"$value\" is not a valid value of type \"$type\"\n" + if (!defined($quiet)); + return 0; + } + + return 1; +} + +sub findType { + my ($value, @candidates) = @_; + if (!defined($value) || ((scalar @candidates) < 1)) { + return undef; + } + foreach my $type (@candidates) { + if (!defined($type_handler{$type})) { + next; + } + if (&{$type_handler{$type}}($value)) { + # the first valid type is returned + return $type; + } + } + return undef; +} + +1; diff --git a/scripts/VyattaConfig.pm b/scripts/VyattaConfig.pm deleted file mode 100755 index 9ddc8ef..0000000 --- a/scripts/VyattaConfig.pm +++ /dev/null @@ -1,603 +0,0 @@ -#!/usr/bin/perl - -# Author: An-Cheng Huang -# Date: 2007 -# Description: vyatta configuration parser - -# **** License **** -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License version 2 as -# published by the Free Software Foundation. -# -# 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. -# -# This code was originally developed by Vyatta, Inc. -# Portions created by Vyatta are Copyright (C) 2006, 2007, 2008 Vyatta, Inc. -# All Rights Reserved. -# **** End License **** - -package VyattaConfig; - -use strict; - -use VyattaConfigDOMTree; - -my %fields = ( - _changes_only_dir_base => $ENV{VYATTA_CHANGES_ONLY_DIR}, - _new_config_dir_base => $ENV{VYATTA_TEMP_CONFIG_DIR}, - _active_dir_base => $ENV{VYATTA_ACTIVE_CONFIGURATION_DIR}, - _vyatta_template_dir => $ENV{VYATTA_CONFIG_TEMPLATE}, - _current_dir_level => "/", - _level => undef, -); - -sub new { - my $that = shift; - my $class = ref ($that) || $that; - my $self = { - %fields, - }; - - bless $self, $class; - return $self; -} - -sub _set_current_dir_level { - my ($self) = @_; - my $level = $self->{_level}; - - $level =~ s/\//%2F/g; - $level =~ s/\s+/\//g; - - $self->{_current_dir_level} = "/$level"; - return $self->{_current_dir_level}; -} - -## setLevel("level") -# if "level" is supplied, set the current level of the hierarchy we are working on -# return the current level -sub setLevel { - my ($self, $level) = @_; - - $self->{_level} = $level if defined($level); - $self->_set_current_dir_level(); - - return $self->{_level}; -} - -## listNodes("level") -# return array of all nodes at "level" -# level is relative -sub listNodes { - my ($self, $path) = @_; - my @nodes = (); - - if (defined $path) { - $path =~ s/\//%2F/g; - $path =~ s/\s+/\//g; - $path = $self->{_new_config_dir_base} . $self->{_current_dir_level} . "/" . $path; - } - else { - $path = $self->{_new_config_dir_base} . $self->{_current_dir_level}; - } - - #print "DEBUG VyattaConfig->listNodes(): path = $path\n"; - opendir DIR, "$path" or return (); - @nodes = grep !/^\./, readdir DIR; - closedir DIR; - - my @nodes_modified = (); - while (@nodes) { - my $tmp = pop (@nodes); - $tmp =~ s/\n//g; - $tmp =~ s/%2F/\//g; - #print "DEBUG VyattaConfig->listNodes(): node = $tmp\n"; - push @nodes_modified, $tmp; - } - - return @nodes_modified; -} - -## listOrigNodes("level") -# return array of all original nodes (i.e., before any current change; i.e., -# in "working") at "level" -# level is relative -sub listOrigNodes { - my ($self, $path) = @_; - my @nodes = (); - - if (defined $path) { - $path =~ s/\//%2F/g; - $path =~ s/\s+/\//g; - $path = $self->{_active_dir_base} . $self->{_current_dir_level} . "/" - . $path; - } - else { - $path = $self->{_active_dir_base} . $self->{_current_dir_level}; - } - - #print "DEBUG VyattaConfig->listNodes(): path = $path\n"; - opendir DIR, "$path" or return (); - @nodes = grep !/^\./, readdir DIR; - closedir DIR; - - my @nodes_modified = (); - while (@nodes) { - my $tmp = pop (@nodes); - $tmp =~ s/\n//g; - $tmp =~ s/%2F/\//g; - #print "DEBUG VyattaConfig->listNodes(): node = $tmp\n"; - push @nodes_modified, $tmp; - } - - return @nodes_modified; -} - -## listOrigNodes("level") -# return array of all original nodes (i.e., before any current change; i.e., -# in "working") at "level" -# level is relative -sub listOrigNodesNoDef { - my ($self, $path) = @_; - my @nodes = (); - - if (defined $path) { - $path =~ s/\//%2F/g; - $path =~ s/\s+/\//g; - $path = $self->{_active_dir_base} . $self->{_current_dir_level} . "/" - . $path; - } - else { - $path = $self->{_active_dir_base} . $self->{_current_dir_level}; - } - - #print "DEBUG VyattaConfig->listNodes(): path = $path\n"; - opendir DIR, "$path" or return (); - @nodes = grep !/^\./, readdir DIR; - closedir DIR; - - my @nodes_modified = (); - while (@nodes) { - my $tmp = pop (@nodes); - $tmp =~ s/\n//g; - $tmp =~ s/%2F/\//g; - #print "DEBUG VyattaConfig->listNodes(): node = $tmp\n"; - if ($tmp ne 'def') { - push @nodes_modified, $tmp; - } - } - - return @nodes_modified; -} - -## returnParent("level") -# return the name of parent node relative to the current hierarchy -# in this case "level" is set to the parent dir ".. .." -# for example -sub returnParent { - my ($self, $node) = @_; - my @x, my $tmp; - - # split our hierarchy into vars on a stack - my @level = split /\s+/, $self->{_level}; - - # count the number of parents we need to lose - # and then pop 1 less - @x = split /\s+/, $node; - for ($tmp = 1; $tmp < @x; $tmp++) { - pop @level; - } - - # return the parent - $tmp = pop @level; - return $tmp; -} - -## returnValue("node") -# returns the value of "node" or undef if the node doesn't exist . -# node is relative -sub returnValue { - my ( $self, $node ) = @_; - my $tmp; - - $node =~ s/\//%2F/g; - $node =~ s/\s+/\//g; - - if ( -f "$self->{_new_config_dir_base}$self->{_current_dir_level}/$node/node.val" ) { - open FILE, "$self->{_new_config_dir_base}$self->{_current_dir_level}/$node/node.val" || return undef; - read FILE, $tmp, 16384; - close FILE; - - $tmp =~ s/\n$//; - return $tmp; - } - else { - return undef; - } -} - - -## returnOrigValue("node") -# returns the original value of "node" (i.e., before the current change; i.e., -# in "working") or undef if the node doesn't exist. -# node is relative -sub returnOrigValue { - my ( $self, $node ) = @_; - my $tmp; - - $node =~ s/\//%2F/g; - $node =~ s/\s+/\//g; - my $filepath = "$self->{_active_dir_base}$self->{_current_dir_level}/$node"; - if ( -f "$filepath/node.val") { - open FILE, "$filepath/node.val" || return undef; - read FILE, $tmp, 16384; - close FILE; - - $tmp =~ s/\n$//; - return $tmp; - } else { - return undef; - } -} - -## returnValues("node") -# returns an array of all the values of "node", or an empty array if the values do not exist. -# node is relative -sub returnValues { - my $val = returnValue(@_); - my @values = (); - if (defined($val)) { - @values = split("\n", $val); - } - return @values; -} - -## returnOrigValues("node") -# returns an array of all the original values of "node" (i.e., before the -# current change; i.e., in "working"), or an empty array if the values do not -# exist. -# node is relative -sub returnOrigValues { - my $val = returnOrigValue(@_); - my @values = (); - if (defined($val)) { - @values = split("\n", $val); - } - return @values; -} - -## exists("node") -# Returns true if the "node" exists. -sub exists { - my ( $self, $node ) = @_; - $node =~ s/\//%2F/g; - $node =~ s/\s+/\//g; - - if ( -d "$self->{_new_config_dir_base}$self->{_current_dir_level}/$node" ) { - #print "DEBUG: the dir is there\n"; - return !0; - } else { - return undef; - } -} - -## existsOrig("node") -# Returns true if the "original node" exists. -sub existsOrig { - my ( $self, $node ) = @_; - $node =~ s/\//%2F/g; - $node =~ s/\s+/\//g; - - if ( -d "$self->{_active_dir_base}$self->{_current_dir_level}/$node" ) { - return 1; - } else { - return undef; - } -} - -## isDeleted("node") -# is the "node" deleted. node is relative. returns true or false -sub isDeleted { - my ($self, $node) = @_; - $node =~ s/\//%2F/g; - $node =~ s/\s+/\//g; - - my $filepathAct - = "$self->{_active_dir_base}$self->{_current_dir_level}/$node"; - my $filepathNew - = "$self->{_new_config_dir_base}$self->{_current_dir_level}/$node"; - - if ((-e $filepathAct) && !(-e $filepathNew)) { - return 1; - } - return 0; -} - -## listDeleted("level") -# return array of deleted nodes in the "level" -# "level" defaults to current -sub listDeleted { - my ($self, $path) = @_; - my @new_nodes = $self->listNodes("$path"); - my @orig_nodes = $self->listOrigNodes("$path"); - my %new_hash = map { $_ => 1 } @new_nodes; - my @deleted = grep { !defined($new_hash{$_}) } @orig_nodes; - return @deleted; -} - -## isChanged("node") -# will check the change_dir to see if the "node" has been changed from a previous -# value. returns true or false. -sub isChanged { - my ($self, $node) = @_; - - # let's setup the filepath for the change_dir - $node =~ s/\//%2F/g; - $node =~ s/\s+/\//g; - my $filepath = "$self->{_changes_only_dir_base}$self->{_current_dir_level}/$node"; - - # if the node exists in the change dir, it's modified. - if (-e "$filepath") { return 1; } - else { return 0; } -} - -## isChangedOrDeleted("node") -# is the "node" changed or deleted. node is relative. returns true or false -sub isChangedOrDeleted { - my ($self, $node) = @_; - - $node =~ s/\//%2F/g; - $node =~ s/\s+/\//g; - - my $filepathChg - = "$self->{_changes_only_dir_base}$self->{_current_dir_level}/$node"; - if (-e $filepathChg) { - return 1; - } - - my $filepathAct - = "$self->{_active_dir_base}$self->{_current_dir_level}/$node"; - my $filepathNew - = "$self->{_new_config_dir_base}$self->{_current_dir_level}/$node"; - - if ((-e $filepathAct) && !(-e $filepathNew)) { - return 1; - } - - return 0; -} - -## isAdded("node") -# will compare the new_config_dir to the active_dir to see if the "node" has -# been added. returns true or false. -sub isAdded { - my ($self, $node) = @_; - - #print "DEBUG VyattaConfig->isAdded(): node $node\n"; - # let's setup the filepath for the modify dir - $node =~ s/\//%2F/g; - $node =~ s/\s+/\//g; - my $filepathNewConfig = "$self->{_new_config_dir_base}$self->{_current_dir_level}/$node"; - - #print "DEBUG VyattaConfig->isAdded(): filepath $filepathNewConfig\n"; - - # if the node doesn't exist in the modify dir, it's not - # been added. so short circuit and return false. - if (! -e $filepathNewConfig) { return 0; } - - # now let's setup the path for the working dir - my $filepathActive = "$self->{_active_dir_base}$self->{_current_dir_level}/$node"; - - # if the node is in the active_dir it's not new - if (-e $filepathActive) { return 0; } - else { return 1; } -} - -## listNodeStatus("level") -# return a hash of the status of nodes at the current config level -# node name is the hash key. node status is the hash value. -# node status can be one of deleted, added, changed, or static -sub listNodeStatus { - my ($self, $path) = @_; - my @nodes = (); - my %nodehash = (); - - # find deleted nodes first - @nodes = $self->listDeleted("$path"); - foreach my $node (@nodes) { - if ($node =~ /.+/) { $nodehash{$node} = "deleted" }; - } - - @nodes = (); - @nodes = $self->listNodes("$path"); - foreach my $node (@nodes) { - if ($node =~ /.+/) { - #print "DEBUG VyattaConfig->listNodeStatus(): node $node\n"; - # No deleted nodes -- added, changed, ot static only. - if ($self->isAdded("$path $node")) { $nodehash{$node} = "added"; } - elsif ($self->isChanged("$path $node")) { $nodehash{$node} = "changed"; } - else { $nodehash{$node} = "static"; } - } - } - - return %nodehash; -} - -############ DOM Tree ################ - -#Create active DOM Tree -sub createActiveDOMTree { - - my $self = shift; - - my $tree = new VyattaConfigDOMTree($self->{_active_dir_base} . $self->{_current_dir_level},"active"); - - return $tree; -} - -#Create changes only DOM Tree -sub createChangesOnlyDOMTree { - - my $self = shift; - - my $tree = new VyattaConfigDOMTree($self->{_changes_only_dir_base} . $self->{_current_dir_level}, - "changes_only"); - - return $tree; -} - -#Create new config DOM Tree -sub createNewConfigDOMTree { - - my $self = shift; - - my $tree = new VyattaConfigDOMTree($self->{_new_config_dir_base} . $self->{_current_dir_level}, - "new_config"); - - return $tree; -} - - -###### functions for templates ###### - -# $1: array representing the config node path. -# returns the filesystem path to the template of the specified node, -# or undef if the specified node path is not valid. -sub getTmplPath { - my $self = shift; - my @cfg_path = @{$_[0]}; - my $tpath = $self->{_vyatta_template_dir}; - for my $p (@cfg_path) { - if (-d "$tpath/$p") { - $tpath .= "/$p"; - next; - } - if (-d "$tpath/node.tag") { - $tpath .= "/node.tag"; - next; - } - # the path is not valid! - return undef; - } - return $tpath -} - -sub isTagNode { - my $self = shift; - my $cfg_path_ref = shift; - my $tpath = $self->getTmplPath($cfg_path_ref); - return undef if (!defined($tpath)); - if (-d "$tpath/node.tag") { - return 1; - } - return 0; -} - -sub hasTmplChildren { - my $self = shift; - my $cfg_path_ref = shift; - my $tpath = $self->getTmplPath($cfg_path_ref); - return undef if (!defined($tpath)); - opendir(TDIR, $tpath) or return 0; - my @tchildren = grep !/^node\.def$/, (grep !/^\./, (readdir TDIR)); - closedir TDIR; - if (scalar(@tchildren) > 0) { - return 1; - } - return 0; -} - -# $cfg_path_ref: ref to array containing the node path. -# returns ($is_multi, $is_text, $default), -# or undef if specified node is not valid. -sub parseTmpl { - my $self = shift; - my $cfg_path_ref = shift; - my ($is_multi, $is_text, $default) = (0, 0, undef); - my $tpath = $self->getTmplPath($cfg_path_ref); - return undef if (!defined($tpath)); - if (! -r "$tpath/node.def") { - return ($is_multi, $is_text); - } - open(TMPL, "<$tpath/node.def") or return ($is_multi, $is_text); - foreach () { - if (/^multi:/) { - $is_multi = 1; - } - if (/^type:\s+txt\s*$/) { - $is_text = 1; - } - if (/^default:\s+(\S+)\s*$/) { - $default = $1; - } - } - close TMPL; - return ($is_multi, $is_text, $default); -} - -###### misc functions ###### - -# compare two value lists and return "deleted" and "added" lists. -# since this is for multi-value nodes, there is no "changed" (if a value's -# ordering changed, it is deleted then added). -# $0: \@orig_values -# $1: \@new_values -sub compareValueLists { - my $self = shift; - my @ovals = @{$_[0]}; - my @nvals = @{$_[1]}; - my %comp_hash = ( - 'deleted' => [], - 'added' => [], - ); - my $idx = 0; - my %ohash = map { $_ => ($idx++) } @ovals; - $idx = 0; - my %nhash = map { $_ => ($idx++) } @nvals; - my $min_changed_idx = 2**31; - my %dhash = (); - foreach (@ovals) { - if (!defined($nhash{$_})) { - push @{$comp_hash{'deleted'}}, $_; - $dhash{$_} = 1; - if ($ohash{$_} < $min_changed_idx) { - $min_changed_idx = $ohash{$_}; - } - } - } - foreach (@nvals) { - if (defined($ohash{$_})) { - if ($ohash{$_} != $nhash{$_}) { - if ($ohash{$_} < $min_changed_idx) { - $min_changed_idx = $ohash{$_}; - } - } - } - } - foreach (@nvals) { - if (defined($ohash{$_})) { - if ($ohash{$_} != $nhash{$_}) { - if (!defined($dhash{$_})) { - push @{$comp_hash{'deleted'}}, $_; - $dhash{$_} = 1; - } - push @{$comp_hash{'added'}}, $_; - } elsif ($ohash{$_} >= $min_changed_idx) { - # ordering unchanged, but something before it is changed. - if (!defined($dhash{$_})) { - push @{$comp_hash{'deleted'}}, $_; - $dhash{$_} = 1; - } - push @{$comp_hash{'added'}}, $_; - } else { - # this is before any changed value. do nothing. - } - } else { - push @{$comp_hash{'added'}}, $_; - } - } - return %comp_hash; -} diff --git a/scripts/VyattaConfigDOMTree.pm b/scripts/VyattaConfigDOMTree.pm deleted file mode 100755 index 4e7ce31..0000000 --- a/scripts/VyattaConfigDOMTree.pm +++ /dev/null @@ -1,370 +0,0 @@ -#!/usr/bin/perl - -# -# Module: vyatta-cfg -# -# **** License **** -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License version 2 as -# published by the Free Software Foundation. -# -# 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. -# -# A copy of the GNU General Public License is available as -# `/usr/share/common-licenses/GPL' in the Debian GNU/Linux distribution -# or on the World Wide Web at `http://www.gnu.org/copyleft/gpl.html'. -# You can also obtain it by writing to the Free Software Foundation, -# Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, -# MA 02110-1301, USA. -# -# This code was originally developed by Vyatta, Inc. -# Portions created by Vyatta are Copyright (C) 2005, 2006, 2007 Vyatta, Inc. -# All Rights Reserved. -# -# Author: Oleg Moskalenko -# Date: 2007 -# Description: -# -# **** End License **** -# -# - -package VyattaConfigDOMTree; - -use strict; - -my %fields = ( - _dir => undef, - _name => undef, - _value => undef, - _subnodes => undef - ); - -sub new { - - my $that = shift; - my $dir = shift; - my $name = shift; - - my $class = ref ($that) || $that; - - my $self = { - %fields - }; - - bless $self, $class; - - $self->{_dir} = $dir; - $self->{_name} = $name; - - return $self->_construct_dom_tree(); -} - -#Simple DOM Tree iteration and screen output -#$1 - left screen offset (optional) -sub print { - - my $self = shift; - my $level = shift; - - my $tree = $self; - - if(!(defined $level)) { - $level=""; - } - - if(defined $tree) { - - print("$level name=",$tree->getNodeName(),"\n"); - - my $value = $tree->getNodeValue(); - - if(defined $value) { - - print("$level value=$value\n"); - - } - - my @subnodes = $tree->getSubNodes(); - - while(@subnodes) { - - my $subnode = shift @subnodes; - $subnode->print($level . " "); - } - } -} - -#Return value of the tree node -sub getNodeValue { - - my $self = shift; - my $tree = $self; - - my $ret = undef; - - if(defined $tree) { - - $ret = $tree->{_value}; - } - - return $ret; -} - -#Return value of the tree node. -#If the value is nor defined, return empty string. -sub getNodeValueAsString { - - my $self = shift; - my $tree = $self; - - my $ret = undef; - - if(defined $tree) { - - $ret = $tree->getNodeValue(); - } - - if(!defined $ret) { - $ret = ""; - } - - return $ret; -} - -#Return name of the tree node -sub getNodeName { - - my $self = shift; - my $tree = $self; - - my $ret = undef; - - if(defined $tree) { - - $ret = $tree->{_name}; - } - - return $ret; -} - -#Return array of subnodes of the tree node -sub getSubNodes { - - my $self = shift; - my $tree = $self; - - my @ret = (); - - if(defined $tree) { - - my $subnodes = $tree->{_subnodes}; - - if(defined $subnodes) { - - @ret = values %{$subnodes}; - - } - } - - return @ret; -} - -sub isLeafNode { - - my $self = shift; - my $tree = $self; - - my $ret=undef; - - if(defined $tree) { - - if(defined $tree->{_value}) { - - if(! defined $tree->{_subnodes}) { - - $ret="true"; - } - } - } - - return $ret; -} - -#Return subtree of the tree according to the path list -#$1, $2, ... - path to the subtree -sub getSubNode { - - my $self = shift; - my $tree = $self; - - my $ret = undef; - - while(@_ && $tree) { - - my $subnode = shift (@_); - - my $subnodes = $tree->{_subnodes}; - - if(defined $subnodes) { - - $tree = $subnodes->{$subnode}; - - } else { - - $tree = undef; - - } - } - - $ret=$tree; - - return $ret; -} - -#Return value of the subnode of the tree according to the path list -#$1, $2, ... - path to the subtree -sub getSubNodeValue { - - my $self = shift; - my $tree = $self; - - my $ret = undef; - - if(defined $tree) { - - my $node = $tree->getSubNode(@_); - - if(defined $node) { - - $ret=$node->getNodeValue(); - } - } - - return $ret; -} - -#Return value of the subnode of the tree according to the path list. -#If the value is not defined, return empty string. -#$1, $2, ... - path to the subtree -sub getSubNodeValueAsString { - - my $self = shift; - my $tree = $self; - - my $ret = undef; - - if(defined $tree) { - - my $node = $tree->getSubNode(@_); - - if(defined $node) { - - $ret=$node->getNodeValue(); - } - } - - if(! defined $ret) { - $ret = ""; - } - - return $ret; -} - -#Check if there is a subnode with the specified path. -#$1, $2, ... - path to the subtree -sub subNodeExist { - - my $self = shift; - my $tree = $self; - - my $ret = undef; - - if(defined $tree) { - - my $node = $tree->getSubNode(@_); - - if(defined $node) { - - $ret="true"; - } - } - - return $ret; -} - -#Return of the children of the node -#$1, $2, ... - path to the subtree -sub getSubNodesNumber { - - my $self = shift; - my $tree = $self; - - my $ret = 0; - - if(defined $tree) { - - my $node = $tree->getSubNode(@_); - - if(defined $node) { - - my @subs = $node->getSubNodes(); - - if(@subs) { - $ret = $#subs + 1; - } - } - } - - return $ret; -} - -#private method: costruct DOM Tree according to the absolute path provided -sub _construct_dom_tree { - - my $self = shift; - - my $subnodesNum=0; - my $valuePresent=0; - - if(!(defined $self)) {return undef;} - - opendir DIR, $self->{_dir} or return undef; - my @entries = grep !/^\./, readdir DIR; - closedir DIR; - - while(@entries) { - - my $entry = shift @entries; - - if($entry) { - my $fn = $self->{_dir} . "/" . $entry; - if( -f $fn) { - if($entry eq "node.val") { - my $value=`cat $fn`; - while(chomp $value) {}; - $self->{_value} = $value; - $valuePresent++; - } - } elsif (-d $fn) { - my $subnode = new VyattaConfigDOMTree($fn,$entry); - if(defined $subnode) { - if(! defined $self->{_subnodes} ) { - $self->{_subnodes} = {}; - } - $self->{_subnodes}->{$entry} = $subnode; - $subnodesNum++; - } - } - } - } - - if($valuePresent<1 && $subnodesNum<1) { - return undef; - } - - return $self; -} diff --git a/scripts/VyattaConfigLoad.pm b/scripts/VyattaConfigLoad.pm deleted file mode 100755 index 5305dc8..0000000 --- a/scripts/VyattaConfigLoad.pm +++ /dev/null @@ -1,421 +0,0 @@ -#!/usr/bin/perl - -# Author: An-Cheng Huang -# Date: 2007 -# Description: Perl module for loading configuration. - -# **** License **** -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License version 2 as -# published by the Free Software Foundation. -# -# 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. -# -# This code was originally developed by Vyatta, Inc. -# Portions created by Vyatta are Copyright (C) 2006, 2007, 2008 Vyatta, Inc. -# All Rights Reserved. - -package VyattaConfigLoad; - -use strict; -use sort 'stable'; -use lib "/opt/vyatta/share/perl5/"; -use XorpConfigParser; -use VyattaConfig; - -# configuration ordering. higher rank configured before lower rank. -my $default_rank = 0; -my %config_rank = ( - 'qos-policy' => 1100, - 'firewall' => 1020, - 'service nat' => 1010, - 'system host-name' => 1005, - 'interfaces' => 1000, - 'interfaces bridge' => 990, - 'interfaces bonding' => 995, - 'interfaces ethernet' => 980, - 'interfaces tunnel' => 910, - 'system gateway-address' => 890, - 'system name-server' => 880, - 'system login user' => 870, - 'system' => 860, - 'protocols static' => 850, - 'service ssh' => 840, - 'service telnet' => 830, - 'policy' => 820, - 'protocols bgp' => 790, - 'protocols ospf parameters' => 785, - 'protocols ospf' => 780, - 'protocols rip' => 770, - 'vpn' => 600, - -); - -my %regex_rank = ( - 'interfaces ethernet \S* vrrp' => 500, - 'interfaces ethernet \S* vif \S* vrrp' => 500, - 'interfaces ethernet \S* pppo[ea]' => 400, - 'protocols bgp \d+ parameters' => 810, - 'protocols bgp \d+ neighbor \d+\.\d+\.\d+\.\d+' => 800, - 'protocols bgp \d+ neighbor \w+' => 801, -); - -my @all_nodes = (); -my @all_naked_nodes = (); - -sub match_regex { - my ($pattern, $str) = @_; - $pattern =~ s/^(.*)$/\^$1\$/; - return ($str =~ m/$pattern/) ? 1 : 0; -} - -sub get_regex_rank { - my ($str) = @_; - foreach (keys %regex_rank) { - if (match_regex($_, $str)) { - return $regex_rank{$_}; - } - } - return undef; -} - -sub get_config_rank { - # longest prefix match - my @path = @_; - while ((scalar @path) > 0) { - my $path_str = join ' ', @path; - if (defined($config_rank{$path_str})) { - return ($config_rank{$path_str}); - } - my $wrank = get_regex_rank($path_str); - return $wrank if (defined($wrank)); - pop @path; - } - return $default_rank; -} - -sub applySingleQuote { - my @return = (); - foreach (@_) { - # change all single quotes to "'\''" since we're going to single-quote - # every component of the command - if (/^'(.*)'$/) { - $_ = $1; - } - $_ =~ s/'/'\\''/g; - # single-quote every component of the command - if (/^'.*'$/) { - push @return, $_; - } elsif (/^"(.*)"$/) { - push @return, "'$1'"; - } else { - push @return, "'$_'"; - } - } - return @return; -} - -sub enumerate_branch { - my $cur_node = shift; - my @cur_path = @_; - # name not defined at root level - if (defined($cur_node->{'name'})) { - my $name = $cur_node->{'name'}; - if ($name =~ /^\s*(\S+)\s+(\S.*)$/) { - push @cur_path, ($1, $2); - } else { - push @cur_path, $name; - } - } - my $terminal = 0; - if (!defined($cur_node->{'children'})) { - $terminal = 1; - } else { - foreach (@{$cur_node->{'children'}}) { - if (defined($_->{'name'})) { - enumerate_branch($_, @cur_path); - $terminal = 0; - } - } - } - if ($terminal) { - my $val = $cur_node->{'value'}; - if (defined($val)) { - push @cur_path, $val; - } - push @all_naked_nodes, [ @cur_path ]; - my @qpath = applySingleQuote(@cur_path); - push @all_nodes, [\@qpath, get_config_rank(@cur_path)]; - } -} - -# $0: config file to load -# return: list of all config statement sorted by rank -sub getStartupConfigStatements { - # clean up the lists first - @all_nodes = (); - @all_naked_nodes = (); - - my $load_cfg = shift; - if (!defined($load_cfg)) { - return (); - } - - my $xcp = new XorpConfigParser(); - $xcp->parse($load_cfg); - my $root = $xcp->get_node( () ); - if (!defined($root)) { - return (); - } - enumerate_branch($root, ( )); - - @all_nodes = sort { ${$b}[1] <=> ${$a}[1] } @all_nodes; - return @all_nodes; -} - -my %node_order = (); - -# $0: ref of list of parsed naked statements. -# return: hash containing the config hierarchy. -sub generateHierarchy { - my @node_list = @{$_[0]}; - my %hash = (); - %node_order = (); - my $order = 0; - foreach my $node (@node_list) { - my @path = @{$node}; - my $path_str = join ' ', @path; - $node_order{$path_str} = $order; - $order++; - my $cur_ref = \%hash; - foreach (@path) { - if (!defined($cur_ref->{$_})) { - $cur_ref->{$_} = { }; - } - $cur_ref = $cur_ref->{$_}; - } - } - return %hash; -} - -# $0: config file to load. -# return: hash containing the config hierarchy. -sub loadConfigHierarchy { - # clean up the lists first - @all_nodes = (); - @all_naked_nodes = (); - - my $load_cfg = shift; - if (!defined($load_cfg)) { - return (); - } - - my $xcp = new XorpConfigParser(); - $xcp->parse($load_cfg); - my $root = $xcp->get_node( () ); - if (!defined($root)) { - return (); - } - enumerate_branch($root, ( )); - - return generateHierarchy(\@all_naked_nodes); -} - -# $0: ref of hierarchy root. -# $1: display prefix. -sub printHierarchy { - my $cur_ref = shift; - my $prefix = shift; - foreach (sort keys %{$cur_ref}) { - print "$prefix$_"; - if (scalar(keys %{$cur_ref->{$_}}) == 0) { - print " (terminal)\n"; - next; - } else { - print "\n"; - } - printHierarchy($cur_ref->{$_}, "$prefix "); - } -} - -# $0: hash ref representing a "multi:" node. -# $1: array ref representing current config path. -# returns the list of node values sorted by the original order. -sub getSortedMultiValues { - my $nref = $_[0]; - my @npath = @{$_[1]}; - my $path_str = join ' ', @npath; - my @list = (); - foreach (keys %{$nref}) { - my $key = "$path_str $_"; - push @list, [ $_, $node_order{$key} ]; - } - my @slist = sort { ${$a}[1] <=> ${$b}[1] } @list; - @slist = map { ${$_}[0] } @slist; - return @slist; -} - -my $active_cfg = undef; -my $new_cfg_ref = undef; - -my @delete_list = (); - -# find specified node's values in active config that have been deleted from -# new config. -# $0: hash ref at the current hierarchy level (new config) -# $1: array ref representing current config path (active config) -sub findDeletedValues { - my $new_ref = $_[0]; - my @active_path = @{$_[1]}; - my ($is_multi, $is_text) = $active_cfg->parseTmpl(\@active_path); - $active_cfg->setLevel(join ' ', @active_path); - if ($is_multi) { - # for "multi:" nodes, need to sort the values by the original order. - my @nvals = getSortedMultiValues($new_ref, \@active_path); - if ($is_text) { - @nvals = map { /^"(.*)"$/ ? $1 : $_ }@nvals; - } - my @ovals = $active_cfg->returnOrigValues(''); - my %comp_hash = $active_cfg->compareValueLists(\@ovals, \@nvals); - foreach (@{$comp_hash{'deleted'}}) { - my @plist = applySingleQuote(@active_path, $_); - push @delete_list, [\@plist, get_config_rank(@active_path, $_)]; - } - } else { - # do nothing. if a single-value leaf node is deleted, it should have - # been detected at the previous level. since we are already at node.val, - # it can only be "added" or "changed", handled later. - } -} - -# find nodes in active config that have been deleted from new config. -# $0: hash ref at the current hierarchy level (new config) -# $1: array ref representing current config path (active config) -sub findDeletedNodes { - my $new_ref = $_[0]; - my @active_path = @{$_[1]}; - $active_cfg->setLevel(join ' ', @active_path); - my @active_nodes = $active_cfg->listOrigNodes(); - foreach (@active_nodes) { - if ($_ eq 'def') { - next; - } - if ($_ eq 'node.val') { - findDeletedValues($new_ref, \@active_path); - next; - } - if (!defined($new_ref->{$_})) { - my @plist = applySingleQuote(@active_path, $_); - push @delete_list, [\@plist, get_config_rank(@active_path, $_)]; - } else { - findDeletedNodes($new_ref->{$_}, [ @active_path, $_ ]); - } - } -} - -my @set_list = (); - -# find specified node's values in active config that are set -# (added or changed). -# $0: hash ref at the current hierarchy level (new config) -# $1: array ref representing current config path (active config) -sub findSetValues { - my $new_ref = $_[0]; - my @active_path = @{$_[1]}; - my ($is_multi, $is_text) = $active_cfg->parseTmpl(\@active_path); - $active_cfg->setLevel(join ' ', @active_path); - if ($is_multi) { - # for "multi:" nodes, need to sort the values by the original order. - my @nvals = getSortedMultiValues($new_ref, \@active_path); - if ($is_text) { - @nvals = map { /^"(.*)"$/ ? $1 : $_ } @nvals; - } - my @ovals = $active_cfg->returnOrigValues(''); - my %comp_hash = $active_cfg->compareValueLists(\@ovals, \@nvals); - foreach (@{$comp_hash{'added'}}) { - my @plist = applySingleQuote(@active_path, $_); - push @set_list, [\@plist, get_config_rank(@active_path, $_)]; - } - } else { - my @nvals = keys %{$new_ref}; - my $nval = $nvals[0]; - if ($is_text) { - $nval =~ s/^"(.*)"$/$1/; - } - my $oval = $active_cfg->returnOrigValue(''); - if (!defined($oval) || ($nval ne $oval)) { - my @plist = applySingleQuote(@active_path, $nval); - push @set_list, [\@plist, get_config_rank(@active_path, $nval)]; - } - } -} - -# find nodes in new config that are set (added or changed). -# $0: hash ref at the current hierarchy level (new config) -# $1: array ref representing current config path (active config) -sub findSetNodes { - my $new_ref = $_[0]; - my @active_path = @{$_[1]}; - $active_cfg->setLevel(join ' ', @active_path); - my @active_nodes = $active_cfg->listOrigNodes(); - my %active_hash = map { $_ => 1 } @active_nodes; - if (defined($active_hash{'node.val'})) { - # we are at a leaf node. - findSetValues($new_ref, \@active_path); - return; - } - foreach (sort keys %{$new_ref}) { - if (scalar(keys %{$new_ref->{$_}}) == 0) { - # we are at a non-value leaf node. - # check if we need to add this node. - if (!defined($active_hash{$_})) { - my @plist = applySingleQuote(@active_path, $_); - push @set_list, [\@plist, get_config_rank(@active_path, $_)]; - } else { - # node already present. do nothing. - } - next; - } - # we recur regardless of whether it's in active. all changes will be - # handled when we reach leaf nodes (above). - findSetNodes($new_ref->{$_}, [ @active_path, $_ ]); - } -} - -# compare the current active config with the specified hierarchy and return -# the "diff". -# $0: hash ref of config hierarchy. -# return: hash containing the diff. -sub getConfigDiff { - $active_cfg = new VyattaConfig; - $new_cfg_ref = shift; - @set_list = (); - @delete_list = (); - findDeletedNodes($new_cfg_ref, [ ]); - findSetNodes($new_cfg_ref, [ ]); - # don't really need to sort the lists by rank since we have to commit - # everything together anyway. - @delete_list = sort { ${$a}[1] <=> ${$b}[1] } @delete_list; - @set_list = sort { ${$b}[1] <=> ${$a}[1] } @set_list; - - # need to filter out deletions of nodes with default values - my @new_delete_list = (); - foreach my $del (@delete_list) { - my @comps = map { s/^'(.*)'$/$1/; $_; } @{${$del}[0]}; - my ($is_multi, $is_text, $default) = $active_cfg->parseTmpl(\@comps); - if (!defined($default)) { - push @new_delete_list, $del; - } - } - - my %diff = ( - 'delete' => \@new_delete_list, - 'set' => \@set_list, - ); - return %diff; -} - -1; diff --git a/scripts/VyattaConfigOutput.pm b/scripts/VyattaConfigOutput.pm deleted file mode 100755 index fa0b274..0000000 --- a/scripts/VyattaConfigOutput.pm +++ /dev/null @@ -1,371 +0,0 @@ -#!/usr/bin/perl - -# Author: An-Cheng Huang -# Date: 2007 -# Description: Perl module for generating output of the configuration. - -# **** License **** -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License version 2 as -# published by the Free Software Foundation. -# -# 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. -# -# This code was originally developed by Vyatta, Inc. -# Portions created by Vyatta are Copyright (C) 2006, 2007, 2008 Vyatta, Inc. -# All Rights Reserved. -# **** End License **** - - -# outputNewConfig() -# prints the "new" config, i.e., the active config with any un-committed -# changes. 'diff' notation is also generated to indicate the changes. -# -# outputActiveConfig() -# prints the "active" config. suitable for "saving", for example. - -package VyattaConfigOutput; - -use strict; -use lib '/opt/vyatta/share/perl5/'; -use VyattaConfig; -use Sort::Versions; - -# whether to show default values -my $show_all = 0; -sub set_show_all { - if (shift) { - $show_all = 1; - } -} - -my $hide_password = 0; -sub set_hide_password { - if (shift) { - $hide_password = 1; - } -} - -sub txt_need_quotes { - $_ = shift; - return 1 if (/^$/ || /[\s\*}{;]/); - return 0; -} - -my $config = undef; - -# $0: array ref for path -# $1: display prefix -# $2: node name -# $3: simple show (if defined, don't show diff prefix. used for "don't show as -# deleted" from displayDeletedOrigChildren.) -sub displayValues { - my @cur_path = @{$_[0]}; - my $prefix = $_[1]; - my $name = $_[2]; - my $simple_show = $_[3]; - my ($is_multi, $is_text, $default) = $config->parseTmpl(\@cur_path); - if ($is_text) { - $default =~ /^"(.*)"$/; - my $txt = $1; - if (!txt_need_quotes($txt)) { - $default = $txt; - } - } - my $is_password = ($name =~ /^.*(password|pre-shared-secret)$/); - my $HIDE_PASSWORD = '****************'; - $config->setLevel(join ' ', @cur_path); - if ($is_multi) { - my @ovals = $config->returnOrigValues(''); - my @nvals = $config->returnValues(''); - if ($is_text) { - @ovals = map { (txt_need_quotes($_)) ? "\"$_\"" : "$_"; } @ovals; - @nvals = map { (txt_need_quotes($_)) ? "\"$_\"" : "$_"; } @nvals; - } - my $idx = 0; - my %ohash = map { $_ => ($idx++) } @ovals; - $idx = 0; - my %nhash = map { $_ => ($idx++) } @nvals; - my @dlist = map { if (!defined($nhash{$_})) { $_; } else { undef; } } - @ovals; - if (defined($simple_show)) { - foreach my $oval (@ovals) { - if ($is_password && $hide_password) { - $oval = $HIDE_PASSWORD; - } - print "$prefix$name $oval\n"; - } - return; - } - foreach my $del (@dlist) { - if (defined($del)) { - if ($is_password && $hide_password) { - $del = $HIDE_PASSWORD; - } - print "-$prefix$name $del\n"; - } - } - foreach my $nval (@nvals) { - my $diff = '+'; - if (defined($ohash{$nval})) { - if ($ohash{$nval} != $nhash{$nval}) { - $diff = '>'; - } else { - $diff = ' '; - } - } - if ($is_password && $hide_password) { - $nval = $HIDE_PASSWORD; - } - print "$diff$prefix$name $nval\n"; - } - } else { - my $oval = $config->returnOrigValue(''); - my $nval = $config->returnValue(''); - if ($is_text) { - if (defined($oval) && txt_need_quotes($oval)) { - $oval = "\"$oval\""; - } - if (defined($nval) && txt_need_quotes($nval)) { - $nval = "\"$nval\""; - } - } - - my %cnodes = $config->listNodeStatus(); - my @cnames = sort keys %cnodes; - - if (defined($simple_show)) { - if (!$cnodes{'def'} || $show_all) { - if ($is_password && $hide_password) { - $oval = $HIDE_PASSWORD; - } - print "$prefix$name $oval\n"; - } - return; - } - my $value = $nval; - my $diff = ' '; - if (!defined($oval) && defined($nval)) { - $diff = '+'; - } elsif (!defined($nval) && defined($oval)) { - $diff = '-'; - $value = $oval; - } else { - # both must be defined - if ($oval ne $nval) { - $diff = '>'; - } - } - if (!$cnodes{'def'} || $show_all) { - if ($is_password && $hide_password) { - $value = $HIDE_PASSWORD; - } - print "$diff$prefix$name $value\n"; - } - } -} - -# $0: array ref for path -# $1: display prefix -# $2: don't show as deleted? (if defined, config is shown as normal instead of -# deleted.) -sub displayDeletedOrigChildren { - my @cur_path = @{$_[0]}; - my $prefix = $_[1]; - my $dont_show_as_deleted = $_[2]; - my $dprefix = '-'; - if (defined($dont_show_as_deleted)) { - $dprefix = ''; - } - $config->setLevel(''); - my @children = $config->listOrigNodes(join ' ', @cur_path); - for my $child (sort @children) { - if ($child eq 'node.val') { - # should not happen! - next; - } - my $is_tag = $config->isTagNode([ @cur_path, $child ]); - $config->setLevel(join ' ', (@cur_path, $child)); - my @cnames = sort $config->listOrigNodesNoDef(); - - if ($cnames[0] eq 'node.val') { - displayValues([ @cur_path, $child ], $prefix, $child, - $dont_show_as_deleted); - } elsif ($cnames[0] eq 'def') { - #ignore - } elsif (scalar($#cnames) >= 0) { - if ($is_tag) { - @cnames = sort versioncmp @cnames; - foreach my $cname (@cnames) { - if ($cname eq 'node.val') { - # should not happen - next; - } - print "$dprefix$prefix$child $cname {\n"; - displayDeletedOrigChildren([ @cur_path, $child, $cname ], - "$prefix ", $dont_show_as_deleted); - print "$dprefix$prefix}\n"; - } - } else { - print "$dprefix$prefix$child {\n"; - displayDeletedOrigChildren([ @cur_path, $child ], "$prefix ", - $dont_show_as_deleted); - print "$dprefix$prefix}\n"; - } - } else { - my $has_tmpl_children = $config->hasTmplChildren([ @cur_path, $child ]); - print "$dprefix$prefix$child" - . ($has_tmpl_children ? " {\n$dprefix$prefix}\n" : "\n"); - } - } -} - -# $0: hash ref for children status -# $1: array ref for path -# $2: display prefix -sub displayChildren { - my %child_hash = %{$_[0]}; - my @cur_path = @{$_[1]}; - my $prefix = $_[2]; - for my $child (sort (keys %child_hash)) { - if ($child eq 'node.val') { - # should not happen! - next; - } - my ($diff, $vdiff) = (' ', ' '); - if ($child_hash{$child} eq 'added') { - $diff = '+'; - $vdiff = '+'; - } elsif ($child_hash{$child} eq 'deleted') { - $diff = '-'; - $vdiff = '-'; - } elsif ($child_hash{$child} eq 'changed') { - $vdiff = '>'; - } - my $is_tag = $config->isTagNode([ @cur_path, $child ]); - $config->setLevel(join ' ', (@cur_path, $child)); - my %cnodes = $config->listNodeStatus(); - my @cnames = sort keys %cnodes; - - #if node.val exists and ct == 0 w/o def or ct ==1 w/ def - my $leaf = 0; - if ($cnodes{'def'}) { - if ($#cnames == 1 && $cnodes{'node.val'}) { - $leaf = 1; - } - } else { - if ($#cnames == 0 && $cnodes{'node.val'}) { - $leaf = 1; - } - } - - if ($leaf == 1) { - displayValues([ @cur_path, $child ], $prefix, $child); - } elsif (scalar($#cnames) >= 0) { - if ($is_tag) { - @cnames = sort versioncmp @cnames; - foreach my $cname (@cnames) { - if ($cname eq 'node.val') { - # should not happen - next; - } - my $tdiff = ' '; - if ($cnodes{$cname} eq 'deleted') { - $tdiff = '-'; - } elsif ($cnodes{$cname} eq 'added') { - $tdiff = '+'; - } - print "$tdiff$prefix$child $cname {\n"; - if ($cnodes{$cname} eq 'deleted') { - displayDeletedOrigChildren([ @cur_path, $child, $cname ], - "$prefix "); - } else { - $config->setLevel(join ' ', (@cur_path, $child, $cname)); - my %ccnodes = $config->listNodeStatus(); - displayChildren(\%ccnodes, [ @cur_path, $child, $cname ], - "$prefix "); - } - print "$tdiff$prefix}\n"; - } - } else { - print "$diff$prefix$child {\n"; - if ($child_hash{$child} eq 'deleted') { - # this should not happen - displayDeletedOrigChildren([ @cur_path, $child ], "$prefix "); - } else { - displayChildren(\%cnodes, [ @cur_path, $child ], "$prefix "); - } - print "$diff$prefix}\n"; - } - } else { - if ($child_hash{$child} eq 'deleted') { - $config->setLevel(''); - my @onodes = $config->listOrigNodes(join ' ', (@cur_path, $child)); - if ($#onodes == 0 && $onodes[0] eq 'node.val') { - displayValues([ @cur_path, $child ], $prefix, $child); - } else { - print "$diff$prefix$child {\n"; - displayDeletedOrigChildren([ @cur_path, $child ], "$prefix "); - print "$diff$prefix}\n"; - } - } else { - my $has_tmpl_children - = $config->hasTmplChildren([ @cur_path, $child ]); - print "$diff$prefix$child" - . ($has_tmpl_children ? " {\n$diff$prefix}\n" : "\n"); - } - } - } -} - -# @ARGV: represents the 'root' path. the output starts at this point under -# the new config. -sub outputNewConfig { - $config = new VyattaConfig; - $config->setLevel(join ' ', @_); - my %rnodes = $config->listNodeStatus(); - if (scalar(keys %rnodes) > 0) { - my @rn = keys %rnodes; - - #if node.val exists and ct == 0 w/o def or ct ==1 w/ def - my $leaf = 0; - if ($rnodes{'def'}) { - if ($#rn == 1 && $rnodes{'node.val'}) { - $leaf = 1; - } - } else { - if ($#rn == 0 && $rnodes{'node.val'}) { - $leaf = 1; - } - } - - if ($leaf == 1) { - # this is a leaf value-node - displayValues([ @_ ], '', $_[$#_]); - } else { - displayChildren(\%rnodes, [ @_ ], ''); - } - } else { - if (defined($config->existsOrig()) && !defined($config->exists())) { - # this is a deleted node - print 'Configuration under "' . (join ' ', @_) . "\" has been deleted\n"; - } elsif (!defined($config->getTmplPath(\@_))) { - print "Specified configuration path is not valid\n"; - } else { - print 'Configuration under "' . (join ' ', @_) . "\" is empty\n"; - } - } -} - -# @ARGV: represents the 'root' path. the output starts at this point under -# the active config. -sub outputActiveConfig { - $config = new VyattaConfig; - $config->setLevel(join ' ', @_); - displayDeletedOrigChildren([ @_ ], '', 1); -} - -1; diff --git a/scripts/VyattaIpTablesAddressFilter.pm b/scripts/VyattaIpTablesAddressFilter.pm deleted file mode 100755 index 9789fef..0000000 --- a/scripts/VyattaIpTablesAddressFilter.pm +++ /dev/null @@ -1,207 +0,0 @@ -#!/usr/bin/perl - -# Author: An-Cheng Huang -# Date: 2007 -# Description: IP tables address filter - -# **** License **** -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License version 2 as -# published by the Free Software Foundation. -# -# 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. -# -# This code was originally developed by Vyatta, Inc. -# Portions created by Vyatta are Copyright (C) 2006, 2007, 2008 Vyatta, Inc. -# All Rights Reserved. -# **** End License **** - -package VyattaIpTablesAddressFilter; - -use VyattaConfig; -use VyattaMisc; -use VyattaTypeChecker; - -my %_protocolswithports = ( - tcp => 1, - udp => 1, - 6 => 1, - 17 => 1, -); - -my %fields = ( - _srcdst => undef, - _range_start => undef, - _range_stop => undef, - _network => undef, - _address => undef, - _port => undef, - _protocol => undef, - _src_mac => undef, -); - -sub new { - my $that = shift; - my $class = ref ($that) || $that; - my $self = { - %fields, - }; - - bless $self, $class; - return $self; -} - -sub setup { - my ($self, $level) = @_; - my $config = new VyattaConfig; - - $config->setLevel("$level"); - - # setup needed parent nodes - $self->{_srcdst} = $config->returnParent(".."); - $self->{_protocol} = $config->returnValue(".. protocol"); - - # setup address filter nodes - $self->{_address} = $config->returnValue("address"); - $self->{_network} = undef; - $self->{_range_start} = undef; - $self->{_range_stop} = undef; - if (defined($self->{_address})) { - if ($self->{_address} =~ /\//) { - $self->{_network} = $self->{_address}; - $self->{_address} = undef; - } elsif ($self->{_address} =~ /^([^-]+)-([^-]+)$/) { - $self->{_range_start} = $1; - $self->{_range_stop} = $2; - $self->{_address} = undef; - } - } - - $self->{_port} = $config->returnValue("port"); - $self->{_src_mac} = $config->returnValue("mac-address"); - - return 0; -} - -sub setupOrig { - my ($self, $level) = @_; - my $config = new VyattaConfig; - - $config->setLevel("$level"); - - # setup needed parent nodes - $self->{_srcdst} = $config->returnParent(".."); - $self->{_protocol} = $config->returnOrigValue(".. protocol"); - - # setup address filter nodes - $self->{_address} = $config->returnOrigValue("address"); - $self->{_network} = undef; - $self->{_range_start} = undef; - $self->{_range_stop} = undef; - if (defined($self->{_address})) { - if ($self->{_address} =~ /\//) { - $self->{_network} = $self->{_address}; - $self->{_address} = undef; - } elsif ($self->{_address} =~ /^([^-]+)-([^-]+)$/) { - $self->{_range_start} = $1; - $self->{_range_stop} = $2; - $self->{_address} = undef; - } - } - - $self->{_port} = $config->returnOrigValue("port"); - $self->{_src_mac} = $config->returnValue("mac-address"); - - return 0; -} - -sub print { - my ($self) = @_; - - print "srcdst: $self->{_srcdst}\n" if defined $self->{_srcdst}; - print "range start: $self->{_range_start}\n" if defined $self->{_range_start}; - print "range stop: $self->{_range_stop}\n" if defined $self->{_range_stop}; - print "network: $self->{_network}\n" if defined $self->{_network}; - print "address: $self->{_address}\n" if defined $self->{_address}; - print "port: $self->{_port}\n" if defined $self->{_port}; - print "protocol: $self->{_protocol}\n" if defined $self->{_protocol}; - print "src-mac: $self->{_src_mac}\n" if defined $self->{_src_mac}; - - return 0; -} - -sub rule { - my ($self) = @_; - my $rule = ""; - my $can_use_port = 1; - - if (!defined($self->{_protocol}) - || !defined($_protocolswithports{$self->{_protocol}})) { - $can_use_port = 0; - } - - if (($self->{_srcdst} eq "source") && (defined($self->{_src_mac}))) { - # handle src mac - my $str = $self->{_src_mac}; - $str =~ s/^\!(.*)$/! $1/; - $rule .= "-m mac --mac-source $str "; - } - - # set the address filter parameters - if (defined($self->{_network})) { - my $str = $self->{_network}; - return (undef, "\"$str\" is not a valid IP subnet") - if (!VyattaTypeChecker::validateType('ipv4net_negate', $str, 1)); - $str =~ s/^\!(.*)$/! $1/; - $rule .= "--$self->{_srcdst} $str "; - } elsif (defined($self->{_address})) { - my $str = $self->{_address}; - return (undef, "\"$str\" is not a valid IP address") - if (!VyattaTypeChecker::validateType('ipv4_negate', $str, 1)); - $str =~ s/^\!(.*)$/! $1/; - $rule .= "--$self->{_srcdst} $str "; - } elsif ((defined $self->{_range_start}) && (defined $self->{_range_stop})) { - my $start = $self->{_range_start}; - my $stop = $self->{_range_stop}; - return (undef, "\"$start-$stop\" is not a valid IP range") - if (!VyattaTypeChecker::validateType('ipv4_negate', $start, 1) - || !VyattaTypeChecker::validateType('ipv4', $stop, 1)); - my $negate = ''; - if ($self->{_range_start} =~ /^!(.*)$/) { - $start = $1; - $negate = '! ' - } - if ("$self->{_srcdst}" eq "source") { - $rule .= ("-m iprange $negate--src-range $start-$self->{_range_stop} "); - } - elsif ("$self->{_srcdst}" eq "destination") { - $rule .= ("-m iprange $negate--dst-range $start-$self->{_range_stop} "); - } - } - - my ($port_str, $port_err) - = VyattaMisc::getPortRuleString($self->{_port}, $can_use_port, - ($self->{_srcdst} eq "source") ? "s" : "d", - $self->{_protocol}); - return (undef, $port_err) if (!defined($port_str)); - $rule .= $port_str; - return ($rule, undef); -} - -sub outputXmlElem { - my ($name, $value, $fh) = @_; - print $fh " <$name>$value\n"; -} - -sub outputXml { - my ($self, $prefix, $fh) = @_; - outputXmlElem("${prefix}_addr", $self->{_address}, $fh); - outputXmlElem("${prefix}_net", $self->{_network}, $fh); - outputXmlElem("${prefix}_addr_start", $self->{_range_start}, $fh); - outputXmlElem("${prefix}_addr_stop", $self->{_range_stop}, $fh); - outputXmlElem("${prefix}_port", $self->{_port}, $fh); -} - diff --git a/scripts/VyattaMisc.pm b/scripts/VyattaMisc.pm deleted file mode 100755 index 5f7b436..0000000 --- a/scripts/VyattaMisc.pm +++ /dev/null @@ -1,486 +0,0 @@ -#!/usr/bin/perl - -# Module: VyattaMisc.pm -# -# Author: Marat -# Date: 2007 -# Description: Implements miscellaneous commands - -# **** License **** -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License version 2 as -# published by the Free Software Foundation. -# -# 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. -# -# This code was originally developed by Vyatta, Inc. -# Portions created by Vyatta are Copyright (C) 2006, 2007, 2008 Vyatta, Inc. -# All Rights Reserved. -# **** End License **** - -package VyattaMisc; -require Exporter; -@ISA = qw(Exporter); -@EXPORT = qw(getNetAddIP isIpAddress is_ip_v4_or_v6); -@EXPORT_OK = qw(getNetAddIP isIpAddress is_ip_v4_or_v6); - - -use strict; - -use VyattaConfig; - -sub get_sysfs_value { - my ($intf, $name) = @_; - - open (my $statf, '<', "/sys/class/net/$intf/$name") - or die "Can't open statistics file /sys/class/net/$intf/$name"; - - my $value = <$statf>; - chomp $value if defined $value; - close $statf; - return $value; -} - -# check if interace is configured to get an IP address using dhcp -sub is_dhcp_enabled { - my ($intf, $outside_cli) = @_; - - my $config = new VyattaConfig; - if (!($outside_cli eq '')) { - $config->{_active_dir_base} = "/opt/vyatta/config/active/"; - } - - if ($intf =~ m/^eth/) { - if ($intf =~ m/(\w+)\.(\d+)/) { - $config->setLevel("interfaces ethernet $1 vif $2"); - } else { - $config->setLevel("interfaces ethernet $intf"); - } - } elsif ($intf =~ m/^br/) { - $config->setLevel("interfaces bridge $intf"); - } elsif ($intf =~ m/^bond/) { - if ($intf =~ m/(\w+)\.(\d+)/) { - $config->setLevel("interfaces bonding $1 vif $2"); - } else { - $config->setLevel("interfaces bonding $intf"); - } - } else { - # - # add other interfaces that can be configured to use dhcp above - # - return 0; - } - my @addrs = $config->returnOrigValues("address"); - foreach my $addr (@addrs) { - if (defined $addr && $addr eq "dhcp") { - return 1; - } - } - return 0; -} - -# return dhclient related files for interface -sub generate_dhclient_intf_files { - my $intf = shift; - my $dhclient_dir = '/var/lib/dhcp3/'; - - $intf =~ s/\./_/g; - my $intf_config_file = $dhclient_dir . 'dhclient_' . $intf . '.conf'; - my $intf_process_id_file = $dhclient_dir . 'dhclient_' . $intf . '.pid'; - my $intf_leases_file = $dhclient_dir . 'dhclient_' . $intf . '.leases'; - return ($intf_config_file, $intf_process_id_file, $intf_leases_file); - -} - -# getInterfacesIPadresses() returns IP addresses for the interface type passed to it -# possible type of interfaces : 'broadcast', 'pointopoint', 'multicast', 'all' -# the loopback IP address is never returned with any of the above parameters -sub getInterfacesIPadresses { - - my $interface_type = shift; - if (!($interface_type =~ m/broadcast|pointopoint|multicast|all/)) { - print STDERR "Invalid interface type specified to retrive IP addresses for\n"; - return undef; - } - my @interfaces_on_system = `ifconfig -a | awk '\$2 ~ /Link/ {print \$1}'`; - chomp @interfaces_on_system; - my @intf_ips = (); - my $intf_ips_index = 0; - foreach my $intf_system (@interfaces_on_system) { - if (!($intf_system eq 'lo')) { - my $is_intf_interface_type = 0; - if (!($interface_type eq 'all')) { - $is_intf_interface_type = - `ip link show $intf_system 2>/dev/null | grep -i $interface_type | wc -l`; - } else { - $is_intf_interface_type = 1; - } - if ($is_intf_interface_type > 0) { - $intf_ips[$intf_ips_index] = - `ip addr show $intf_system 2>/dev/null | grep inet | grep -v inet6 | awk '{print \$2}'`; - if (!($intf_ips[$intf_ips_index] eq '')){ - $intf_ips_index++; - } - } - } - } - chomp @intf_ips; - return (@intf_ips); - -} - - -sub getNetAddrIP { - my ($interface); - ($interface) = @_; - - if ($interface eq '') { - print STDERR "Error: No interface specified.\n"; - return undef; - } - - my $ifconfig_out = `ifconfig $interface`; - $ifconfig_out =~ /inet addr:(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/; - my $ip = $1; - if ($ip eq '') { - print STDERR "Error: Unable to determine IP address for interface \'$interface\'.\n"; - return undef; - } - - $ifconfig_out =~ /Mask:(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/; - my $netmask = $1; - if ($netmask eq '') { - print STDERR "Error: Unable to determine netmask for interface \'$interface\'.\n"; - return undef; - } - - use NetAddr::IP; # This library is available via libnetaddr-ip-perl.deb - my $naip = new NetAddr::IP($ip, $netmask); - return $naip; -} - -sub is_ip_v4_or_v6 { - my $addr = shift; - - my $ip = NetAddr::IP->new($addr); - if (defined $ip && $ip->version() == 4) { - # - # the call to IP->new() will accept 1.1 and consider - # it to be 1.1.0.0, so add a check to force all - # 4 octets to be defined - # - if ($addr !~ /\d+\.\d+\.\d+\.\d+/) { - return undef; - } - return 4; - } - $ip = NetAddr::IP->new6($addr); - if (defined $ip && $ip->version() == 6) { - return 6; - } - - return undef; -} - -sub isIpAddress { - my $ip = shift; - - $_ = $ip; - if ( ! /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) { - return 0; - } - else { - my @ips = split /\./, $ip; - my $octet = 0; - my $counter = 0; - - foreach $octet (@ips) { - if (($octet < 0) || ($octet > 255)) { return 0; } - if (($counter == 0) && ($octet < 1)) { return 0; } - $counter++; - } - } - - return 1; -} - -sub isClusterIP { - my ($vc, $ip) = @_; - - if (!(defined($ip))) { - return 0; - } - - my @cluster_groups = $vc->listNodes('cluster group'); - foreach my $cluster_group (@cluster_groups) { - my @services = $vc->returnValues("cluster group $cluster_group service"); - foreach my $service (@services) { - if ($ip eq $service) { - return 1; - } - } - } - - return 0; -} - -sub remove_ip_prefix { - my @addr_nets = @_; - - s/\/\d+$// for @addr_nets; - return @addr_nets; -} - -sub is_ip_in_list { - my ($ip, @list) = @_; - - if (!defined($ip) || scalar(@list) == 0) { - return 0; - } - - @list = remove_ip_prefix(@list); - my %list_hash = map { $_ => 1 } @list; - if (defined($list_hash{$ip})) { - return 1; - } else { - return 0; - } -} - -sub get_eth_ip_addrs { - my ($vc, $eth_path) = @_; - - my @addrs = (); - my @virt_addrs = (); - - $vc->setLevel("interfaces ethernet $eth_path"); - @addrs = $vc->returnValues("address"); - - # - # check for VIPs - # - $vc->setLevel("interfaces ethernet $eth_path vrrp vrrp-group"); - my @vrrp_groups = $vc->listNodes(); - foreach my $group (@vrrp_groups) { - $vc->setLevel("interfaces ethernet $eth_path vrrp vrrp-group $group"); - @virt_addrs = $vc->returnValues("virtual-address"); - } - return (@addrs, @virt_addrs); -} - -sub get_tun_ip_addrs { - my ($vc, $tun_path) = @_; - - my @addrs = (); - my @virt_addrs = (); - - $vc->setLevel("interfaces tunnel $tun_path"); - @addrs = $vc->returnValues("address"); - - # - # check for VIPs - # - $vc->setLevel("interfaces tunnel $tun_path vrrp vrrp-group"); - my @vrrp_groups = $vc->listNodes(); - foreach my $group (@vrrp_groups) { - $vc->setLevel("interfaces tunnel $tun_path vrrp vrrp-group $group"); - @virt_addrs = $vc->returnValues("virtual-address"); - } - return (@addrs, @virt_addrs); -} - -sub get_serial_ip_addrs { - # - # Todo when serial is added - # -} - -sub isIPinInterfaces { - my ($vc, $ip_addr, @interfaces) = @_; - - if (!(defined($ip_addr))) { - return 0; - } - - foreach my $intf (@interfaces) { - # regular ethernet - if ($intf =~ m/^eth\d+$/) { - my @addresses = get_eth_ip_addrs($vc, $intf); - if (is_ip_in_list($ip_addr, @addresses)) { - return 1; - } - } - # ethernet vlan - if ($intf =~ m/^eth(\d+).(\d+)$/) { - my $eth = "eth$1"; - my $vif = $2; - my @addresses = get_eth_ip_addrs($vc, "$eth vif $vif"); - if (is_ip_in_list($ip_addr, @addresses)) { - return 1; - } - } - # tunnel - if ($intf =~ m/^tun\d+$/) { - my @addresses = get_tun_ip_addrs($vc, $intf); - if (is_ip_in_list($ip_addr, @addresses)) { - return 1; - } - } - # serial - if ($intf =~ m/^wan(\d+).(\d+)$/) { - my @addresses = get_serial_ip_addrs($vc, $intf); - if (is_ip_in_list($ip_addr, @addresses)) { - return 1; - } - } - } - - return 0; -} - -sub isClusteringEnabled { - my ($vc) = @_; - - if ($vc->exists('cluster')) { - return 1; - } else { - return 0; - } -} - -# $str: string representing a port number -# returns ($success, $err) -# $success: 1 if success. otherwise undef -# $err: error message if failure. otherwise undef -sub isValidPortNumber { - my $str = shift; - return (undef, "\"$str\" is not a valid port number") - if (!($str =~ /^\d+$/)); - return (undef, "invalid port \"$str\" (must be between 1 and 65535)") - if ($str < 1 || $str > 65535); - return (1, undef); -} - -# $str: string representing a port range -# $sep: separator for range -# returns ($success, $err) -# $success: 1 if success. otherwise undef -# $err: error message if failure. otherwise undef -sub isValidPortRange { - my $str = shift; - my $sep = shift; - return (undef, "\"$str\" is not a valid port range") - if (!($str =~ /^(\d+)$sep(\d+)$/)); - my ($start, $end) = ($1, $2); - my ($success, $err) = isValidPortNumber($start); - return (undef, $err) if (!defined($success)); - ($success, $err) = isValidPortNumber($end); - return (undef, $err) if (!defined($success)); - return (undef, "invalid port range ($end is not greater than $start)") - if ($end <= $start); - return (1, undef); -} - -my %port_name_hash_tcp = (); -my %port_name_hash_udp = (); -sub buildPortNameHash { - open(IF, ") { - s/#.*$//; - my $is_tcp = /\d\/tcp\s/; - my @names = grep (!/\//, (split /\s/)); - foreach my $name (@names) { - if ($is_tcp) { - $port_name_hash_tcp{$name} = 1; - } else { - $port_name_hash_udp{$name} = 1; - } - } - } - close IF; - return 1; -} - -# $str: string representing a port name -# $proto: protocol to check -# returns ($success, $err) -# $success: 1 if success. otherwise undef -# $err: error message if failure. otherwise undef -sub isValidPortName { - my $str = shift; - my $proto = shift; - return (undef, "\"\" is not a valid port name for protocol \"$proto\"") - if ($str eq ''); - buildPortNameHash() if ((keys %port_name_hash_tcp) == 0); - return (1, undef) if ($proto eq 'tcp' && defined($port_name_hash_tcp{$str})); - return (1, undef) if ($proto eq '6' && defined($port_name_hash_tcp{$str})); - return (1, undef) if ($proto eq 'udp' && defined($port_name_hash_udp{$str})); - return (1, undef) if ($proto eq '17' && defined($port_name_hash_udp{$str})); - return (undef, "\"$str\" is not a valid port name for protocol \"$proto\""); -} - -sub getPortRuleString { - my $port_str = shift; - my $can_use_port = shift; - my $prefix = shift; - my $proto = shift; - my $negate = ''; - if ($port_str =~ /^!(.*)$/) { - $port_str = $1; - $negate = '! '; - } - $port_str =~ s/-/:/g; - - my $num_ports = 0; - my @port_specs = split /,/, $port_str; - foreach my $port_spec (@port_specs) { - my ($success, $err) = (undef, undef); - if ($port_spec =~ /:/) { - ($success, $err) = isValidPortRange($port_spec, ':'); - if (defined($success)) { - $num_ports += 2; - next; - } else { - return (undef, $err); - } - } - if ($port_spec =~ /^\d/) { - ($success, $err) = isValidPortNumber($port_spec); - if (defined($success)) { - $num_ports += 1; - next; - } else { - return (undef, $err); - } - } - ($success, $err) = isValidPortName($port_spec, $proto); - if (defined($success)) { - $num_ports += 1; - next; - } else { - return (undef, $err); - } - } - - my $rule_str = ''; - if (($num_ports > 0) && (!$can_use_port)) { - return (undef, "ports can only be specified when protocol is \"tcp\" " - . "or \"udp\" (currently \"$proto\")"); - } - if ($num_ports > 15) { - return (undef, "source/destination port specification only supports " - . "up to 15 ports (port range counts as 2)"); - } - if ($num_ports > 1) { - $rule_str = " -m multiport --${prefix}ports ${negate}${port_str}"; - } elsif ($num_ports > 0) { - $rule_str = " --${prefix}port ${negate}${port_str}"; - } - - return ($rule_str, undef); -} - -return 1; diff --git a/scripts/VyattaTypeChecker.pm b/scripts/VyattaTypeChecker.pm deleted file mode 100755 index f77664f..0000000 --- a/scripts/VyattaTypeChecker.pm +++ /dev/null @@ -1,228 +0,0 @@ -#!/usr/bin/perl - -# Author: An-Cheng Huang -# Date: 2007 -# Description: Type checking script - -# **** License **** -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License version 2 as -# published by the Free Software Foundation. -# -# 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. -# -# This code was originally developed by Vyatta, Inc. -# Portions created by Vyatta are Copyright (C) 2006, 2007, 2008 Vyatta, Inc. -# All Rights Reserved. -# **** End License **** - -# Perl module for type validation. -# Usage 1: validate a value of a specific type. -# use VyattaTypeChecker; -# ... -# if (VyattaTypeChecker::validateType('ipv4', '1.1.1.1')) { -# # valid -# ... -# } else { -# # not valie -# ... -# } -# -# Usage 2: find the type of a value (from a list of candidates), returns -# undef if the value is not valid for any of the candidates. -# $valtype = VyattaTypeChecker::findType('1.1.1.1', 'ipv4', 'ipv6'); -# if (!defined($valtype)) { -# # neither ipv4 nor ipv6 -# ... -# } else { -# if ($valtype eq 'ipv4') { -# ... -# } else { -# ... -# } -# } - -package VyattaTypeChecker; - -use strict; - -my %type_handler = ( - 'ipv4' => \&validate_ipv4, - 'ipv4net' => \&validate_ipv4net, - 'ipv4range' => \&validate_ipv4range, - 'ipv4_negate' => \&validate_ipv4_negate, - 'ipv4net_negate' => \&validate_ipv4net_negate, - 'ipv4range_negate' => \&validate_ipv4range_negate, - 'iptables4_addr' => \&validate_iptables4_addr, - 'protocol' => \&validate_protocol, - 'protocol_negate' => \&validate_protocol_negate, - 'macaddr' => \&validate_macaddr, - 'macaddr_negate' => \&validate_macaddr_negate, - 'ipv6' => \&validate_ipv6, - ); - -sub validate_ipv4 { - $_ = shift; - return 0 if (!/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/); - return 0 if ($1 > 255 || $2 > 255 || $3 > 255 || $4 > 255); - return 1; -} - -sub validate_ipv4net { - $_ = shift; - return 0 if (!/^(\d+)\.(\d+)\.(\d+)\.(\d+)\/(\d+)$/); - return 0 if ($1 > 255 || $2 > 255 || $3 > 255 || $4 > 255 || $5 > 32); - return 1; -} - -sub validate_ipv4range { - $_ = shift; - return 0 if (!/^([^-]+)-([^-]+)$/); - my ($a1, $a2) = ($1, $2); - return 0 if (!validate_ipv4($a1) || !validate_ipv4($a2)); - return 1; -} - -sub validate_ipv4_negate { - my $value = shift; - if ($value =~ m/^\!(.*)$/) { - $value = $1; - } - return validate_ipv4($value); -} - -sub validate_ipv4net_negate { - my $value = shift; - if ($value =~ m/^\!(.*)$/) { - $value = $1; - } - return validate_ipv4net($value); -} - -sub validate_ipv4range_negate { - my $value = shift; - if ($value =~ m/^\!(.*)$/) { - $value = $1; - } - return validate_ipv4range($value); -} - -sub validate_iptables4_addr { - my $value = shift; - return 0 if (!validate_ipv4_negate($value) - && !validate_ipv4net_negate($value) - && !validate_ipv4range_negate($value)); - return 1; -} - -sub validate_protocol { - my $value = shift; - $value = lc $value; - return 1 if ($value eq 'all'); - if (!open(IN, ") { - s/^([^#]*)#.*$/$1/; - if ((/^$value\s/) || (/^\S+\s+$value\s/)) { - $ret = 1; - last; - } - } - close IN; - return $ret; -} - -sub validate_protocol_negate { - my $value = shift; - if ($value =~ m/^\!(.*)$/) { - $value = $1; - } - return validate_protocol($value); -} - -sub validate_macaddr { - my $value = shift; - $value = lc $value; - my $byte = '[0-9a-f]{2}'; - return 1 if ($value =~ /^$byte(:$byte){5}$/); -} - -sub validate_macaddr_negate { - my $value = shift; - if ($value =~ m/^\!(.*)$/) { - $value = $1; - } - return validate_macaddr($value); -} - -# IPv6 syntax definition -my $RE_IPV4_BYTE = '((25[0-5])|(2[0-4][0-9])|([01][0-9][0-9])|([0-9]{1,2}))'; -my $RE_IPV4 = "$RE_IPV4_BYTE(\.$RE_IPV4_BYTE){3}"; -my $RE_H16 = '([a-fA-F0-9]{1,4})'; -my $RE_H16_COLON = "($RE_H16:)"; -my $RE_LS32 = "(($RE_H16:$RE_H16)|($RE_IPV4))"; -my $RE_IPV6_P1 = "($RE_H16_COLON)\{6\}$RE_LS32"; -my $RE_IPV6_P2 = "::($RE_H16_COLON)\{5\}$RE_LS32"; -my $RE_IPV6_P3 = "($RE_H16)?::($RE_H16_COLON)\{4\}$RE_LS32"; -my $RE_IPV6_P4 = "(($RE_H16_COLON)\{0,1\}$RE_H16)?" - . "::($RE_H16_COLON)\{3\}$RE_LS32"; -my $RE_IPV6_P5 = "(($RE_H16_COLON)\{0,2\}$RE_H16)?" - . "::($RE_H16_COLON)\{2\}$RE_LS32"; -my $RE_IPV6_P6 = "(($RE_H16_COLON)\{0,3\}$RE_H16)?" - . "::($RE_H16_COLON)\{1\}$RE_LS32"; -my $RE_IPV6_P7 = "(($RE_H16_COLON)\{0,4\}$RE_H16)?::$RE_LS32"; -my $RE_IPV6_P8 = "(($RE_H16_COLON)\{0,5\}$RE_H16)?::$RE_H16"; -my $RE_IPV6_P9 = "(($RE_H16_COLON)\{0,6\}$RE_H16)?::"; -my $RE_IPV6 = "($RE_IPV6_P1)|($RE_IPV6_P2)|($RE_IPV6_P3)|($RE_IPV6_P4)" - . "|($RE_IPV6_P5)|($RE_IPV6_P6)|($RE_IPV6_P7)|($RE_IPV6_P8)" - . "|($RE_IPV6_P9)"; - -sub validate_ipv6 { - $_ = shift; - return 0 if (!/^$RE_IPV6$/); - return 1; -} - -sub validateType { - my ($type, $value, $quiet) = @_; - if (!defined($type) || !defined($value)) { - return 0; - } - if (!defined($type_handler{$type})) { - print "type \"$type\" not defined\n" if (!defined($quiet)); - return 0; - } - if (!&{$type_handler{$type}}($value)) { - print "\"$value\" is not a valid value of type \"$type\"\n" - if (!defined($quiet)); - return 0; - } - - return 1; -} - -sub findType { - my ($value, @candidates) = @_; - if (!defined($value) || ((scalar @candidates) < 1)) { - return undef; - } - foreach my $type (@candidates) { - if (!defined($type_handler{$type})) { - next; - } - if (&{$type_handler{$type}}($value)) { - # the first valid type is returned - return $type; - } - } - return undef; -} - -1; - diff --git a/scripts/vyatta-check-typeless-node.pl b/scripts/vyatta-check-typeless-node.pl old mode 100644 new mode 100755 index 65a7408..1780a5e --- a/scripts/vyatta-check-typeless-node.pl +++ b/scripts/vyatta-check-typeless-node.pl @@ -1,7 +1,7 @@ #!/usr/bin/perl use lib "/opt/vyatta/share/perl5/"; -use VyattaConfig; -use VyattaMisc; +use Vyatta::Config; +use Vyatta::Misc; use Getopt::Long; ## Check if a typeless node exists @@ -9,7 +9,7 @@ use Getopt::Long; # i.e. $VAR(./node/) always expands to true. Once bug 2525 is properly # fixed, this can go away my $node = shift; -my $config = new VyattaConfig; +my $config = new Vyatta::Config; if ($config->exists("$node")) { exit 0; diff --git a/scripts/vyatta-cli-expand-var.pl b/scripts/vyatta-cli-expand-var.pl index 2691615..f690f0b 100755 --- a/scripts/vyatta-cli-expand-var.pl +++ b/scripts/vyatta-cli-expand-var.pl @@ -21,7 +21,7 @@ use strict; use lib "/opt/vyatta/share/perl5/"; -use VyattaConfig; +use Vyatta::Config; # expand a variable reference if ($#ARGV != 0) { @@ -59,7 +59,7 @@ if (/\@/) { exit 1; } -my $config = new VyattaConfig; +my $config = new Vyatta::Config; my $path_str = join ' ', (split /\//); my $val_str = ""; if ($multi_val) { diff --git a/scripts/vyatta-config-gen-sets.pl b/scripts/vyatta-config-gen-sets.pl old mode 100644 new mode 100755 index b9b083e..2fe4ac6 --- a/scripts/vyatta-config-gen-sets.pl +++ b/scripts/vyatta-config-gen-sets.pl @@ -25,7 +25,7 @@ use strict; use lib "/opt/vyatta/share/perl5/"; -use VyattaConfigLoad; +use Vyatta::ConfigLoad; my $conf_file = '/opt/vyatta/etc/config/config.boot'; @@ -33,7 +33,7 @@ $conf_file = $ARGV[0] if defined $ARGV[0]; # get a list of all config statement in the startup config file # (sorted by rank). -my @all_nodes = VyattaConfigLoad::getStartupConfigStatements($conf_file); +my @all_nodes = Vyatta::ConfigLoad::getStartupConfigStatements($conf_file); if (scalar(@all_nodes) == 0) { # no config statements exit 1; diff --git a/scripts/vyatta-config-loader.pl b/scripts/vyatta-config-loader.pl index 29b6bcd..856799a 100755 --- a/scripts/vyatta-config-loader.pl +++ b/scripts/vyatta-config-loader.pl @@ -24,7 +24,7 @@ use strict; use lib "/opt/vyatta/share/perl5/"; -use VyattaConfigLoad; +use Vyatta::ConfigLoad; umask 0002; @@ -47,7 +47,7 @@ sub restore_fds { # get a list of all config statement in the startup config file # (sorted by rank). -my @all_nodes = VyattaConfigLoad::getStartupConfigStatements($ARGV[0]); +my @all_nodes = Vyatta::ConfigLoad::getStartupConfigStatements($ARGV[0]); if (scalar(@all_nodes) == 0) { # no config statements restore_fds(); diff --git a/scripts/vyatta-find-type.pl b/scripts/vyatta-find-type.pl index 3c9ccc6..9621a58 100755 --- a/scripts/vyatta-find-type.pl +++ b/scripts/vyatta-find-type.pl @@ -21,7 +21,7 @@ use strict; use lib "/opt/vyatta/share/perl5/"; -use VyattaTypeChecker; +use Vyatta::TypeChecker; # find the type of a value (from a list of candidates) if ($#ARGV < 1) { @@ -29,7 +29,7 @@ if ($#ARGV < 1) { exit 1; } -if (my $type = VyattaTypeChecker::findType(@ARGV)) { +if (my $type = Vyatta::TypeChecker::findType(@ARGV)) { # type found print "$type"; exit 0; diff --git a/scripts/vyatta-interfaces.pl b/scripts/vyatta-interfaces.pl old mode 100644 new mode 100755 index 6453717..31b7d8d --- a/scripts/vyatta-interfaces.pl +++ b/scripts/vyatta-interfaces.pl @@ -31,8 +31,8 @@ # use lib "/opt/vyatta/share/perl5/"; -use VyattaConfig; -use VyattaMisc; +use Vyatta::Config; +use Vyatta::Misc; use Getopt::Long; use POSIX; @@ -126,7 +126,7 @@ sub dhcp_conf_header { sub is_address_enabled { my $intf = shift; - my $config = new VyattaConfig; + my $config = new Vyatta::Config; ## FIXME this is name based madness find a better way ## so we don't have to redo with each interface type! @@ -160,20 +160,20 @@ sub is_address_enabled { } sub get_hostname { - my $config = new VyattaConfig; + my $config = new Vyatta::Config; $config->setLevel("system"); return $config->returnValue("host-name"); } sub is_domain_name_set { - my $config = new VyattaConfig; + my $config = new Vyatta::Config; $config->setLevel("system"); return $config->returnValue("domain-name"); } sub get_mtu { my $intf = shift; - my $config = new VyattaConfig; + my $config = new Vyatta::Config; $config->setLevel("interfaces $intf"); return $config->returnValue("mtu"); } @@ -224,7 +224,7 @@ sub is_intf_disabled { exit 1; } - my $config = new VyattaConfig; + my $config = new Vyatta::Config; $config->setLevel("$intf_cli_path"); if ($intf =~ m/^br/) { @@ -245,7 +245,7 @@ sub is_intf_disabled { sub run_dhclient { my $intf = shift; - my ($intf_config_file, $intf_process_id_file, $intf_leases_file) = VyattaMisc::generate_dhclient_intf_files($intf); + my ($intf_config_file, $intf_process_id_file, $intf_leases_file) = Vyatta::Misc::generate_dhclient_intf_files($intf); dhcp_update_config($intf_config_file, $intf); if (!(is_intf_disabled($intf))) { my $cmd = "$dhcp_daemon -q -nw -cf $intf_config_file -pf $intf_process_id_file -lf $intf_leases_file $intf 2> /dev/null &"; @@ -258,7 +258,7 @@ sub run_dhclient { sub stop_dhclient { my $intf = shift; if (!(is_intf_disabled($intf))) { - my ($intf_config_file, $intf_process_id_file, $intf_leases_file) = VyattaMisc::generate_dhclient_intf_files($intf); + my ($intf_config_file, $intf_process_id_file, $intf_leases_file) = Vyatta::Misc::generate_dhclient_intf_files($intf); my $release_cmd = "$dhcp_daemon -q -cf $intf_config_file -pf $intf_process_id_file -lf $intf_leases_file -r $intf 2> /dev/null"; system ($release_cmd) == 0 or warn "stop $dhcp_daemon failed: $?\n"; @@ -387,7 +387,7 @@ sub is_valid_addr { print "Error: can't use dhcp client on loopback interface\n"; exit 1; } - if (VyattaMisc::is_dhcp_enabled($intf)) { + if (Vyatta::Misc::is_dhcp_enabled($intf)) { print "Error: dhcp already configured for $intf\n"; exit 1; } @@ -433,7 +433,7 @@ sub is_valid_addr { } } - if (VyattaMisc::is_dhcp_enabled($intf)) { + if (Vyatta::Misc::is_dhcp_enabled($intf)) { print "Error: remove dhcp before adding static addresses for $intf\n"; exit 1; } @@ -459,12 +459,12 @@ sub is_valid_addr { sub op_dhcp_command { my ($op_command, $intf) = @_; - if (!VyattaMisc::is_dhcp_enabled($intf)) { + if (!Vyatta::Misc::is_dhcp_enabled($intf)) { print "$intf is not using DHCP to get an IP address\n"; exit 1; } - my $flags = VyattaMisc::get_sysfs_value($intf, 'flags'); + my $flags = Vyatta::Misc::get_sysfs_value($intf, 'flags'); my $hex_flags = hex($flags); if (!($hex_flags & 0x1)) { print "$intf is disabled. Unable to release/renew lease\n"; diff --git a/scripts/vyatta-load-config.pl b/scripts/vyatta-load-config.pl index dfbf575..664fd2a 100755 --- a/scripts/vyatta-load-config.pl +++ b/scripts/vyatta-load-config.pl @@ -26,7 +26,7 @@ use lib "/opt/vyatta/share/perl5/"; use POSIX; use IO::Prompt; use Sys::Syslog qw(:standard :macros); -use VyattaConfigLoad; +use Vyatta::ConfigLoad; $SIG{'INT'} = 'IGNORE'; @@ -147,7 +147,7 @@ syslog("warning", "Load config [$orig_load_file] by $login"); system("$sbindir/vyatta_config_migrate.pl $load_file"); print "Loading config file $load_file...\n"; -my %cfg_hier = VyattaConfigLoad::loadConfigHierarchy($load_file); +my %cfg_hier = Vyatta::ConfigLoad::loadConfigHierarchy($load_file); if (scalar(keys %cfg_hier) == 0) { print "The specified file does not contain any configuration.\n"; print "Do you want to remove everything in the running configuration? [no] "; @@ -158,7 +158,7 @@ if (scalar(keys %cfg_hier) == 0) { } } -my %cfg_diff = VyattaConfigLoad::getConfigDiff(\%cfg_hier); +my %cfg_diff = Vyatta::ConfigLoad::getConfigDiff(\%cfg_hier); my @delete_list = @{$cfg_diff{'delete'}}; my @set_list = @{$cfg_diff{'set'}}; diff --git a/scripts/vyatta-output-config.pl b/scripts/vyatta-output-config.pl index 05bdc4c..e47f718 100755 --- a/scripts/vyatta-output-config.pl +++ b/scripts/vyatta-output-config.pl @@ -20,20 +20,20 @@ # **** End License **** use strict; -use lib "/opt/vyatta/share/perl5/"; -use VyattaConfigOutput; +use lib "/opt/vyatta/share/perl5"; +use Vyatta::Config::Output; if ($ARGV[0] eq '-all') { shift; - VyattaConfigOutput::set_show_all(1); + set_show_all(1); } if ($ARGV[0] eq '-active') { shift; - VyattaConfigOutput::set_hide_password(1); - VyattaConfigOutput::outputActiveConfig(@ARGV); + set_hide_password(1); + outputActiveConfig(@ARGV); } else { - VyattaConfigOutput::outputNewConfig(@ARGV); + outputNewConfig(@ARGV); } exit 0; diff --git a/scripts/vyatta-save-config.pl b/scripts/vyatta-save-config.pl index 2c02766..f33a693 100755 --- a/scripts/vyatta-save-config.pl +++ b/scripts/vyatta-save-config.pl @@ -20,8 +20,8 @@ # **** End License **** use strict; -use lib "/opt/vyatta/share/perl5/"; -use VyattaConfigOutput; +use lib "/opt/vyatta/share/perl5"; +use Vyatta::Config::Output; my $etcdir = "/opt/vyatta/etc"; my $bootpath = $etcdir . "/config"; @@ -84,8 +84,8 @@ if ($mode eq 'local') { } select SAVE; -VyattaConfigOutput::set_show_all(1); -VyattaConfigOutput::outputActiveConfig(); +set_show_all(1); +outputActiveConfig(); print $version_str; close SAVE; select STDOUT; diff --git a/scripts/vyatta-validate-type.pl b/scripts/vyatta-validate-type.pl index eecc024..f180489 100755 --- a/scripts/vyatta-validate-type.pl +++ b/scripts/vyatta-validate-type.pl @@ -21,7 +21,7 @@ use strict; use lib "/opt/vyatta/share/perl5/"; -use VyattaTypeChecker; +use Vyatta::TypeChecker; # validate a value of a specific type if ($#ARGV < 1) { @@ -35,5 +35,5 @@ if ($ARGV[0] eq '-q') { $quiet = 1; } -exit 0 if (VyattaTypeChecker::validateType($ARGV[0], $ARGV[1], $quiet)); +exit 0 if (Vyatta::TypeChecker::validateType($ARGV[0], $ARGV[1], $quiet)); exit 1; -- cgit v1.2.3