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