diff options
author | Christian Breunig <christian@breunig.cc> | 2024-06-30 07:37:49 +0200 |
---|---|---|
committer | Christian Breunig <christian@breunig.cc> | 2024-06-30 07:39:10 +0200 |
commit | 069bd35b3cc58e0deeae02d3a7811d29c1ccea3f (patch) | |
tree | e9697cbe7ef50908ce96a0a57e76f7d7b7bcaeb2 /lib/Vyatta | |
parent | 6f435de5a5ee165d24a11a28c5aa10b735bace03 (diff) | |
download | vyatta-cfg-069bd35b3cc58e0deeae02d3a7811d29c1ccea3f.tar.gz vyatta-cfg-069bd35b3cc58e0deeae02d3a7811d29c1ccea3f.zip |
T6527: remove legacy Perl library components
Diffstat (limited to 'lib/Vyatta')
-rwxr-xr-x | lib/Vyatta/Config.pm | 751 | ||||
-rwxr-xr-x | lib/Vyatta/ConfigOutput.pm | 482 | ||||
-rw-r--r-- | lib/Vyatta/File.pm | 71 | ||||
-rwxr-xr-x | lib/Vyatta/Interface.pm | 521 | ||||
-rwxr-xr-x | lib/Vyatta/Misc.pm | 588 | ||||
-rwxr-xr-x | lib/Vyatta/TypeChecker.pm | 339 | ||||
-rw-r--r-- | lib/Vyatta/ioctl.pm | 67 |
7 files changed, 0 insertions, 2819 deletions
diff --git a/lib/Vyatta/Config.pm b/lib/Vyatta/Config.pm deleted file mode 100755 index 1469994..0000000 --- a/lib/Vyatta/Config.pm +++ /dev/null @@ -1,751 +0,0 @@ -# Author: Vyatta <eng@vyatta.com> -# 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 File::Find; - -use lib '/opt/vyatta/share/perl5'; -use Cstore; - -my %fields = ( - _level => undef, - _cstore => undef, -); - -sub new { - my ($that, $level) = @_; - my $class = ref ($that) || $that; - my $self = { - %fields, - }; - bless $self, $class; - $self->{_level} = $level if defined($level); - $self->{_cstore} = new Cstore(); - return $self; -} - -sub get_path_comps { - my ($self, $pstr) = @_; - $pstr = '' if (!defined($pstr)); - $pstr = "$self->{_level} $pstr" if (defined($self->{_level})); - $pstr =~ s/^\s+//; - $pstr =~ s/\s+$//; - my @path_comps = split /\s+/, $pstr; - return \@path_comps; -} - -############################################################ -# low-level API functions that use the cstore library directly. -# they are either new functions or old ones that have been -# converted to use cstore. -############################################################ - -###### -# observers of current working config or active config during a commit. -# * MOST users of this API should use these functions. -# * these functions MUST NOT worry about the "deactivated" state, i.e., -# deactivated nodes are equivalent to having been deleted for these -# functions. in other words, these functions are NOT "deactivate-aware". -# * functions that can be used to observe "active config" can be used -# outside a commit as well (only when observing active config, of course). -# -# note: these functions accept a third argument "$include_deactivated", but -# it is for error checking purposes to ensure that all legacy -# invocations have been fixed. the functions MUST NOT be called -# with this argument. -my $DIE_DEACT_MSG = 'This function is NOT deactivate-aware'; - -## exists("path to node") -# Returns true if specified node exists in working config. -sub exists { - my ($self, $path, $include_deactivated) = @_; - die $DIE_DEACT_MSG if (defined($include_deactivated)); - return 1 - if ($self->{_cstore}->cfgPathExists($self->get_path_comps($path), undef)); - return; # note: this return is needed. can't just return the return value - # of the above function since some callers expect "undef" - # as false. -} - -## existsOrig("path to node") -# Returns true if specified node exists in active config. -sub existsOrig { - my ($self, $path, $include_deactivated) = @_; - die $DIE_DEACT_MSG if (defined($include_deactivated)); - return 1 - if ($self->{_cstore}->cfgPathExists($self->get_path_comps($path), 1)); - return; # note: this return is needed. -} - -## isDefault("path to node") -# Returns true if specified node is "default" in working config. -sub isDefault { - my ($self, $path) = @_; - return 1 - if ($self->{_cstore}->cfgPathDefault($self->get_path_comps($path), undef)); - return; # note: this return is needed. -} - -## isDefaultOrig("path to node") -# Returns true if specified node is "default" in active config. -sub isDefaultOrig { - my ($self, $path) = @_; - return 1 - if ($self->{_cstore}->cfgPathDefault($self->get_path_comps($path), 1)); - return; # note: this return is needed. -} - -## listNodes("level") -# return array of all child nodes at "level" in working config. -sub listNodes { - my ($self, $path, $include_deactivated) = @_; - die $DIE_DEACT_MSG if (defined($include_deactivated)); - my $ref = $self->{_cstore}->cfgPathGetChildNodes( - $self->get_path_comps($path), undef); - return @{$ref}; -} - -## listOrigNodes("level") -# return array of all child nodes at "level" in active config. -sub listOrigNodes { - my ($self, $path, $include_deactivated) = @_; - die $DIE_DEACT_MSG if (defined($include_deactivated)); - my $ref = $self->{_cstore}->cfgPathGetChildNodes( - $self->get_path_comps($path), 1); - return @{$ref}; -} - -## returnValue("node") -# return value of specified single-value node in working config. -# return undef if fail to get value (invalid node, node doesn't exist, -# not a single-value node, etc.). -sub returnValue { - my ($self, $path, $include_deactivated) = @_; - die $DIE_DEACT_MSG if (defined($include_deactivated)); - return $self->{_cstore}->cfgPathGetValue($self->get_path_comps($path), - undef); -} - -## returnOrigValue("node") -# return value of specified single-value node in active config. -# return undef if fail to get value (invalid node, node doesn't exist, -# not a single-value node, etc.). -sub returnOrigValue { - my ($self, $path, $include_deactivated) = @_; - die $DIE_DEACT_MSG if (defined($include_deactivated)); - return $self->{_cstore}->cfgPathGetValue($self->get_path_comps($path), 1); -} - -## returnValues("node") -# return array of values of specified multi-value node in working config. -# return empty array if fail to get value (invalid node, node doesn't exist, -# not a multi-value node, etc.). -sub returnValues { - my ($self, $path, $include_deactivated) = @_; - die $DIE_DEACT_MSG if (defined($include_deactivated)); - my $ref = $self->{_cstore}->cfgPathGetValues($self->get_path_comps($path), - undef); - return @{$ref}; -} - -## returnOrigValues("node") -# return array of values of specified multi-value node in active config. -# return empty array if fail to get value (invalid node, node doesn't exist, -# not a multi-value node, etc.). -sub returnOrigValues { - my ($self, $path, $include_deactivated) = @_; - die $DIE_DEACT_MSG if (defined($include_deactivated)); - my $ref = $self->{_cstore}->cfgPathGetValues($self->get_path_comps($path), - 1); - return @{$ref}; -} - -## sessionChanged() -# return whether the config session has uncommitted changes -sub sessionChanged { - my ($self) = @_; - return $self->{_cstore}->sessionChanged(); -} - -## inSession() -# returns whether in a config session -sub inSession { - my ($self) = @_; - return $self->{_cstore}->inSession(); -} - -## loadFile() -# "load" the specified file -sub loadFile { - my ($self, $file) = @_; - return $self->{_cstore}->loadFile($file); -} - -###### -# observers of the "effective" config. -# they can be used -# (1) outside a config session (e.g., op mode, daemons, callbacks, etc.). -# OR -# (2) during a config session -# -# HOWEVER, NOTE that the definition of "effective" is different under these -# two scenarios. -# (1) when used outside a config session, "effective" == "active". -# in other words, in such cases the effective config is the same -# as the running config. -# -# (2) when used during a config session, a config path (leading to either -# a "node" or a "value") is "effective" if it is "in effect" at the -# time when these observers are called. more detailed info can be -# found in the library code. -# -# originally, these functions are exclusively for use during config -# sessions. however, for some usage scenarios, it is useful to have a set -# of API functions that can be used both during and outside config -# sessions. therefore, definition (1) is added above for convenience. -# -# for example, a developer can use these functions in a script that can -# be used both during a commit action and outside config mode, as long as -# the developer is clearly aware of the difference between the above two -# definitions. -# -# note that when used outside a config session (i.e., definition (1)), -# these functions are equivalent to the observers for the "active" config. -# -# to avoid any confusiton, when possible (e.g., in a script that is -# exclusively used in op mode), developers should probably use those -# "active" observers explicitly when outside a config session instead -# of these "effective" observers. -# -# it is also important to note that when used outside a config session, -# due to race conditions, it is possible that the "observed" active config -# becomes out-of-sync with the config that is actually "in effect". -# specifically, this happens when two things occur simultaneously: -# (a) an observer function is called from outside a config session. -# AND -# (b) someone invokes "commit" inside a config session (any session). -# -# this is because "commit" only updates the active config at the end after -# all commit actions have been executed, so before the update happens, -# some config nodes have already become "effective" but are not yet in the -# "active config" and therefore are not observed by these functions. -# -# note that this is only a problem when the caller is outside config mode. -# in such cases, the caller (which could be an op-mode command, a daemon, -# a callback script, etc.) already must be able to handle config changes -# that can happen at any time. if "what's configured" is more important, -# using the "active config" should be fine as long as it is relatively -# up-to-date. if the actual "system state" is more important, then the -# caller should probably just check the system state in the first place -# (instead of using these config observers). - -## isEffective("path") -# return whether "path" is in "active" config when used outside config -# session, -# OR -# return whether "path" is "effective" during current commit. -# see above discussion about the two different definitions. -# -# "effective" means the path is in effect, i.e., any of the following is true: -# (1) active && working -# path is in both active and working configs, i.e., unchanged. -# (2) !active && working && committed -# path is not in active, has been set in working, AND has already -# been committed, i.e., "commit" has already processed the -# addition/update of the path. -# (3) active && !working && !committed -# path is in active, has been deleted from working, AND -# has NOT been committed yet, i.e., "commit" (per priority) has not -# processed the deletion of the path yet (or has processed it but -# the action failed). -# -# note: during commit, deactivate has the same effect as delete. so as -# far as this function (and any other commit observer functions) is -# concerned, deactivated nodes don't exist. -sub isEffective { - my ($self, $path) = @_; - return 1 - if ($self->{_cstore}->cfgPathEffective($self->get_path_comps($path))); - return; # note: this return is needed. -} - -## isActive("path") -# XXX this is the original API function. name is confusing ("active" could -# be confused with "orig") but keep it for compatibility. -# just call isEffective(). -# also, original function accepts "$disable" flag, which doesn't make -# sense. for commit purposes, deactivated should be equivalent to -# deleted. -sub isActive { - my ($self, $path, $include_deactivated) = @_; - die $DIE_DEACT_MSG if (defined($include_deactivated)); - return $self->isEffective($path); -} - -## listEffectiveNodes("level") -# return array of "effective" child nodes at "level" during current commit. -# see isEffective() for definition of "effective". -sub listEffectiveNodes { - my ($self, $path) = @_; - my $ref = $self->{_cstore}->cfgPathGetEffectiveChildNodes( - $self->get_path_comps($path)); - return @{$ref}; -} - -## listOrigPlusComNodes("level") -# XXX this is the original API function. name is confusing (it's neither -# necessarily "orig" nor "plus") but keep it for compatibility. -# just call listEffectiveNodes(). -# also, original function accepts "$disable" flag, which doesn't make -# sense. for commit purposes, deactivated should be equivalent to -# deleted. -sub listOrigPlusComNodes { - my ($self, $path, $include_deactivated) = @_; - die $DIE_DEACT_MSG if (defined($include_deactivated)); - return $self->listEffectiveNodes($path); -} - -## returnEffectiveValue("node") -# return "effective" value of specified "node" during current commit. -sub returnEffectiveValue { - my ($self, $path) = @_; - return $self->{_cstore}->cfgPathGetEffectiveValue( - $self->get_path_comps($path)); -} - -## returnOrigPlusComValue("node") -# XXX this is the original API function. just call returnEffectiveValue(). -# also, original function accepts "$disable" flag. -sub returnOrigPlusComValue { - my ($self, $path, $include_deactivated) = @_; - die $DIE_DEACT_MSG if (defined($include_deactivated)); - return $self->returnEffectiveValue($path); -} - -## returnEffectiveValues("node") -# return "effective" values of specified "node" during current commit. -sub returnEffectiveValues { - my ($self, $path) = @_; - my $ref = $self->{_cstore}->cfgPathGetEffectiveValues( - $self->get_path_comps($path)); - return @{$ref}; -} - -## returnOrigPlusComValues("node") -# XXX this is the original API function. just call returnEffectiveValues(). -# also, original function accepts "$disable" flag. -sub returnOrigPlusComValues { - my ($self, $path, $include_deactivated) = @_; - die $DIE_DEACT_MSG if (defined($include_deactivated)); - return $self->returnEffectiveValues($path); -} - -## isDeleted("node") -# whether specified node has been deleted in working config -sub isDeleted { - my ($self, $path, $include_deactivated) = @_; - die $DIE_DEACT_MSG if (defined($include_deactivated)); - return 1 if ($self->{_cstore}->cfgPathDeleted($self->get_path_comps($path))); - return; # note: this return is needed. -} - -## listDeleted("level") -# return array of deleted nodes at specified "level" -sub listDeleted { - my ($self, $path, $include_deactivated) = @_; - die $DIE_DEACT_MSG if (defined($include_deactivated)); - my $ref = $self->{_cstore}->cfgPathGetDeletedChildNodes( - $self->get_path_comps($path)); - return @{$ref}; -} - -## returnDeletedValues("level") -# return array of deleted values of specified "multi node" -sub returnDeletedValues { - my ($self, $path) = @_; - my $ref = $self->{_cstore}->cfgPathGetDeletedValues( - $self->get_path_comps($path)); - return @{$ref}; -} - -## isAdded("node") -# whether specified node has been added in working config -sub isAdded { - my ($self, $path, $include_deactivated) = @_; - die $DIE_DEACT_MSG if (defined($include_deactivated)); - return 1 if ($self->{_cstore}->cfgPathAdded($self->get_path_comps($path))); - return; # note: this return is needed. -} - -## isChanged("node") -# whether specified node has been changed in working config -# XXX behavior is different from original implementation, which was -# inconsistent between deleted nodes and deactivated nodes. -# see cstore library source for details. -# basically, a node is "changed" if it's "added", "deleted", or -# "marked changed" (i.e., if any descendant changed). -sub isChanged { - my ($self, $path, $include_deactivated) = @_; - die $DIE_DEACT_MSG if (defined($include_deactivated)); - return 1 if ($self->{_cstore}->cfgPathChanged($self->get_path_comps($path))); - return; # note: this return is needed. -} - -## listNodeStatus("level") -# return a hash of status of child nodes at specified 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, $include_deactivated) = @_; - die $DIE_DEACT_MSG if (defined($include_deactivated)); - my $ref = $self->{_cstore}->cfgPathGetChildNodesStatus( - $self->get_path_comps($path)); - return %{$ref}; -} - -## getTmplChildren("level") -# return list of child nodes in the template hierarchy at specified level. -sub getTmplChildren { - my ($self, $path) = @_; - my $ref = $self->{_cstore}->tmplGetChildNodes($self->get_path_comps($path)); - return @{$ref}; -} - -## validateTmplPath("path") -# return whether specified path is a valid template path -sub validateTmplPath { - my ($self, $path, $validate_vals) = @_; - return 1 if ($self->{_cstore}->validateTmplPath($self->get_path_comps($path), - $validate_vals)); - return; # note: this return is needed. -} - -## parseTmplAll("path") -# return hash ref of parsed template of specified path, undef if path is -# invalid. note: if !allow_val, path must terminate at a "node", not "value". -sub parseTmplAll { - my ($self, $path, $allow_val) = @_; - my $href = $self->{_cstore}->getParsedTmpl($self->get_path_comps($path), - $allow_val); - if (defined($href)) { - # some conversions are needed - if (defined($href->{is_value}) and $href->{is_value} eq '1') { - $href->{is_value} = 1; - } - if (defined($href->{multi}) and $href->{multi} eq '1') { - $href->{multi} = 1; - } - if (defined($href->{tag}) and $href->{tag} eq '1') { - $href->{tag} = 1; - } - if (defined($href->{limit})) { - $href->{limit} = int($href->{limit}); - } - } - return $href; -} - -sub hasTmplChildren { - my ($self, $path) = @_; - my $ref = $self->{_cstore}->tmplGetChildNodes($self->get_path_comps($path)); - return if (!defined($ref)); - return (scalar(@{$ref}) > 0); -} - - -###### -# "deactivate-aware" observers of current working config or active config. -# * MUST ONLY be used by operations that NEED to distinguish between -# deactivated nodes and deleted nodes. below is the list of operations -# that are allowed to use these functions: -# * configuration output (show, save, load) -# -# operations that are not on the above list MUST NOT use these -# "deactivate-aware" functions. - -## deactivated("node") -# return whether specified node is deactivated in working config. -# note that this is different from "marked deactivated". if a node is -# "marked deactivated", then the node itself and any descendants are -# "deactivated". -sub deactivated { - my ($self, $path) = @_; - return 1 - if ($self->{_cstore}->cfgPathDeactivated($self->get_path_comps($path), - undef)); - return; # note: this return is needed. -} - -## deactivatedOrig("node") -# return whether specified node is deactivated in active config. -sub deactivatedOrig { - my ($self, $path) = @_; - return 1 - if ($self->{_cstore}->cfgPathDeactivated($self->get_path_comps($path), 1)); - return; # note: this return is needed. -} - -## returnValuesDA("node") -# DA version of returnValues() -sub returnValuesDA { - my ($self, $path) = @_; - my $ref = $self->{_cstore}->cfgPathGetValuesDA($self->get_path_comps($path), - undef); - return @{$ref}; -} - -## returnOrigValuesDA("node") -# DA version of returnOrigValues() -sub returnOrigValuesDA { - my ($self, $path) = @_; - my $ref = $self->{_cstore}->cfgPathGetValuesDA($self->get_path_comps($path), - 1); - return @{$ref}; -} - -## returnValueDA("node") -# DA version of returnValue() -sub returnValueDA { - my ($self, $path) = @_; - return $self->{_cstore}->cfgPathGetValueDA($self->get_path_comps($path), - undef); -} - -## returnOrigValueDA("node") -# DA version of returnOrigValue() -sub returnOrigValueDA { - my ($self, $path) = @_; - return $self->{_cstore}->cfgPathGetValueDA($self->get_path_comps($path), 1); -} - -## listOrigNodesDA("level") -# DA version of listOrigNodes() -sub listOrigNodesDA { - my ($self, $path) = @_; - my $ref = $self->{_cstore}->cfgPathGetChildNodesDA( - $self->get_path_comps($path), 1); - return @{$ref}; -} - -## listNodeStatusDA("level") -# DA version of listNodeStatus() -sub listNodeStatusDA { - my ($self, $path) = @_; - my $ref = $self->{_cstore}->cfgPathGetChildNodesStatusDA( - $self->get_path_comps($path)); - return %{$ref}; -} - -## returnComment("node") -# return comment of "node" in working config or undef if comment doesn't exist -sub returnComment { - my ($self, $path) = @_; - return $self->{_cstore}->cfgPathGetComment($self->get_path_comps($path), - undef); -} - -## returnOrigComment("node") -# return comment of "node" in active config or undef if comment doesn't exist -sub returnOrigComment { - my ($self, $path) = @_; - return $self->{_cstore}->cfgPathGetComment($self->get_path_comps($path), 1); -} - - -############################################################ -# high-level API functions (not using the cstore library directly) -############################################################ - -## setLevel("level") -# set the current level of config hierarchy to specified level (if defined). -# return the current level. -sub setLevel { - my ($self, $level) = @_; - $self->{_level} = $level if defined($level); - return $self->{_level}; -} - -## returnParent("..( ..)*") -# return the name of ancestor node relative to the current level. -# each level up is represented by a ".." in the argument. -sub returnParent { - my ($self, $ppath) = @_; - my @pcomps = @{$self->get_path_comps()}; - # we could call split in scalar context but that generates a warning - my @dummy = split(/\s+/, $ppath); - my $num = scalar(@dummy); - return if ($num > scalar(@pcomps)); - return $pcomps[-$num]; -} - -## parseTmpl("path") -# parse template of specified path and return ($is_multi, $is_text, $default) -# or undef if specified path is not valid. -sub parseTmpl { - my ($self, $path) = @_; - my $href = $self->parseTmplAll($path); - return if (!defined($href)); - my $is_multi = $href->{multi}; - my $is_text = (defined($href->{type}) and $href->{type} eq 'txt'); - my $default = $href->{default}; - return ($is_multi, $is_text, $default); -} - -## isTagNode("path") -# whether specified path is a tag node. -sub isTagNode { - my ($self, $path) = @_; - my $href = $self->parseTmplAll($path); - return (defined($href) and $href->{tag}); -} - -## isMultiNode("path") -# whether specified path is a "multi leaf node", i.e., multi-value node. -sub isMultiNode { - my ($self, $path) = @_; - my $href = $self->parseTmplAll($path, 1); - return (defined($href) and !$href->{is_value} and $href->{type} - and $href->{multi}); -} - -## isLeafNode("path") -# whether specified path is a "leaf node", i.e., single-/multi-value node. -sub isLeafNode { - my ($self, $path) = @_; - my $href = $self->parseTmplAll($path, 1); - return (defined($href) and !$href->{is_value} and $href->{type} - and !$href->{tag}); -} - -## isLeafValue("path") -# whether specified path is a "leaf value", i.e., value of a leaf node. -sub isLeafValue { - my ($self, $path) = @_; - my $href = $self->parseTmplAll($path, 1); - return (defined($href) and $href->{is_value} and !$href->{tag}); -} - -# 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; -} - - -sub outputError { - my ($location,$msg) = @_; - print STDERR "_errloc_:[ " . join(" ",@{$location}) . " ]\n"; - print STDERR $msg . "\n\n"; -} - -############################################################ -# API functions that have not been converted -############################################################ - -# XXX the following function should not be needed. the only user is -# ConfigLoad, which uses this to get all deactivated nodes in active -# config and then reactivates everything on load. -# -# this works for "load" but not for "merge", which incorrectly -# reactivates all deactivated nodes even if they are not in the config -# file to be merged. see bug 5746. -# -# how to get rid of this function depends on how bug 5746 is going -# to be fixed. -## getAllDeactivated() -# returns array of all deactivated nodes. -my @all_deactivated_nodes; -sub getAllDeactivated { - my ($self, $path) = @_; - my $start_dir = $ENV{VYATTA_ACTIVE_CONFIGURATION_DIR}; - find ( \&wanted, $start_dir ); - return @all_deactivated_nodes; -} -sub wanted { - if ( $_ eq '.disable' ) { - my $f = $File::Find::name; - #now strip off leading path and trailing file - $f = substr($f, length($ENV{VYATTA_ACTIVE_CONFIGURATION_DIR})); - $f = substr($f, 0, length($f)-length("/.disable")); - $f =~ s/\// /g; - push @all_deactivated_nodes, $f; - } -} - -1; - diff --git a/lib/Vyatta/ConfigOutput.pm b/lib/Vyatta/ConfigOutput.pm deleted file mode 100755 index 604d35e..0000000 --- a/lib/Vyatta/ConfigOutput.pm +++ /dev/null @@ -1,482 +0,0 @@ -# Author: Vyatta <eng@vyatta.com> -# 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; -use strict; - -our @EXPORT = qw(set_show_all set_hide_password outputActiveConfig outputNewConfig); -use base qw(Exporter); - -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 $dis = $_[1]; - my $prefix = $_[2]; - my $name = $_[3]; - my $simple_show = $_[4]; - - $config->setLevel(join ' ', @cur_path); - my ($is_multi, $is_text, $default) = $config->parseTmpl(); - if ($is_text) { - $default =~ /^"(.*)"$/; - my $txt = $1; - if (!txt_need_quotes($txt)) { - $default = $txt; - } - } - my $is_password = ($name =~ /^.*(passphrase|password|pre-shared-secret|key)$/); - - my $HIDE_PASSWORD = '****************'; - - if ($is_multi) { - my @ovals = $config->returnOrigValuesDA(); - my @nvals = $config->returnValuesDA(); - 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 "$dis$prefix$name $oval\n"; - } - return; - } - foreach my $del (@dlist) { - if (defined($del)) { - if ($is_password && $hide_password) { - $del = $HIDE_PASSWORD; - } - print "$dis-$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 "$dis$diff$prefix$name $nval\n"; - } - } else { - if ($config->isDefault() and !$show_all) { - # not going to show anything so just return - return; - } - - my $oval = $config->returnOrigValueDA(); - my $nval = $config->returnValueDA(); - if ($is_text) { - if (defined($oval) && txt_need_quotes($oval)) { - $oval = "\"$oval\""; - } - if (defined($nval) && txt_need_quotes($nval)) { - $nval = "\"$nval\""; - } - } - - if (defined($simple_show)) { - if ($is_password && $hide_password) { - $oval = $HIDE_PASSWORD; - } - print "$dis$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 ($is_password && $hide_password) { - $value = $HIDE_PASSWORD; - } - print "$dis$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 $dis = $_[1]; - my $prefix = $_[2]; - my $dont_show_as_deleted = $_[3]; - my $dprefix = '-'; - if (defined($dont_show_as_deleted)) { - $dprefix = ''; - } - - $config->setLevel(''); - my @children = $config->listOrigNodesDA(join(' ', @cur_path)); - for my $child (sort @children) { - # reset level - $config->setLevel(''); - my $is_tag = $config->isTagNode(join(' ', @cur_path, $child)); - - if (!$is_tag) { - my $path = join(' ',( @cur_path, $child )); - my $comment = $config->returnComment($path); - if (defined $comment) { - print "$prefix /* $comment */\n"; - } - - # check deactivate state - my $de_working = $config->deactivated($path); - my $de_active = $config->deactivatedOrig($path); - if ($de_active) { - if ($de_working) { - # deactivated in both - $dis = '! '; - } else { - # deactivated only in active - $dis = '! '; - } - } else { - if ($de_working) { - # deactivated only in working - if (defined($dont_show_as_deleted)) { - $dis = ' '; - } else { - $dis = 'D '; - } - } else { - # deactivated in neither - $dis = ' '; - } - } - } - - $config->setLevel(join ' ', (@cur_path, $child)); - if ($config->isLeafNode()) { - displayValues([ @cur_path, $child ], $dis, $prefix, $child, - $dont_show_as_deleted); - next; - } - - # not a leaf node - my @cnames = sort versioncmp ($config->listOrigNodesDA()); - if (scalar(@cnames) > 0) { - if ($is_tag) { - foreach my $cname (@cnames) { - my $path = join(' ',( @cur_path, $child, $cname )); - $config->setLevel($path); - - my $comment = $config->returnComment(); - if (defined $comment) { - print "$prefix /* $comment */\n"; - } - - # check deactivate state - my $de_working = $config->deactivated(); - my $de_active = $config->deactivatedOrig(); - if ($de_active) { - if ($de_working) { - # deactivated in both - $dis = '! '; - } else { - # deactivated only in active - $dis = '! '; - } - } else { - if ($de_working) { - # deactivated only in working - if (defined($dont_show_as_deleted)) { - $dis = ' '; - } else { - $dis = 'D '; - } - } else { - # deactivated in neither - $dis = ' '; - } - } - - print "$dis$dprefix$prefix$child $cname {\n"; - displayDeletedOrigChildren([ @cur_path, $child, $cname ], - $dis,"$prefix ", $dont_show_as_deleted); - print "$dis$dprefix$prefix}\n"; - } - } else { - print "$dis$dprefix$prefix$child {\n"; - displayDeletedOrigChildren([ @cur_path, $child ],$dis, "$prefix ", - $dont_show_as_deleted); - print "$dis$dprefix$prefix}\n"; - } - } else { - my $has_tmpl_children = $config->hasTmplChildren(); - print "$dis$dprefix$prefix$child" - . ($has_tmpl_children ? " {\n$dis$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 $dis = $_[2]; - my $prefix = $_[3]; - for my $child (sort (keys %child_hash)) { - my $dis = ""; - 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 = '>'; - } - - $config->setLevel(''); - my $is_tag = $config->isTagNode(join(' ', @cur_path, $child)); - - if (!$is_tag) { - my $path = join(' ',( @cur_path, $child )); - my $comment = $config->returnComment($path); - if (defined $comment) { - print "$prefix /* $comment */\n"; - } - - # check deactivate state - my $de_working = $config->deactivated($path); - my $de_active = $config->deactivatedOrig($path); - if ($de_active) { - if ($de_working) { - # deactivated in both - $dis = '! '; - } else { - # deactivated only in active - if ($child_hash{$child} eq 'deleted') { - $dis = '! '; - } else { - $dis = 'A '; - } - } - } else { - if ($de_working) { - # deactivated only in working - $dis = 'D '; - } else { - # deactivated in neither - $dis = ' '; - } - } - } - - $config->setLevel(join ' ', (@cur_path, $child)); - if ($config->isLeafNode()) { - displayValues([ @cur_path, $child ], $dis, $prefix, $child); - next; - } - - # not a leaf node - my %cnodes = $config->listNodeStatusDA(); - my @cnames = sort keys %cnodes; - if (scalar(@cnames) > 0) { - if ($is_tag) { - @cnames = sort versioncmp @cnames; - foreach my $cname (@cnames) { - my $path = join(' ',( @cur_path, $child, $cname )); - $config->setLevel($path); - my $comment = $config->returnComment(); - if (defined $comment) { - print "$prefix /* $comment */\n"; - } - - # check deactivate state - my $de_working = $config->deactivated(); - my $de_active = $config->deactivatedOrig(); - if ($de_active) { - if ($de_working) { - # deactivated in both - $dis = '! '; - } else { - # deactivated only in active - if ($cnodes{$cname} eq 'deleted') { - $dis = '! '; - } else { - $dis = 'A '; - } - } - } else { - if ($de_working) { - # deactivated only in working - $dis = 'D '; - } else { - # deactivated in neither - $dis = ' '; - } - } - - my $tdiff = ' '; - if ($cnodes{$cname} eq 'deleted') { - $tdiff = '-'; - } elsif ($cnodes{$cname} eq 'added') { - $tdiff = '+'; - } - print "$dis$tdiff$prefix$child $cname {\n"; - if ($cnodes{$cname} eq 'deleted') { - displayDeletedOrigChildren([ @cur_path, $child, $cname ], - $dis, "$prefix "); - } else { - $config->setLevel(join ' ', (@cur_path, $child, $cname)); - my %ccnodes = $config->listNodeStatusDA(); - displayChildren(\%ccnodes, [ @cur_path, $child, $cname ], - $dis, "$prefix "); - } - print "$dis$tdiff$prefix}\n"; - } - } else { - print "$dis$diff$prefix$child {\n"; - if ($child_hash{$child} eq 'deleted') { - # this should not happen - displayDeletedOrigChildren([ @cur_path, $child ], $dis, - "$prefix "); - } else { - displayChildren(\%cnodes, [ @cur_path, $child ], $dis, - "$prefix "); - } - print "$dis$diff$prefix}\n"; - } - } else { - if ($child_hash{$child} eq 'deleted') { - # XXX weird. already checked for leaf node above. - $config->setLevel(''); - if ($config->isLeafNode(join ' ', (@cur_path, $child))) { - displayValues([ @cur_path, $child ], $dis, $prefix, $child); - } else { - print "$dis$diff$prefix$child {\n"; - displayDeletedOrigChildren([ @cur_path, $child ], $dis, - "$prefix "); - print "$dis$diff$prefix}\n"; - } - } else { - my $has_tmpl_children - = $config->hasTmplChildren(); - print "$dis$diff$prefix$child" - . ($has_tmpl_children ? " {\n$dis$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 ' ', @_); - if ($config->isLeafNode()) { - displayValues([ @_ ], '', '', $_[$#_]); - return; - } - - # not a leaf node - my %rnodes = $config->listNodeStatusDA(); - if (scalar(keys %rnodes) > 0) { - displayChildren(\%rnodes, [ @_ ], '', ''); - } else { - if ($config->existsOrig() && ! $config->exists()) { - # this is a deleted node - print 'Configuration under "' . (join ' ', @_) . "\" has been deleted\n"; - } elsif (!$config->validateTmplPath('', 1)) { - # validation of current path (including values) failed - 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/File.pm b/lib/Vyatta/File.pm deleted file mode 100644 index 49f5c2b..0000000 --- a/lib/Vyatta/File.pm +++ /dev/null @@ -1,71 +0,0 @@ -# Module: File.pm -# File manipulation functions - -# **** 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) 2010 Vyatta, Inc. -# All Rights Reserved. -# **** End License **** - -package Vyatta::File; -use strict; -use warnings; - -our @EXPORT = qw(touch mkdir_p rm_rf); -our @EXPORT_OK = qw(show_error); -use base qw(Exporter); - -use Fcntl; -use File::Path qw(make_path remove_tree); - -# Change file time stamps -# if file does not exist, it is created empty -sub touch { - my $file = shift; - my $t = time; - - sysopen (my $f, $file, O_RDWR|O_CREAT) - or die "Can't touch $file: $!"; - close $f; - utime $t, $t, $file; -} - -# like mkdir -p -# Wrapper of File::Path:make_tree -sub mkdir_p { - my $path = shift; - my $err; - - make_path($path, { error => \$err } ); - - return @$err; -} - -# like rm -rf -# returns an array of errors if any (see File::Path) -sub rm_rf { - my $path = shift; - my $err; - - remove_tree($path, { error => \$err } ); - - return @$err; -} - -sub show_error { - for my $diag (@_) { - my ($f, $msg) = %$diag; - warn "$f: $msg\n"; - } -} - -1; diff --git a/lib/Vyatta/Interface.pm b/lib/Vyatta/Interface.pm deleted file mode 100755 index 35457e4..0000000 --- a/lib/Vyatta/Interface.pm +++ /dev/null @@ -1,521 +0,0 @@ -# Author: Stephen Hemminger <shemminger@vyatta.com> -# Date: 2009 -# Description: vyatta interface management - -# **** 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) 2008 Vyatta, Inc. -# All Rights Reserved. -# **** End License **** - -package Vyatta::Interface; - -use strict; -use warnings; - -use Vyatta::Misc; -use Vyatta::ioctl; -use Vyatta::Config; -use base 'Exporter'; - -our @EXPORT = qw(IFF_UP IFF_BROADCAST IFF_DEBUG IFF_LOOPBACK - IFF_POINTOPOINT IFF_RUNNING IFF_NOARP - IFF_PROMISC IFF_MULTICAST); - -use constant { - IFF_UP => 0x1, # interface is up - IFF_BROADCAST => 0x2, # broadcast address valid - IFF_DEBUG => 0x4, # turn on debugging - IFF_LOOPBACK => 0x8, # is a loopback net - IFF_POINTOPOINT => 0x10, # interface is has p-p link - IFF_NOTRAILERS => 0x20, # avoid use of trailers - IFF_RUNNING => 0x40, # interface RFC2863 OPER_UP - IFF_NOARP => 0x80, # no ARP protocol - IFF_PROMISC => 0x100, # receive all packets - IFF_ALLMULTI => 0x200, # receive all multicast packets - IFF_MASTER => 0x400, # master of a load balancer - IFF_SLAVE => 0x800, # slave of a load balancer - IFF_MULTICAST => 0x1000, # Supports multicast - IFF_PORTSEL => 0x2000, # can set media type - IFF_AUTOMEDIA => 0x4000, # auto media select active - IFF_DYNAMIC => 0x8000, # dialup device with changing addresses - IFF_LOWER_UP => 0x10000, # driver signals L1 up - IFF_DORMANT => 0x20000, # driver signals dormant - IFF_ECHO => 0x40000, # echo sent packets -}; - -# Build list of known interface types -my $NETDEV = '/opt/vyatta/etc/netdevice'; - -# Hash of interface types -# ex: $net_prefix{"eth"} = "ethernet" -my %net_prefix; - -sub parse_netdev_file { - my $filename = shift; - - open(my $in, '<', $filename) - or return; - - while (<$in>) { - chomp; - - # remove text after # as comment - s/#.*$//; - - my ($prefix, $type) = split; - - # ignore blank lines or missing patterns - next unless defined($prefix) && defined($type); - - $net_prefix{$prefix} = $type; - } - close $in; -} - -# read /opt/vyatta/etc/netdevice -parse_netdev_file($NETDEV); - -# look for optional package interfaces in /opt/vyatta/etc/netdevice.d -my $dirname = $NETDEV . '.d'; -if (opendir(my $netd, $dirname)) { - foreach my $pkg (sort readdir $netd) { - parse_netdev_file($dirname . '/' . $pkg); - } - closedir $netd; -} - -# get list of interface types (only used in usage function) -sub interface_types { - return values %net_prefix; -} - -# new interface description object -sub new { - my $that = shift; - my $name = pop; - my $class = ref($that) || $that; - - my ($vif, $vif_c, $vrid); - my $dev = $name; - - # remove VRRP id suffix - if ($dev =~ /^(.*)v(\d+)$/) { - $dev = $1; - $vrid = $2; - } - - # QinQ or usual VLAN - if ($dev =~ /^([^\.]+)\.(\d+)\.(\d+)/) { - $dev = $1; - $vif = $2; - $vif_c = $3; - } elsif ($dev =~ /^(.*)\.(\d+)/) { - $dev = $1; - $vif = $2; - } - - return unless ($dev =~ /^(l2tpeth|[a-z]+)/); - - # convert from prefix 'eth' to type 'ethernet' - my $type = $net_prefix{$1}; - return unless $type; # unknown network interface type - - my $self = { - name => $name, - type => $type, - dev => $dev, - vif => $vif, - vif_c => $vif_c, - vrid => $vrid, - }; - bless $self, $class; - return $self; -} - -## Field accessors -sub name { - my $self = shift; - return $self->{name}; -} - -sub path { - my $self = shift; - my $config = new Vyatta::Config; - - if ($self->{name} =~ /^(pppo[a])(\d+)/) { - - # For ppp need to look in config file to find where used - my $type = $1; - my $id = $2; - - my $intf = _ppp_intf($self->{name}); - return unless $intf; - - my $adsl = "interfaces adsl $intf pvc"; - my $config = new Vyatta::Config; - foreach my $pvc ($config->listNodes($adsl)) { - my $path = "$adsl $pvc $type $id"; - return $path if $config->exists($path); - } - } elsif ($self->{name} =~ /^(wan\d+)\.(\d+)/) { - - # guesswork for wan devices - my $dev = $1; - my $vif = $2; - foreach my $type (qw(cisco-hdlc ppp frame-relay)) { - my $path = "interfaces serial $dev $type vif $vif"; - return $path if $config->exists($path); - } - } else { - - # normal device - my $path = "interfaces $self->{type} $self->{dev}"; - $path .= " vrrp vrrp-group $self->{vrid}" if $self->{vrid}; - $path .= " vif $self->{vif}" if ($self->{vif} && !$self->{vif_c}); - $path .= " vif-s $self->{vif} vif-c $self->{vif_c}" if - ($self->{vif} && $self->{vif_c}); - - - return $path; - } - - return; # undefined (not in config) -} - -sub type { - my $self = shift; - return $self->{type}; -} - -sub vif { - my $self = shift; - return $self->{vif}; -} - -sub vrid { - my $self = shift; - return $self->{vrid}; -} - -sub physicalDevice { - my $self = shift; - return $self->{dev}; -} - -# Read ppp config to find the associated interface for the ppp device -sub _ppp_intf { - my $dev = shift; - my $intf; - - open(my $ppp, '<', "/etc/ppp/peers/$dev") - or return; # no such device - - while (my $line = <$ppp>) { - # looking for a line like: #pty "/usr/sbin/pppoe -m 1412 -I eth1" - # and stop after the first occurence of this line - if ($line =~ /^#pty\s.*-I\s*(\w+)"/) { - $intf = $1; - last; - } - } - close $ppp; - - return $intf; -} - -## Configuration checks - -sub configured { - my $self = shift; - my $config = new Vyatta::Config; - - return $config->exists($self->{path}); -} - -sub disabled { - my $self = shift; - my $config = new Vyatta::Config; - - $config->setLevel($self->{path}); - return $config->exists("disable"); -} - -sub mtu { - my $self = shift; - my $config = new Vyatta::Config; - - $config->setLevel($self->{path}); - return $config->returnValue("mtu"); -} - -sub using_dhcp { - my $self = shift; - my $config = new Vyatta::Config; - $config->setLevel($self->{path}); - - my @addr = grep {$_ eq 'dhcp'} $config->returnOrigValues('address'); - - return if ($#addr < 0); - return $addr[0]; -} - -sub bridge_grp { - my $self = shift; - my $config = new Vyatta::Config; - - $config->setLevel($self->{path}); - return $config->returnValue("bridge-group bridge"); -} - -## System checks - -# return array of current addresses (on system) -sub address { - my ($self, $type) = @_; - return Vyatta::Misc::getIP($self->{name}, $type); -} - -# Do SIOCGIFFLAGS ioctl in perl -sub flags { - my $self = shift; - return Vyatta::ioctl::get_interface_flags($self->{name}); -} - -sub exists { - my $self = shift; - my $flags = $self->flags(); - return defined($flags); -} - -sub hw_address { - my $self = shift; - - open my $addrf, '<', "/sys/class/net/$self->{name}/address" - or return; - my $address = <$addrf>; - close $addrf; - - chomp $address if $address; - return $address; -} - -sub is_broadcast { - my $self = shift; - return $self->flags() & IFF_BROADCAST; -} - -sub is_multicast { - my $self = shift; - return $self->flags() & IFF_MULTICAST; -} - -sub is_pointtopoint { - my $self = shift; - return $self->flags() & IFF_POINTOPOINT; -} - -sub is_loopback { - my $self = shift; - return $self->flags() & IFF_LOOPBACK; -} - -# device exists and is online -sub up { - my $self = shift; - my $flags = $self->flags(); - - return defined($flags) && ($flags & IFF_UP); -} - -# device exists and is running (ie carrier present) -sub running { - my $self = shift; - my $flags = $self->flags(); - - return defined($flags) && ($flags & IFF_RUNNING); -} - -# device description information in kernel (future use) -sub description { - my $self = shift; - - return interface_description($self->{name}); -} - -## Utility functions - -# enumerate vrrp slave devices -sub get_vrrp_interfaces { - my ($cfg, $vfunc, $dev, $path) = @_; - my @ret_ifs; - - foreach my $vrid ($cfg->$vfunc("$path vrrp vrrp-group")) { - my $vrdev = $dev."v".$vrid; - my $vrpath = "$path vrrp vrrp-group $vrid interface"; - - push @ret_ifs, - { - name => $vrdev, - type => 'vrrp', - path => $vrpath, - }; - } - - return @ret_ifs; -} - -# enumerate vif devies -sub get_vif_interfaces { - my ($cfg, $vfunc, $dev, $type, $path) = @_; - my @ret_ifs; - - foreach my $vnum ($cfg->$vfunc("$path vif")) { - my $vifdev = "$dev.$vnum"; - my $vifpath = "$path vif $vnum"; - push @ret_ifs, - { - name => $vifdev, - type => $type, - path => $vifpath - }; - push @ret_ifs, get_vrrp_interfaces($cfg, $vfunc, $vifdev, $vifpath); - } - - return @ret_ifs; -} - -# special cases for adsl -sub get_adsl_interfaces { - my ($cfg, $vfunc) = @_; - my @ret_ifs; - - for my $p ($cfg->$vfunc("interfaces adsl $a $a pvc")) { - for my $t ($cfg->$vfunc("interfaces adsl $a $a pvc $p")) { - if ($t eq 'classical-ipoa' or $t eq 'bridged-ethernet') { - - # classical-ipoa or bridged-ethernet - push @ret_ifs, - { - name => $a, - type => 'adsl', - path => "interfaces adsl $a $a pvc $p $t" - }; - next; - } - - # pppo[ea] - for my $i ($cfg->$vfunc("interfaces adsl $a $a pvc $p $t")) { - push @ret_ifs, - { - name => "$t$i", - type => 'adsl-pppo[ea]', - path => "interfaces adsl $a $a pvc $p $t $i" - }; - } - } - } - return @ret_ifs; -} - -# get all configured interfaces from configuration -# parameter is virtual function (see Config.pm) -# -# return a hash of: -# name => ethX -# type => "ethernet" -# path => "interfaces ethernet ethX" -# -# Don't use this function directly, use wrappers below instead -sub get_config_interfaces { - my $vfunc = shift; - my $cfg = new Vyatta::Config; - my @ret_ifs; - - foreach my $type ($cfg->$vfunc("interfaces")) { - if ($type eq 'adsl') { - push @ret_ifs, get_adsl_interfaces($cfg, $vfunc); - next; - } - - foreach my $dev ($cfg->$vfunc("interfaces $type")) { - my $path = "interfaces $type $dev"; - - push @ret_ifs, - { - name => $dev, - type => $type, - path => $path - }; - push @ret_ifs, get_vrrp_interfaces($cfg, $vfunc, $dev, $path); - push @ret_ifs, get_vif_interfaces($cfg, $vfunc, $dev, $type, $path); - } - - } - - return @ret_ifs; -} - -# get array of hash for interfaces in working config -sub get_interfaces { - return get_config_interfaces('listNodes'); -} - -# get array of hash for interfaces in configuration -# when used outside of config mode. -sub get_effective_interfaces { - return get_config_interfaces('listEffectiveNodes'); -} - -# get array of hash for interfaces in original config -# only makes sense in configuration mode -sub get_original_interfaces { - return get_config_interfaces('listOrigNodes'); -} - -# get map of current addresses on the system -# returns reference to hash of form: -# ( "192.168.1.1" => { 'eth0', 'eth2' } ) -sub get_cfg_addresses { - my $config = new Vyatta::Config; - my @cfgifs = get_interfaces(); - my %ahash; - - foreach my $intf (@cfgifs) { - my $name = $intf->{'name'}; - - # workaround openvpn wart - my @addrs; - $config->setLevel($intf->{'path'}); - if ($name =~ /^vtun/) { - @addrs = $config->listNodes('local-address'); - } else { - @addrs = $config->returnValues('address'); - } - - foreach my $addr (@addrs){ - next if ($addr =~ /^dhcp/); - - # put interface into - my $aif = $ahash{$addr}; - if ($aif) { - push @{$aif}, $name; - } else { - $ahash{$addr} = [$name]; - } - } - } - - return \%ahash; -} - -1; diff --git a/lib/Vyatta/Misc.pm b/lib/Vyatta/Misc.pm deleted file mode 100755 index 001fc93..0000000 --- a/lib/Vyatta/Misc.pm +++ /dev/null @@ -1,588 +0,0 @@ -# Module: VyattaMisc.pm -# -# Author: Marat <marat@vyatta.com> -# 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; -use strict; - -require Exporter; - -our @ISA = qw(Exporter); -our @EXPORT = qw(getInterfaces getIP getNetAddIP get_sysfs_value - is_address_enabled is_dhcp_enabled get_ipaddr_intf_hash - isIpAddress is_ip_v4_or_v6 interface_description - is_local_address is_primary_address get_ipnet_intf_hash - isValidPortNumber get_terminal_size get_terminal_height - get_terminal_width is_port_available ); -our @EXPORT_OK = qw(generate_dhclient_intf_files - getInterfacesIPadresses - getPortRuleString - get_short_config_path); - -use Vyatta::Config; -use Vyatta::Interface; -use NetAddr::IP; -use Socket; -Socket6->import(qw(inet_pton getaddrinfo)); - -# -# returns a hash of ipaddrs => interface -# -# only works for ipv4 -# -sub get_ipaddr_intf_hash { - my %config_ipaddrs = (); - my @lines = `ip addr show | grep 'inet '`; - chomp @lines; - foreach my $line (@lines) { - if ($line =~ /vtun|wan/) { - if ($line =~ /inet\s+([0-9.]+).*\s([\w.]+)$/) { - $config_ipaddrs{$1} = $2; - } - } else { - if ($line =~ /inet\s+([0-9.]+)\/.*\s([\w.]+)$/) { - $config_ipaddrs{$1} = $2; - } - } - } - - return \%config_ipaddrs; -} - -# -# returns a hash of ipnet => interface -# -# works for both ipv4 and ipv6 -# -sub get_ipnet_intf_hash { - my @args = qw(ip addr show); - my @addresses; - my %config_ipaddrs = (); - - open my $ipcmd, '-|' - or exec @args - or die "ip addr command failed: $!"; - - my $iface = ""; - while (<$ipcmd>) { - my ( $proto, $addr ) = split; - if ( $proto =~ /.*:$/ && $addr =~ /.*:$/) { - $iface = $addr; - chop($iface); - } - next unless ( $proto =~ /inet/ ); - $config_ipaddrs{$addr} = $iface; - } - close $ipcmd; - - return \%config_ipaddrs; -} - - -# Check whether an address is the primary address on some interface -sub is_primary_address { - my $ip_address = shift; - - my $ref = get_ipaddr_intf_hash(); - my %hash = %{$ref}; - if (!defined $hash{$ip_address}) { - return; - } - - my $line = `ip address show $hash{$ip_address} | grep 'inet' | head -n 1`; - chomp($line); - my $primary_address = undef; - - if ($line =~ /vtun|wan/) { - if ($line =~ /inet\s+([0-9.]+).*\s([\w.]+)$/) { - $primary_address = $1; - } - } else { - if ($line =~ /inet\s+([0-9.]+)\/.*\s([\w.]+)$/) { - $primary_address = $1; - } - } - - return 1 if ($ip_address eq $primary_address); - return; -} - -# remove '/opt/vyatta/etc' from begining of config directory path -sub get_short_config_path { - my $cfg_path = shift; - my $shortened_cfg_path = ""; - $shortened_cfg_path = $cfg_path if defined $cfg_path; - $shortened_cfg_path =~ s/^\/opt\/vyatta\/etc//; - - return $shortened_cfg_path; -} - -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 interface is configured to get an IP address using dhcp -sub is_dhcp_enabled { - my ( $name, $outside_cli ) = @_; - my $intf = new Vyatta::Interface($name); - return unless $intf; - - my $config = new Vyatta::Config; - - $config->setLevel( $intf->path() ); - # the "effective" observers can be used both inside and outside - # config sessions. - foreach my $addr ( $config->returnEffectiveValues('address') ) { - return 1 if ( $addr && $addr eq "dhcp" ); - } - - return; -} - -# check if any non-dhcp addresses configured -sub is_address_enabled { - my $name = shift; - my $intf = new Vyatta::Interface($name); - $intf or return; - - my $config = new Vyatta::Config; - $config->setLevel( $intf->path() ); - foreach my $addr ( $config->returnOrigValues('address') ) { - return 1 if ( $addr && $addr ne 'dhcp' ); - } - - return; -} - -# return dhclient related files for interface -sub generate_dhclient_intf_files { - my $intf = shift; - my $dhclient_dir = '/run/dhclient/'; - - $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 ); -} - -# get list of interfaces on the system via sysfs -# skip dot files (and any interfaces name .xxx) -# and bond_masters file used by bonding -# and wireless control interfaces -sub getInterfaces { - opendir( my $sys_class, '/sys/class/net' ) - or die "can't open /sys/class/net: $!"; - my @interfaces = grep { ( !/^\./ ) && - ( $_ ne 'bonding_masters' ) && - !( $_ =~ '^mon.wlan\d$') && - !( $_ =~ '^wmaster\d+$') - } readdir $sys_class; - closedir $sys_class; - - return @interfaces; -} - -# Test if IP address is local to the system. -# Implemented by doing bind since by default -# Linux will only allow binding to local addresses -sub is_local_address { - my $addr = shift; - my $ip = new NetAddr::IP $addr; - die "$addr: not a valid IP address" - unless $ip; - - my ($pf, $sockaddr); - if ($ip->version() == 4) { - $pf = PF_INET; - $sockaddr = sockaddr_in(0, $ip->aton()); - } else { - $pf = PF_INET6; - $sockaddr = sockaddr_in6(0, $ip->aton()); - } - - socket( my $sock, $pf, SOCK_STREAM, 0) - or die "socket failed\n"; - - return bind($sock, $sockaddr); -} - -# Test if the given port is currently in use by attempting -# to bind to it, success shows the port is currently free. -sub is_port_available { - my $port = shift; - my $family = PF_INET; - my $sockaddr = sockaddr_in($port, INADDR_ANY); - my $proto = getprotobyname('tcp'); - - socket(my $sock, $family, SOCK_STREAM, $proto) - or die "socket failed\n"; - - return bind($sock, $sockaddr); -} - -# get list of IPv4 and IPv6 addresses -# if name is defined then get the addresses on that interface -# if type is defined then restrict to that type (inet, inet6) -sub getIP { - my ( $name, $type ) = @_; - my @args = qw(ip addr show); - my @addresses; - - push @args, ('dev', $name) if $name; - - open my $ipcmd, '-|' - or exec @args - or die "ip addr command failed: $!"; - - <$ipcmd>; - while (<$ipcmd>) { - my ( $proto, $addr ) = split; - next unless ( $proto =~ /inet/ ); - if ($type) { - next if ( $proto eq 'inet6' && $type != 6 ); - next if ( $proto eq 'inet' && $type != 4 ); - } - - push @addresses, $addr; - } - close $ipcmd; - - return @addresses; -} - -my %type_hash = ( - 'broadcast' => 'is_broadcast', - 'multicast' => 'is_multicast', - 'pointtopoint' => 'is_pointtopoint', - 'loopback' => 'is_loopback', - ); - -# getInterfacesIPadresses() returns IPv4 addresses for the interface type -# possible type of interfaces : 'broadcast', 'pointtopoint', 'multicast', 'all' -# and 'loopback' -sub getInterfacesIPadresses { - my $type = shift; - my $type_func; - my @ips; - - $type or die "Interface type not defined"; - - if ( $type ne 'all' ) { - $type_func = $type_hash{$type}; - die "Invalid type specified to retreive IP addresses for: $type" - unless $type_func; - } - - foreach my $name ( getInterfaces() ) { - my $intf = new Vyatta::Interface($name); - next unless $intf; - if ( defined $type_func ) { - next unless $intf->$type_func(); - } - - my @addresses = $intf->address(4); - push @ips, @addresses; - } - - return @ips; -} - -sub getNetAddrIP { - my $name = shift; - my $intf = new Vyatta::Interface($name); - $intf or return; - - foreach my $addr ( $intf->addresses() ) { - my $ip = new NetAddr::IP $addr; - next unless ( $ip && ip->version() == 4 ); - return $ip; - } - - return; -} - -sub is_ip_v4_or_v6 { - my $addr = shift; - - my $ip = new NetAddr::IP $addr; - return unless defined $ip; - - my $vers = $ip->version(); - if ( $vers == 4 ) { - # NetAddr::IP will accept short forms 1.1 and hostnames - # so check if all 4 octets are defined - return 4 unless ( $addr !~ /\d+\.\d+\.\d+\.\d+/ ); # undef - } - elsif ( $vers == 6 ) { - return 6; - } - - return; -} - -sub isIpAddress { - my $ip = shift; - - return unless $ip =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/; - - return unless ( $1 > 0 && $1 < 256 ); - return unless ( $2 >= 0 && $2 < 256 ); - return unless ( $3 >= 0 && $3 < 256 ); - return unless ( $4 >= 0 && $4 < 256 ); - return 1; -} - -sub isClusterIP { - my ( $vc, $ip ) = @_; - - return unless $ip; # undef - - 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 ($service =~ /\//) { - $service = substr( $service, 0, index( $service, '/' )); - } - if ( $ip eq $service ) { - return 1; - } - } - } - - return; -} - -sub remove_ip_prefix { - my @addr_nets = @_; - - s/\/\d+$// for @addr_nets; - return @addr_nets; -} - -sub is_ip_in_list { - my ( $ip, @list ) = @_; - - @list = remove_ip_prefix(@list); - my %list_hash = map { $_ => 1 } @list; - - return $list_hash{$ip}; -} - -sub isIPinInterfaces { - my ( $vc, $ip_addr, @interfaces ) = @_; - - return unless $ip_addr; # undef == false - - foreach my $name (@interfaces) { - return 1 if ( is_ip_in_list( $ip_addr, getIP($name) ) ); - } - - return; # false (undef) -} - -sub isClusteringEnabled { - my ($vc) = @_; - - return $vc->exists('cluster'); -} - -# $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 ); -} - -# $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 '' ); - - my $port = getservbyname( $str, $proto ); - return ( 1, undef ) if $port; - - 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/(\d+)-(\d+)/$1:$2/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 ); - } - } - if ($proto eq 'tcp_udp') { - ( $success, $err ) = isValidPortName( $port_spec, 'tcp' ); - if (defined $success) { - # only do udp test if the tcp test was a success - ( $success, $err ) = isValidPortName( $port_spec, 'udp' ) - } - } else { - ( $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 $negate --${prefix}ports ${port_str}"; - } - elsif ( $num_ports > 0 ) { - $rule_str = " $negate --${prefix}port ${port_str}"; - } - - return ( $rule_str, undef ); -} - -sub interface_description { - my $name = shift; - - open my $ifalias, '<', "/sys/class/net/$name/ifalias" - or return; - - my $description = <$ifalias>; - close $ifalias; - - # If the interface has a description set then just use that, if not then check - # the active config to see if one is configured there. Used for interfaces - # that can be destroyed and recreated during opertion, but then don't have - # their description reset. - - if ($description){ - chomp $description; - } else { - my $intf = new Vyatta::Interface($name); - my $config = new Vyatta::Config; - - $config->setLevel( $intf->path() ); - - if ($config->existsOrig('description')) { - $description = $config->returnOrigValue('description'); - } - } - - return $description; -} - -# returns (rows, columns) for terminal size -sub get_terminal_size { - return Vyatta::ioctl::get_terminal_size(); -} - -# return only terminal width -sub get_terminal_width { - my ($rows, $cols) = get_terminal_size; - return $cols; -} - -# return only terminal height -sub get_terminal_height { - my ($rows, $cols) = get_terminal_size; - return $rows; -} - -1; diff --git a/lib/Vyatta/TypeChecker.pm b/lib/Vyatta/TypeChecker.pm deleted file mode 100755 index 321e9f9..0000000 --- a/lib/Vyatta/TypeChecker.pm +++ /dev/null @@ -1,339 +0,0 @@ -# Author: An-Cheng Huang <ancheng@vyatta.com> -# 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; -use strict; - -our @EXPORT = qw(findType validateType); -use base qw(Exporter); - -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, - 'ipv6_negate' => \&validate_ipv6_negate, - 'ipv6net' => \&validate_ipv6net, - 'ipv6net_negate' => \&validate_ipv6net_negate, - 'hex16' => \&validate_hex_16_bits, - 'hex32' => \&validate_hex_32_bits, - 'ipv6_addr_param' => \&validate_ipv6_addr_param, - 'restrictive_filename' => \&validate_restrictive_filename, - 'no_bash_special' => \&validate_no_bash_special, - 'u32' => \&validate_u32, - 'bool' => \&validate_bool - ); - -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_u32 { - my $val = shift; - return ($val =~ /^\d+$/ and $val < 2**32); -} - -sub validate_bool { - my $val = shift; - return ($val eq 'true' or $val eq 'false'); -} - -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)); - #need to check that range is in ascending order - $a1 =~ m/^(\d\d?\d?)\.(\d\d?\d?)\.(\d\d?\d?)\.(\d\d?\d?)/; - my $v1 = $1*256*256*256+$2*256*256+$3*256+$4; - $a2 =~ m/^(\d\d?\d?)\.(\d\d?\d?)\.(\d\d?\d?)\.(\d\d?\d?)/; - my $v2 = $1*256*256*256+$2*256*256+$3*256+$4; - return 0 if ($v1 > $v2); - 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 ($value =~ /^\d+$/) { - # 0 has special meaning to iptables - return 1 if $value >= 1 and $value <= 255; - } - - return defined getprotobyname($value); -} - -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 validate_ipv6_negate { - my $value = shift; - if ($value =~ m/^\!(.*)$/) { - $value = $1; - } - return validate_ipv6($value); -} - -sub validate_ipv6net { - my $value = shift; - - if ($value =~ m/^(.*)\/(.*)$/) { - my $ipv6_addr = $1; - my $prefix_length = $2; - if ($prefix_length < 0 || $prefix_length > 128) { - return 0; - } - return validate_ipv6($ipv6_addr); - - } else { - return 0; - } -} - -sub validate_ipv6net_negate { - my $value = shift; - - if ($value =~ m/^\!(.*)$/) { - $value = $1; - } - return validate_ipv6net($value); -} - -# Validate a 16-bit hex value, no leading "0x" -sub validate_hex_16_bits { - my $value = shift; - $value = lc $value; - return 1 if ($value =~ /^[0-9a-f]{4}$/) -} - -# Validate a 32-bit hex value, no leading "0x" -sub validate_hex_32_bits { - my $value = shift; - $value = lc $value; - return 1 if ($value =~ /^[0-9a-f]{8}$/) -} - -# Validate the overloaded IPv6 source and destination address parameter in -# the firewall configuration tree. -sub validate_ipv6_addr_param { - my $value = shift; - - # leading exclamation point is valid in all three formats - if ($value =~ m/^\!(.*)$/) { - $value = $1; - } - - if ($value =~ m/^(.*)-(.*)$/) { - # first format: <ipv6addr>-<ipv6-addr> - if (validate_ipv6($1)) { - return validate_ipv6($2); - } else { - return 0; - } - } - - elsif ($value =~ m/^(.*)\/(.*)$/) { - # Second format: <ipv6addr>/<prefix-len> - return validate_ipv6net($value); - } - - else { - # third format: <ipv6addr> - return validate_ipv6($value) - } -} - -# validate a restrictive filename -sub validate_restrictive_filename { - my $value = shift; - return (($value =~ /^[-_.a-zA-Z0-9]+$/) ? 1 : 0); -} - -# validate that a string does not contain bash special chars -sub validate_no_bash_special { - my $value = shift; - return (($value =~ /[;&"'`!\$><|]/) ? 0 : 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) = @_; - return if (!defined($value) || ((scalar @candidates) < 1)); # undef - - foreach my $type (@candidates) { - if (!defined($type_handler{$type})) { - next; - } - if (&{$type_handler{$type}}($value)) { - # the first valid type is returned - return $type; - } - } -} - -1; - -# Local Variables: -# mode: perl -# indent-tabs-mode: nil -# perl-indent-level: 2 -# End: diff --git a/lib/Vyatta/ioctl.pm b/lib/Vyatta/ioctl.pm deleted file mode 100644 index 6572231..0000000 --- a/lib/Vyatta/ioctl.pm +++ /dev/null @@ -1,67 +0,0 @@ -# Author: John Southworth <john.southworth@vyatta.com> -# Date: 2012 -# Description: vyatta ioctl functions - -# **** 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) 2008 Vyatta, Inc. -# All Rights Reserved. -# **** End License **** - -package Vyatta::ioctl; - -use strict; -use warnings; -use Socket; -Socket6->import(qw(inet_pton getaddrinfo)); - -{ - local $^W = 0; - require 'sys/ioctl.ph'; -} - -our @EXPORT = qw(get_terminal_size get_interface_flags); -use base qw(Exporter); - - -# returns (rows, columns) for terminal size; -sub get_terminal_size { - # undefined if not terminal attached - open(my $TTY, '>', '/dev/tty') - or return; - - my $winsize = ''; - # undefined if output not going to terminal - return unless (ioctl($TTY, &TIOCGWINSZ, $winsize)); - close($TTY); - - my ($rows, $cols, undef, undef) = unpack('S4', $winsize); - return ($rows, $cols); -} - -#Do SIOCGIFFLAGS ioctl in perl -sub get_interface_flags { - my $name = shift; - - socket (my $sock, AF_INET, SOCK_DGRAM, 0) - or die "open UDP socket failed: $!"; - - my $ifreq = pack('a16', $name); - ioctl($sock, &SIOCGIFFLAGS, $ifreq) - or return; #undef - - my (undef, $flags) = unpack('a16s', $ifreq); - return $flags; - -} - -1; |