From 069bd35b3cc58e0deeae02d3a7811d29c1ccea3f Mon Sep 17 00:00:00 2001 From: Christian Breunig Date: Sun, 30 Jun 2024 07:37:49 +0200 Subject: T6527: remove legacy Perl library components --- Makefile.am | 11 - configure.ac | 1 - debian/control | 9 +- debian/libvyatta-cfg1.install | 1 - debian/rules | 4 - lib/Vyatta/Config.pm | 751 ----------------------------------------- lib/Vyatta/ConfigOutput.pm | 482 -------------------------- lib/Vyatta/File.pm | 71 ---- lib/Vyatta/Interface.pm | 521 ---------------------------- lib/Vyatta/Misc.pm | 588 -------------------------------- lib/Vyatta/TypeChecker.pm | 339 ------------------- lib/Vyatta/ioctl.pm | 67 ---- perl_dmod/.gitignore | 2 - perl_dmod/Cstore/.gitignore | 5 - perl_dmod/Cstore/Changes | 6 - perl_dmod/Cstore/Cstore.xs | 343 ------------------- perl_dmod/Cstore/MANIFEST | 7 - perl_dmod/Cstore/Makefile.PL | 88 ----- perl_dmod/Cstore/README | 33 -- perl_dmod/Cstore/lib/Cstore.pm | 96 ------ perl_dmod/Cstore/t/Cstore.t | 15 - perl_dmod/Cstore/typemap | 83 ----- perl_dmod/Makefile.am | 25 -- 23 files changed, 3 insertions(+), 3545 deletions(-) delete mode 100755 lib/Vyatta/Config.pm delete mode 100755 lib/Vyatta/ConfigOutput.pm delete mode 100644 lib/Vyatta/File.pm delete mode 100755 lib/Vyatta/Interface.pm delete mode 100755 lib/Vyatta/Misc.pm delete mode 100755 lib/Vyatta/TypeChecker.pm delete mode 100644 lib/Vyatta/ioctl.pm delete mode 100644 perl_dmod/.gitignore delete mode 100644 perl_dmod/Cstore/.gitignore delete mode 100644 perl_dmod/Cstore/Changes delete mode 100644 perl_dmod/Cstore/Cstore.xs delete mode 100644 perl_dmod/Cstore/MANIFEST delete mode 100644 perl_dmod/Cstore/Makefile.PL delete mode 100644 perl_dmod/Cstore/README delete mode 100644 perl_dmod/Cstore/lib/Cstore.pm delete mode 100644 perl_dmod/Cstore/t/Cstore.t delete mode 100644 perl_dmod/Cstore/typemap delete mode 100644 perl_dmod/Makefile.am diff --git a/Makefile.am b/Makefile.am index c175d7d..073ee3a 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1,6 +1,3 @@ -SUBDIRS = . perl_dmod - -share_perl5dir = /opt/vyatta/share/perl5/Vyatta completiondir = /etc/bash_completion.d initddir = /etc/init.d logrotatedir = /etc/logrotate.d @@ -101,14 +98,6 @@ sbin_SCRIPTS += scripts/vyatta-log-commit.pl sbin_SCRIPTS += scripts/vyos-user-precommit-hooks.sh sbin_SCRIPTS += scripts/vyos-user-postcommit-hooks.sh -share_perl5_DATA = lib/Vyatta/Config.pm -share_perl5_DATA += lib/Vyatta/File.pm -share_perl5_DATA += lib/Vyatta/Misc.pm -share_perl5_DATA += lib/Vyatta/ioctl.pm -share_perl5_DATA += lib/Vyatta/Interface.pm -share_perl5_DATA += lib/Vyatta/TypeChecker.pm -share_perl5_DATA += lib/Vyatta/ConfigOutput.pm - default_DATA = etc/default/vyatta-cfg default_DATA += etc/default/vyatta-load-boot diff --git a/configure.ac b/configure.ac index b141216..e8035f7 100644 --- a/configure.ac +++ b/configure.ac @@ -40,7 +40,6 @@ AM_CONDITIONAL([USE_UNIONFSFUSE], [test "$enable_unionfsfuse" != no]) AC_CONFIG_FILES( [Makefile] - [perl_dmod/Makefile] [debian/vyatta-cfg.postinst]) AC_SUBST(NOSTRIP) diff --git a/debian/control b/debian/control index 194d998..136b2e8 100644 --- a/debian/control +++ b/debian/control @@ -4,7 +4,7 @@ Priority: extra Maintainer: VyOS Package Maintainers Build-Depends: debhelper (>= 10), autotools-dev, libglib2.0-dev, libboost-filesystem-dev, libapt-pkg-dev, libtool, flex, - bison, libperl-dev, autoconf, automake, pkg-config, cpio, dh-autoreconf + bison, autoconf, automake, pkg-config, cpio, dh-autoreconf Standards-Version: 3.9.1 Package: vyatta-cfg @@ -14,13 +14,12 @@ Depends: sed (>= 4.1.5), coreutils (>= 5.97-5.3), vyatta-bash | bash (>= 4.1), bsdutils (>=1:2.13), - libsocket6-perl, libvyatta-cfg1 (>=${binary:Version}), unionfs-fuse, uuid-runtime, libboost-filesystem1.74.0, libapt-pkg4.12 | libapt-pkg5.0 | libapt-pkg6.0, - ${perl:Depends}, ${shlibs:Depends} + ${shlibs:Depends} Suggests: util-linux (>= 2.13-5), net-tools, ncurses-bin (>= 5.5-5), @@ -30,9 +29,7 @@ Description: VyOS configuration system Package: libvyatta-cfg1 Architecture: any -Depends: libsort-versions-perl, - libfile-sync-perl, - ${perl:Depends}, ${shlibs:Depends} +Depends: ${shlibs:Depends} Replaces: vyatta-cfg Description: vyatta-cfg back-end library Vyatta configuration back-end library (libvyatta-cfg). diff --git a/debian/libvyatta-cfg1.install b/debian/libvyatta-cfg1.install index 29063b5..093956b 100644 --- a/debian/libvyatta-cfg1.install +++ b/debian/libvyatta-cfg1.install @@ -1,2 +1 @@ usr/lib/*.so.* -opt/vyatta/share/perl5 diff --git a/debian/rules b/debian/rules index 71f18d8..ae34cdf 100755 --- a/debian/rules +++ b/debian/rules @@ -25,10 +25,6 @@ inst_opts := --sourcedir=debian/tmp autoreconf: autoreconf -f -i -override_dh_perl: - rm -f debian/files - dh_perl /opt/vyatta/share/perl5 /opt/vyatta/share/perl5/Vyatta - override_dh_gencontrol: rm -f debian/*/DEBIAN/conffiles if [ -f "../.VYOS_DEV_BUILD" ]; then \ 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 -# 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 -# 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 -# 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 -# 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 -# 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: - - if (validate_ipv6($1)) { - return validate_ipv6($2); - } else { - return 0; - } - } - - elsif ($value =~ m/^(.*)\/(.*)$/) { - # Second format: / - return validate_ipv6net($value); - } - - else { - # third format: - 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 -# 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; diff --git a/perl_dmod/.gitignore b/perl_dmod/.gitignore deleted file mode 100644 index b336cc7..0000000 --- a/perl_dmod/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ -/Makefile -/Makefile.in diff --git a/perl_dmod/Cstore/.gitignore b/perl_dmod/Cstore/.gitignore deleted file mode 100644 index 7082d2a..0000000 --- a/perl_dmod/Cstore/.gitignore +++ /dev/null @@ -1,5 +0,0 @@ -/Makefile -/Cstore.bs -/Cstore.cpp -/blib -/pm_to_blib diff --git a/perl_dmod/Cstore/Changes b/perl_dmod/Cstore/Changes deleted file mode 100644 index 15e5188..0000000 --- a/perl_dmod/Cstore/Changes +++ /dev/null @@ -1,6 +0,0 @@ -Revision history for Perl extension Cstore. - -0.01 Tue Jun 15 12:03:35 2010 - - original version; created by h2xs 1.23 with options - -c --skip-ppport -n Cstore - diff --git a/perl_dmod/Cstore/Cstore.xs b/perl_dmod/Cstore/Cstore.xs deleted file mode 100644 index 3c9a9ad..0000000 --- a/perl_dmod/Cstore/Cstore.xs +++ /dev/null @@ -1,343 +0,0 @@ -/* - * Copyright (C) 2010 Vyatta, Inc. - * - * 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. - * - * You should have received a copy of the GNU General Public License - * along with this program. If not, see . - */ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -/* these macros are defined in perl headers but conflict with C++ headers */ -#undef do_open -#undef do_close - -#include -#include -#include - -#include - -using namespace cstore; - -typedef SV STRVEC; -typedef SV CPATH; -typedef SV STRSTRMAP; - -MODULE = Cstore PACKAGE = Cstore - - -Cstore * -Cstore::new() -CODE: - RETVAL = Cstore::createCstore(false); -OUTPUT: - RETVAL - - -bool -Cstore::cfgPathExists(CPATH *pref, bool active_cfg) -PREINIT: - Cpath arg_cpath; -CODE: - RETVAL = THIS->cfgPathExists(arg_cpath, active_cfg); -OUTPUT: - RETVAL - - -bool -Cstore::cfgPathDefault(CPATH *pref, bool active_cfg) -PREINIT: - Cpath arg_cpath; -CODE: - RETVAL = THIS->cfgPathDefault(arg_cpath, active_cfg); -OUTPUT: - RETVAL - - -STRVEC * -Cstore::cfgPathGetChildNodes(CPATH *pref, bool active_cfg) -PREINIT: - Cpath arg_cpath; -CODE: - vector ret_strvec; - THIS->cfgPathGetChildNodes(arg_cpath, ret_strvec, active_cfg); -OUTPUT: - RETVAL - - -SV * -Cstore::cfgPathGetValue(CPATH *pref, bool active_cfg) -PREINIT: - Cpath arg_cpath; -CODE: - string value; - if (THIS->cfgPathGetValue(arg_cpath, value, active_cfg)) { - RETVAL = newSVpv(value.c_str(), 0); - } else { - XSRETURN_UNDEF; - } -OUTPUT: - RETVAL - - -STRVEC * -Cstore::cfgPathGetValues(CPATH *pref, bool active_cfg) -PREINIT: - Cpath arg_cpath; -CODE: - vector ret_strvec; - THIS->cfgPathGetValues(arg_cpath, ret_strvec, active_cfg); -OUTPUT: - RETVAL - - -bool -Cstore::cfgPathEffective(CPATH *pref) -PREINIT: - Cpath arg_cpath; -CODE: - RETVAL = THIS->cfgPathEffective(arg_cpath); -OUTPUT: - RETVAL - - -STRVEC * -Cstore::cfgPathGetEffectiveChildNodes(CPATH *pref) -PREINIT: - Cpath arg_cpath; -CODE: - vector ret_strvec; - THIS->cfgPathGetEffectiveChildNodes(arg_cpath, ret_strvec); -OUTPUT: - RETVAL - - -SV * -Cstore::cfgPathGetEffectiveValue(CPATH *pref) -PREINIT: - Cpath arg_cpath; -CODE: - string value; - if (THIS->cfgPathGetEffectiveValue(arg_cpath, value)) { - RETVAL = newSVpv(value.c_str(), 0); - } else { - XSRETURN_UNDEF; - } -OUTPUT: - RETVAL - - -STRVEC * -Cstore::cfgPathGetEffectiveValues(CPATH *pref) -PREINIT: - Cpath arg_cpath; -CODE: - vector ret_strvec; - THIS->cfgPathGetEffectiveValues(arg_cpath, ret_strvec); -OUTPUT: - RETVAL - - -bool -Cstore::cfgPathDeleted(CPATH *pref) -PREINIT: - Cpath arg_cpath; -CODE: - RETVAL = THIS->cfgPathDeleted(arg_cpath); -OUTPUT: - RETVAL - - -bool -Cstore::cfgPathAdded(CPATH *pref) -PREINIT: - Cpath arg_cpath; -CODE: - RETVAL = THIS->cfgPathAdded(arg_cpath); -OUTPUT: - RETVAL - - -bool -Cstore::cfgPathChanged(CPATH *pref) -PREINIT: - Cpath arg_cpath; -CODE: - RETVAL = THIS->cfgPathChanged(arg_cpath); -OUTPUT: - RETVAL - - -STRVEC * -Cstore::cfgPathGetDeletedChildNodes(CPATH *pref) -PREINIT: - Cpath arg_cpath; -CODE: - vector ret_strvec; - THIS->cfgPathGetDeletedChildNodes(arg_cpath, ret_strvec); -OUTPUT: - RETVAL - - -STRVEC * -Cstore::cfgPathGetDeletedValues(CPATH *pref) -PREINIT: - Cpath arg_cpath; -CODE: - vector ret_strvec; - THIS->cfgPathGetDeletedValues(arg_cpath, ret_strvec); -OUTPUT: - RETVAL - - -STRSTRMAP * -Cstore::cfgPathGetChildNodesStatus(CPATH *pref) -PREINIT: - Cpath arg_cpath; -CODE: - MapT ret_strstrmap; - THIS->cfgPathGetChildNodesStatus(arg_cpath, ret_strstrmap); -OUTPUT: - RETVAL - - -STRVEC * -Cstore::cfgPathGetValuesDA(CPATH *pref, bool active_cfg) -PREINIT: - Cpath arg_cpath; -CODE: - vector ret_strvec; - THIS->cfgPathGetValuesDA(arg_cpath, ret_strvec, active_cfg); -OUTPUT: - RETVAL - - -SV * -Cstore::cfgPathGetValueDA(CPATH *pref, bool active_cfg) -PREINIT: - Cpath arg_cpath; -CODE: - string value; - if (THIS->cfgPathGetValueDA(arg_cpath, value, active_cfg)) { - RETVAL = newSVpv(value.c_str(), 0); - } else { - XSRETURN_UNDEF; - } -OUTPUT: - RETVAL - - -STRVEC * -Cstore::cfgPathGetChildNodesDA(CPATH *pref, bool active_cfg) -PREINIT: - Cpath arg_cpath; -CODE: - vector ret_strvec; - THIS->cfgPathGetChildNodesDA(arg_cpath, ret_strvec, active_cfg); -OUTPUT: - RETVAL - - -bool -Cstore::cfgPathDeactivated(CPATH *pref, bool active_cfg) -PREINIT: - Cpath arg_cpath; -CODE: - RETVAL = THIS->cfgPathDeactivated(arg_cpath, active_cfg); -OUTPUT: - RETVAL - - -STRSTRMAP * -Cstore::cfgPathGetChildNodesStatusDA(CPATH *pref) -PREINIT: - Cpath arg_cpath; -CODE: - MapT ret_strstrmap; - THIS->cfgPathGetChildNodesStatusDA(arg_cpath, ret_strstrmap); -OUTPUT: - RETVAL - - -STRVEC * -Cstore::tmplGetChildNodes(CPATH *pref) -PREINIT: - Cpath arg_cpath; -CODE: - vector ret_strvec; - THIS->tmplGetChildNodes(arg_cpath, ret_strvec); -OUTPUT: - RETVAL - - -bool -Cstore::validateTmplPath(CPATH *pref, bool validate_vals) -PREINIT: - Cpath arg_cpath; -CODE: - RETVAL = THIS->validateTmplPath(arg_cpath, validate_vals); -OUTPUT: - RETVAL - - -STRSTRMAP * -Cstore::getParsedTmpl(CPATH *pref, bool allow_val) -PREINIT: - Cpath arg_cpath; -CODE: - MapT ret_strstrmap; - if (!THIS->getParsedTmpl(arg_cpath, ret_strstrmap, allow_val)) { - XSRETURN_UNDEF; - } -OUTPUT: - RETVAL - - -SV * -Cstore::cfgPathGetComment(CPATH *pref, bool active_cfg) -PREINIT: - Cpath arg_cpath; -CODE: - string comment; - if (THIS->cfgPathGetComment(arg_cpath, comment, active_cfg)) { - RETVAL = newSVpv(comment.c_str(), 0); - } else { - XSRETURN_UNDEF; - } -OUTPUT: - RETVAL - - -bool -Cstore::sessionChanged() -CODE: - RETVAL = THIS->sessionChanged(); -OUTPUT: - RETVAL - - -bool -Cstore::loadFile(char *filename) -CODE: - RETVAL = THIS->loadFile(filename); -OUTPUT: - RETVAL - - -bool -Cstore::inSession() -CODE: - RETVAL = THIS->inSession(); -OUTPUT: - RETVAL diff --git a/perl_dmod/Cstore/MANIFEST b/perl_dmod/Cstore/MANIFEST deleted file mode 100644 index 3f4f007..0000000 --- a/perl_dmod/Cstore/MANIFEST +++ /dev/null @@ -1,7 +0,0 @@ -Changes -Makefile.PL -MANIFEST -README -Cstore.xs -t/Cstore.t -lib/Cstore.pm diff --git a/perl_dmod/Cstore/Makefile.PL b/perl_dmod/Cstore/Makefile.PL deleted file mode 100644 index d3968f7..0000000 --- a/perl_dmod/Cstore/Makefile.PL +++ /dev/null @@ -1,88 +0,0 @@ -# Copyright (C) 2010 Vyatta, Inc. -# -# 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. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see . - -package MY; - -use 5.010000; -use ExtUtils::MakeMaker; - -my $PMOD_DIR = '$(SITEPREFIX)/share/perl5'; - -sub constants{ - my $self = shift; - my $orig_txt = $self->SUPER::constants(@_); - $orig_txt =~ s#= \$\(SITEPREFIX\)/(lib|share)/.*#= $PMOD_DIR#g; - return $orig_txt; -} - -sub c_o { - my $self = shift; - my $orig_txt = $self->SUPER::c_o(@_); - $orig_txt =~ s/\.c(\s)/.cpp$1/g; - return $orig_txt; -} - -sub xs_c { - my $self = shift; - my $orig_txt = $self->SUPER::xs_c(@_); - $orig_txt =~ s/\.c(\s)/.cpp$1/g; - return $orig_txt; -} - -sub xs_o { - my $self = shift; - my $orig_txt = $self->SUPER::xs_o(@_); - $orig_txt =~ s/\.c(\s)/.cpp$1/g; - return $orig_txt; -} - -sub install { - my $self = shift; - my $orig_txt = $self->SUPER::install(@_); - $orig_txt =~ s/pure_install doc_install/pure_install/g; - $orig_txt =~ s/\$\(INST_MAN3DIR\) .*/undef undef/g; - return $orig_txt; -} - -sub clean { - my $self = shift; - my $orig_txt = $self->SUPER::clean(@_); - $orig_txt =~ s/Cstore\.c\s/Cstore.cpp /g; - return $orig_txt; -} - -sub dynamic_lib { - my $self = shift; - my $orig_txt = $self->SUPER::dynamic_lib(@_); - $orig_txt =~ s/(\s)LD_RUN_PATH=\S+\s+/$1/g; - return $orig_txt; -} - -WriteMakefile( - NAME => 'Cstore', - VERSION_FROM => 'lib/Cstore.pm', - PREREQ_PM => {}, - ($] >= 5.005 ? - (ABSTRACT_FROM => 'lib/Cstore.pm', - AUTHOR => 'Vyatta ') : ()), - # note: MM will convert LIBS to absolute path in Makefile. - # => regenerate Makefile every time - LIBS => ['-L../../src/.libs -lvyatta-cfg'], - DEFINE => '', - INC => '-I../../src', - CC => 'g++', - PREFIX => '/opt/vyatta', - INSTALLDIRS => 'site', -); - diff --git a/perl_dmod/Cstore/README b/perl_dmod/Cstore/README deleted file mode 100644 index 84870fc..0000000 --- a/perl_dmod/Cstore/README +++ /dev/null @@ -1,33 +0,0 @@ -Cstore version 0.01 -========================== - -This module provides Perl bindings to the Vyatta Cstore library. - - -INSTALLATION - -This module is installed as part of the vyatta-cfg package. - - -DEPENDENCIES - -This module requires the Vyatta Cstore library. - - -COPYRIGHT AND LICENCE - -Copyright (C) 2010 Vyatta, Inc. - -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. - -You should have received a copy of the GNU General Public License -along with this program. If not, see . - - diff --git a/perl_dmod/Cstore/lib/Cstore.pm b/perl_dmod/Cstore/lib/Cstore.pm deleted file mode 100644 index 7cf2169..0000000 --- a/perl_dmod/Cstore/lib/Cstore.pm +++ /dev/null @@ -1,96 +0,0 @@ -# Copyright (C) 2010 Vyatta, Inc. -# -# 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. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see . - -package Cstore; - -use 5.010000; -use strict; -use warnings; - -require Exporter; -use AutoLoader qw(AUTOLOAD); - -our @ISA = qw(Exporter); - -# Items to export into callers namespace by default. Note: do not export -# names by default without a very good reason. Use EXPORT_OK instead. -# Do not simply export all your public functions/methods/constants. - -# This allows declaration use Cstore ':all'; -# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK -# will save memory. -our %EXPORT_TAGS = ( 'all' => [ qw( - -) ] ); - -our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); - -our @EXPORT = qw( - -); - -our $VERSION = '0.01'; - -require XSLoader; -XSLoader::load('Cstore', $VERSION); - -# Preloaded methods go here. - -# Autoload methods go after =cut, and are processed by the autosplit program. - -1; -__END__ -=head1 NAME - -Cstore - Perl binding for the Vyatta Cstore library - -=head1 SYNOPSIS - - use Cstore; - my $cstore = new Cstore; - -=head1 DESCRIPTION - -This module provides the Perl binding for the Vyatta Cstore library. - -=head2 EXPORT - -None by default. - -=head1 SEE ALSO - -For more information on the Cstore library, see the documentation and -source code for the main library. - -=head1 AUTHOR - -Vyatta, Inc. Eeng@vyatta.comE - -=head1 COPYRIGHT AND LICENSE - -Copyright (C) 2010 Vyatta, Inc. - -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. - -You should have received a copy of the GNU General Public License -along with this program. If not, see . - -=cut diff --git a/perl_dmod/Cstore/t/Cstore.t b/perl_dmod/Cstore/t/Cstore.t deleted file mode 100644 index 51d23ac..0000000 --- a/perl_dmod/Cstore/t/Cstore.t +++ /dev/null @@ -1,15 +0,0 @@ -# Before `make install' is performed this script should be runnable with -# `make test'. After `make install' it should work as `perl Cstore.t' - -######################### - -# change 'tests => 1' to 'tests => last_test_to_print'; - -use Test::More tests => 1; -BEGIN { use_ok('Cstore') }; - -######################### - -# Insert your test code below, the Test::More module is use()ed here so read -# its man page ( perldoc Test::More ) for help writing this test script. - diff --git a/perl_dmod/Cstore/typemap b/perl_dmod/Cstore/typemap deleted file mode 100644 index 8d6d178..0000000 --- a/perl_dmod/Cstore/typemap +++ /dev/null @@ -1,83 +0,0 @@ -# Copyright (C) 2010 Vyatta, Inc. -# -# 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. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see . - -Cstore * O_CPPOBJ -STRVEC * T_STRVEC_REF -CPATH * T_CPATH_REF -STRSTRMAP * T_STRSTRMAP_REF - - -############################################################ -OUTPUT -O_CPPOBJ - sv_setref_pv($arg, CLASS, (void *) $var); - -T_STRVEC_REF - AV *results; - results = (AV *) sv_2mortal((SV *) newAV()); - for (unsigned int i = 0; i < ret_strvec.size(); i++) { - av_push(results, newSVpv(ret_strvec[i].c_str(), 0)); - } - $arg = newRV((SV *) results); - -T_STRSTRMAP_REF - HV *href = (HV *) sv_2mortal((SV *) newHV()); - MapT::iterator it = ret_strstrmap.begin(); - for (; it != ret_strstrmap.end(); ++it) { - const char *key = (*it).first.c_str(); - const char *val = (*it).second.c_str(); - hv_store(href, key, strlen(key), newSVpv(val, 0), 0); - } - $arg = newRV((SV *) href); - - -############################################################ -INPUT -O_CPPOBJ - if (sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG)) { - $var = ($type) SvIV((SV *) SvRV($arg)); - } else { - warn(\"${Package}::$func_name(): $var is not a blessed SV reference\"); - XSRETURN_UNDEF; - } - -T_STRVEC_REF - { - int i = 0; - I32 num = 0; - if (!SvROK($arg) || SvTYPE(SvRV($arg)) != SVt_PVAV) { - XSRETURN_UNDEF; - } - num = av_len((AV *) SvRV($arg)); - /* if input array is empty, vector will be empty as well. */ - for (i = 0; i <= num; i++) { - string str = SvPV_nolen(*av_fetch((AV *) SvRV($arg), i, 0)); - arg_strvec.push_back(str); - } - } - -T_CPATH_REF - { - int i = 0; - I32 num = 0; - if (!SvROK($arg) || SvTYPE(SvRV($arg)) != SVt_PVAV) { - XSRETURN_UNDEF; - } - num = av_len((AV *) SvRV($arg)); - /* if input array is empty, path will be empty as well. */ - for (i = 0; i <= num; i++) { - arg_cpath.push(SvPV_nolen(*av_fetch((AV *) SvRV($arg), i, 0))); - } - } - diff --git a/perl_dmod/Makefile.am b/perl_dmod/Makefile.am deleted file mode 100644 index 6c12b35..0000000 --- a/perl_dmod/Makefile.am +++ /dev/null @@ -1,25 +0,0 @@ -PERL_MODS = Cstore - -# nop for all-local. make install will do a build anyway, so don't repeat -# the build here. -all-local: ; - -install-exec-local: - for pm in $(PERL_MODS); do \ - (cd $$pm; \ - perl Makefile.PL; \ - $(MAKE) $(AM_MAKEFLAGS) install); \ - done - -clean-local: - for pm in $(PERL_MODS); do \ - (cd $$pm; \ - perl Makefile.PL; \ - $(MAKE) $(AM_MAKEFLAGS) realclean); \ - done - -# nops -check-local: ; -install-data-local: ; -uninstall-local: ; - -- cgit v1.2.3