135/snmp-info
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'test-coverage'

Browse Source
This commit is contained in:
Eric A. Miller
2018-03-22 00:20:03 -04:00
parent e7fcd98107 f6d0fb1d7e
commit 27b310ee68
6 changed files with 999 additions and 19 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@@ -9,3 +9,4 @@ Makefile*
Build
_build
blib
cover_db

5
Build.PL
View File

@@ -27,6 +27,11 @@ Module::Build->new(
test_requires => {
'Test::More' => '0.88',
'Test::Distribution' => '0',
'Test::Class::Most' => '0',
'Test::MockObject::Extends' => '0',
'File::Find' => '0',
'Path::Class' => '0',
'File::Slurper' => '0',
},
# script_files => [
# ],

57
lib/SNMP/Info.pm
View File

@@ -1277,7 +1277,7 @@ sub new {
}
# Connects to device unless open session is provided.
$sess = new SNMP::Session(
$sess = SNMP::Session->new(
'UseEnums' => 1,
%sess_args, 'RetryNoSuch' => $new_obj->{nosuch}
) unless defined $sess;
@@ -1339,7 +1339,7 @@ sub update {
delete $sess_args{BigInt};
delete $sess_args{MibDirs};
my $sess = new SNMP::Session(
my $sess = SNMP::Session->new(
'UseEnums' => 1,
%sess_args, 'RetryNoSuch' => $obj->{nosuch}
);
@@ -2721,7 +2721,7 @@ sub _get_topo_data {
my $self = shift;
my $partial = shift;
my $topo_cap = shift;
my $method = shift;
my $method = shift || '';
return unless $method =~ /(ip|if|port|id|platform|cap)/;
@@ -3056,7 +3056,9 @@ the SNMP::Info methods.
'name' => 'sysName',
'location' => 'sysLocation',
'layers' => 'sysServices',
# IF-MIB
'ports' => 'ifNumber',
# IP-MIB
'ipforwarding' => 'ipForwarding',
);
@@ -3074,7 +3076,9 @@ ALTEON-TS-PHYSICAL-MIB::agPortCurCfgPortName.
=cut
%FUNCS = (
# IF-MIB::IfEntry
'interfaces' => 'ifIndex',
# IF-MIB::IfEntry
'i_name' => 'ifName',
# IF-MIB::IfEntry
@@ -3104,13 +3108,13 @@ ALTEON-TS-PHYSICAL-MIB::agPortCurCfgPortName.
# IF-MIB::IfStackTable
'i_stack_status' => 'ifStackStatus',
# IP Address Table
# IP::MIB::ipAddrTable (deprecated IPv4 address table)
'ip_index' => 'ipAdEntIfIndex',
'ip_table' => 'ipAdEntAddr',
'ip_netmask' => 'ipAdEntNetMask',
'ip_broadcast' => 'ipAdEntBcastAddr',
# ifXTable - Extension Table
# IF-MIB::ifXTable - Extension Table
'i_speed_high' => 'ifHighSpeed',
'i_pkts_multi_in' => 'ifInMulticastPkts',
'i_pkts_multi_out' => 'ifOutMulticastPkts',
@@ -3126,7 +3130,7 @@ ALTEON-TS-PHYSICAL-MIB::agPortCurCfgPortName.
'i_pkts_bcast_out64' => 'ifHCOutBroadcastPkts',
'i_alias' => 'ifAlias',
# IP Routing Table
# RFC-1213::ipRoute (deprecated Table IP Routing Table)
'ipr_route' => 'ipRouteDest',
'ipr_if' => 'ipRouteIfIndex',
'ipr_1' => 'ipRouteMetric1',
@@ -3157,7 +3161,13 @@ $info->init() will throw an exception if a MIB does not load.
%MIBS = (
# The "main" MIBs are automagically loaded in Net-SNMP now.
# Include these here for cases where the Net-SNMP default MIB list has
# been overridden during the compliation of the local Net-SNMP library.
# These cover the globals and funcs defined in this file.
'SNMPv2-MIB' => 'sysObjectID',
'RFC1213-MIB' => 'ipRouteIfIndex',
'IP-MIB' => 'ipAdEntAddr',
'IF-MIB' => 'ifIndex',
);
=item %MUNGE
@@ -4237,7 +4247,7 @@ sub _load_attr {
# partial fetch may strip the Module portion upon return. We need
# the match to make sure we didn't leave the table during getnext
# requests
my ($leaf) = $qual_leaf =~ /::(\w+)$/;
$self->debug()
@@ -4245,7 +4255,7 @@ sub _load_attr {
defined $partial ? "($partial)" : '', " : $oid" ,
defined $partial ? ".$partial" : '', "\n";
my $var = new SNMP::Varbind( [$qual_leaf, $partial] );
my $var = SNMP::Varbind->new( [$qual_leaf, $partial] );
# So devices speaking SNMP v.1 are not supposed to give out
# data from SNMP2, but most do. Net-SNMP, being very precise
@@ -4438,7 +4448,7 @@ sub snmp_connect_ip {
return if ( $ip eq '0.0.0.0' ) or ( $ip =~ /^127\./ );
# Create session object
my $snmp_test = new SNMP::Session(
my $snmp_test = SNMP::Session->new(
'DestHost' => $ip,
'Community' => $comm,
'Version' => $ver
@@ -4680,21 +4690,27 @@ sub can {
my $funcs = $self->funcs();
# We need to resolve funcs with a prefix or suffix
my $f_method = $method;
$f_method =~ s/^(load|orig)_//;
$f_method =~ s/_raw$//;
my $base_method = $method;
$base_method =~ s/^(load|orig)_//;
$base_method =~ s/_raw$//;
no strict 'refs'; ## no critic (ProhibitNoStrict )
# We could add load_/orig_/_raw alternatives to symbol table here on
# first call of any type for a global or func since they all use the same
# destination code, but they aren't used heavily in main code base so
# we’ll just create if/when they are called rather than pollute the
# symbol table with entries that never get called.
# Check for set_ ing.
if ( $method =~ /^set_/ ) {
return *{$AUTOLOAD} = _make_setter( $method, $oid, @_ );
return *{$method} = _make_setter( $method, $oid, @_ );
}
elsif ( defined $funcs->{$f_method} || $table ) {
return *{$AUTOLOAD} = _load_attr( $method, $oid, @_ );
elsif ( defined $funcs->{$base_method} || $table ) {
return *{$method} = _load_attr( $method, $oid, @_ );
}
else {
return *{$AUTOLOAD} = _global( $method, $oid );
return *{$method} = _global( $method, $oid );
}
}
@@ -4734,12 +4750,12 @@ subclass.
=cut
our $AUTOLOAD;
sub AUTOLOAD {
my $self = shift;
my ($sub_name) = $AUTOLOAD =~ /::(\w+)$/;
return if $sub_name =~ /DESTROY$/;
# Typos in function calls in SNMP::Info subclasses turn into
# AUTOLOAD requests for non-methods. While this is deprecated,
# we'll still get called, so report a less confusing error.
@@ -4766,6 +4782,9 @@ sub AUTOLOAD {
}
# Skip AUTOLOAD()
sub DESTROY {}
1;
=head1 COPYRIGHT AND LICENSE

6
xt/20_run.t Normal file
View File

@@ -0,0 +1,6 @@
#!/usr/bin/env perl
use strict;
use warnings;
use Test::Class::Load qw<xt/lib>;

271
xt/lib/My/Test/Class.pm Normal file
View File

@@ -0,0 +1,271 @@
# My::Test::Class
#
# Copyright (c) 2018 Eric Miller
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# * Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
# * Neither the name of the University of California, Santa Cruz nor the
# names of its contributors may be used to endorse or promote products
# derived from this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
# LIABLE FOR # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
package My::Test::Class;
use Test::Class::Most attributes => [qw/class mock_session test_obj/];
use Test::MockObject::Extends;
use File::Find 'find';
use Path::Class 'dir';
use File::Slurper 'read_lines';
use base qw<Test::Class Class::Data::Inheritable>;
INIT { Test::Class->runtests }
my $EMPTY = q{};
sub startup : Tests( startup => 1 ) {
my $test = shift;
(my $class = ref $test) =~ s/::Test$//x;
return ok 1, "$class loaded" if $class eq __PACKAGE__;
use_ok $class or die;
$test->class($class);
$test->mock_session(create_mock_session());
return;
}
sub shutdown : Tests(shutdown) { }
sub setup : Tests(setup) {
my $test = shift;
my $class = $test->class;
my $sess = $test->mock_session;
$test->{info}
= $class->new('AutoSpecify' => 0, 'BulkWalk' => 0, 'Session' => $sess,);
}
sub teardown : Tests(teardown) { my $test = shift; $test->{info} = undef; }
sub create_mock_session {
my $home = dir($ENV{HOME}, 'netdisco-mibs');
local $ENV{'SNMPCONFPATH'} = $EMPTY;
local $ENV{'MIBDIRS'} = $EMPTY;
local $ENV{'MIBS'} = $EMPTY;
local $ENV{'SNMP_PERSISTENT_DIR'} = $home;
SNMP::initMib();
my @mibdirs = _build_mibdirs();
foreach my $d (@mibdirs) {
next unless -d $d;
SNMP::addMibDirs($d);
}
my $session = SNMP::Session->new(
UseEnums => 1,
RetryNoSuch => 1,
DestHost => '127.0.0.1',
Community => 'public',
Version => 2,
# Hold simulated data for mock sessions
Data => {},
);
my $mock_session = Test::MockObject::Extends->new($session);
mock_get($mock_session);
mock_getnext($mock_session);
mock_set($mock_session);
return $mock_session;
}
sub _build_mibdirs {
my $home = dir($ENV{HOME}, 'netdisco-mibs');
return map { dir($home, $_)->stringify } @{_get_mibdirs_content($home)};
}
sub _get_mibdirs_content {
my $home = shift;
my @list
= map { s|$home/||; $_ } grep {m/[a-z0-9]/} grep {-d} glob("$home/*");
return \@list;
}
sub mock_get {
my $mock_session = shift;
$mock_session->mock(
'get',
sub {
my $self = shift;
my $vars = shift;
my ($leaf, $iid, $oid, $oid_name);
my $c_data = $self->{Data};
# From SNMP::Info get will only be passed either an OID or
# SNMP::Varbind with a fully qualified leaf and potentially
# a partial
if (ref($vars) =~ /SNMP::Varbind/x) {
($leaf, $iid) = @{$vars};
}
else {
$oid = $vars;
$oid_name = SNMP::translateObj($oid, 0, 1) || $EMPTY;
($leaf, $iid) = $oid_name =~ /^(\S+::\w+)[.]?(\S+)*$/x;
}
$iid ||= 0;
my $new_iid = $iid;
my $val = $EMPTY;
my $data = $c_data->{$leaf} || {};
my $count = scalar keys %{$data} || 0;
if ($count > 1) {
my $found = 0;
foreach my $d_iid (sort keys %{$data}) {
if ($d_iid eq $iid) {
$val = $data->{$d_iid};
$found = 1;
next;
}
elsif ($found == 1) {
$new_iid = $d_iid;
last;
}
}
if ($found && ($new_iid eq $iid)) {
$leaf = 'unknown';
}
}
else {
$val = $data->{$iid};
$leaf = 'unknown';
}
if (ref $vars =~ /SNMP::Varbind/x) {
$vars->[0] = $leaf;
$vars->[1] = $new_iid;
$vars->[2] = $val;
}
return (wantarray() ? $vars : $val);
}
);
return;
}
sub mock_getnext {
my $mock_session = shift;
$mock_session->mock(
'getnext',
sub {
my $self = shift;
my $vars = shift;
my ($leaf, $iid, $oid, $oid_name);
my $c_data = $self->{Data};
# From SNMP::Info getnext will only be passed a SNMP::Varbind
# with a fully qualified leaf and potentially a partial
($leaf, $iid) = @{$vars};
# If we captured data using OIDs printed numerically -On option,
# we need to convert the leaf to an OID for match
my $leaf_oid = SNMP::translateObj($leaf, 0, 1) || '';
unless (defined $iid) {
$iid = -1;
}
my $new_iid = $iid;
my $val = $EMPTY;
my $data = $c_data->{$leaf} || $c_data->{$leaf_oid};
my $count = scalar keys %{$data} || 0;
if ($count) {
my $found = 0;
foreach my $d_iid (sort keys %{$data}) {
if ($d_iid gt $iid && !$found) {
$val = $data->{$d_iid};
$new_iid = $d_iid;
$found = 1;
next;
}
elsif ($found == 1) {
last;
}
}
if ($found && ($new_iid eq $iid)) {
$leaf = 'unknown';
}
}
else {
$val = $data->{$iid};
$leaf = 'unknown';
}
$vars->[0] = $leaf;
$vars->[1] = $new_iid;
$vars->[2] = $val;
return (wantarray() ? $vars : $val);
}
);
return;
}
# For testing purposes assume sets worked
sub mock_set {1}
# Utility to load snmpwalk from a file to use for mock sessions
sub load_snmpdata {
my $test = shift;
my $data_file = shift;
my @lines = read_lines($data_file);
my $snmp_data = {};
foreach my $line (@lines) {
next if !$line;
next if ($line =~ /^#/);
if ($line =~ /^(\S+::\w+)[.]?(\S+)*\s=\s(.*)$/x) {
my ($leaf, $iid, $val) = ($1, $2, $3);
next if !$leaf;
$iid ||= 0;
$val =~ s/\"//g;
$snmp_data->{$leaf}->{$iid} = $val;
}
}
return $snmp_data;
}
# Grab the symbol table for verification that
# dynamic methods via AUTOLOAD and can() have been inserted
sub symbols {
my $test = shift;
my $class = $test->class;
{
no strict 'refs'; ## no critic (ProhibitNoStrict)
return \%{$class . '::'};
}
}
1;

678
xt/lib/SNMP/Info/Test.pm Normal file
View File

@@ -0,0 +1,678 @@
# SNMP::Info::Test
#
# Copyright (c) 2018 Eric Miller
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# * Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
# * Neither the name of the University of California, Santa Cruz nor the
# names of its contributors may be used to endorse or promote products
# derived from this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
# LIABLE FOR # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
package SNMP::Info::Test;
use Test::Class::Most parent => 'My::Test::Class';
use SNMP::Info;
sub _constructor : Tests(11) {
my $test = shift;
my $class = $test->class;
my $sess = $test->mock_session;
can_ok $class, 'new';
isa_ok $test->{info}, $class, '... and the object it returns';
is(defined $test->{info}{init}, 1, 'mibs initialized');
ok(
scalar keys %{$test->{info}{mibs}},
'mibs subclass data structure initialized'
);
ok(
scalar keys %{$test->{info}{globals}},
'globals subclass data structure initialized'
);
ok(
scalar keys %{$test->{info}{funcs}},
'funcs subclass data structure initialized'
);
ok(
scalar keys %{$test->{info}{munge}},
'munge subclass data structure initialized'
);
is_deeply($test->{info}{store}, {}, 'store initialized');
is($test->{info}{snmp_comm}, 'public', 'snmp comm arg saved');
is($test->{info}{snmp_ver}, 2, 'snmp version arg saved');
is($test->{info}{snmp_user}, 'initial', 'snmp user arg saved');
}
sub globals : Tests(2) {
my $test = shift;
can_ok($test->{info}, 'globals');
subtest 'Globals can() subtest' => sub {
my $test_globals = $test->{info}->globals;
foreach my $key (keys %$test_globals) {
can_ok($test->{info}, $key);
}
};
}
sub funcs : Tests(2) {
my $test = shift;
can_ok($test->{info}, 'funcs');
subtest 'Funcs can() subtest' => sub {
my $test_funcs = $test->{info}->funcs;
foreach my $key (keys %$test_funcs) {
can_ok($test->{info}, $key);
}
};
}
# update() needs to be reworked to discard all args except community
# or context as described in documentation
sub update : Tests(4) {
my $test = shift;
# Starting community
is($test->{info}{sess}{Community}, 'public', 'original community');
# Change community
$test->{info}->update('Community' => 'new_community',);
is($test->{info}{sess}{Community}, 'new_community', 'community changed');
# Starting context
is($test->{info}{sess}{Context}, '', 'original context');
# Change context
$test->{info}->update('Context' => 'new_context',);
is($test->{info}->{sess}->{Context}, 'new_context', 'context changed');
}
sub cache_and_clear_cache : Tests(9) {
my $test = shift;
# Isolate tests to cache method. Populated structure of global 'name' and
# func 'i_description'
my $cache_data = {
'_name' => 'Test-Name',
'_i_description' => 1,
'store' => {
'i_description' =>
{10 => 'Test-Description-10', 20 => 'Test-Description-20'}
}
};
# The empty store hash exists upon initialization and remains when the cache
# is cleared.
my $empty_cache = {'store' => {}};
can_ok($test->{info}, 'cache');
cmp_deeply($empty_cache, $test->{info}->cache(), 'cache starts empty');
ok($test->{info}->cache($cache_data), 'insert test data into cache');
cmp_deeply(
$cache_data,
$test->{info}->cache(),
'cache method returns test data'
);
is($test->{info}->name(),
'Test-Name', 'global method call returned cached data');
cmp_deeply(
$test->{info}->i_description(),
$cache_data->{store}{i_description},
'funcs method call returned cached data'
);
can_ok($test->{info}, 'clear_cache');
ok($test->{info}->clear_cache(), 'cache cleared');
cmp_deeply(
$empty_cache,
$test->{info}->cache(),
'no cached data returned after clear_cache method call'
);
}
sub debug : Tests(4) {
my $test = shift;
can_ok($test->{info}, 'debug');
ok(
defined $test->{info}{debug}
&& $test->{info}{debug} == 0
&& $test->{info}->debug() == 0,
'debug initialized off'
);
$test->{info}->debug(1);
ok($test->{info}{debug} && $test->{info}->debug(), 'debug on');
$test->{info}->debug(0);
ok($test->{info}{debug} == 0 && $test->{info}->debug() == 0, 'debug off');
}
sub offline : Tests(4) {
my $test = shift;
can_ok($test->{info}, 'offline');
ok(!defined $test->{info}{Offline}, 'offline not initialized');
$test->{info}->offline(1);
ok($test->{info}{Offline} && $test->{info}->offline(), 'offline mode on');
$test->{info}->offline(0);
ok($test->{info}{Offline} == 0 && $test->{info}->offline() == 0,
'offline off');
}
sub bulkwalk : Tests(4) {
my $test = shift;
can_ok $test->{info}, 'bulkwalk';
# Test harness initalizes BulkWalk off, if we didn't provide an arg
# it would not be defined.
ok(
!defined $test->{info}{BulkWalk}
|| ($test->{info}{BulkWalk} == 0 && $test->{info}->bulkwalk() == 0),
'bulkwalk initialized off'
);
$test->{info}->bulkwalk(1);
ok($test->{info}{BulkWalk} && $test->{info}->bulkwalk(), 'bulkwalk on');
$test->{info}->bulkwalk(0);
ok($test->{info}{BulkWalk} == 0 && $test->{info}->bulkwalk() == 0,
'bulkwalk off');
}
sub loopdetect : Tests(4) {
my $test = shift;
can_ok $test->{info}, 'loopdetect';
ok(!defined $test->{info}{LoopDetect}, 'loopdetect not initialized');
$test->{info}->loopdetect(1);
ok($test->{info}{LoopDetect} && $test->{info}->loopdetect(), 'loopdetect on');
$test->{info}->loopdetect(0);
ok($test->{info}{LoopDetect} == 0 && $test->{info}->loopdetect() == 0,
'loopdetect off');
}
sub device_type : Tests(8) {
my $test = shift;
can_ok($test->{info}, 'device_type');
# Empty args and no SNMP data should result in undef
is($test->{info}->device_type(),
undef, 'No sysServices, no sysDescr results in undef');
# Populate cache for tests rather than mocking session to limit code hit
# on these tests
my $cache_data
= {'_layers' => '00000000', '_description' => 'My-Test-sysDescr',};
$test->{info}->cache($cache_data);
is($test->{info}->device_type(),
'SNMP::Info', 'No sysServices and unknown sysDescr results in SNMP::Info');
$test->{info}->debug(1);
warnings_like { $test->{info}->device_type() }
[{carped => qr/Might give unexpected results/i}],
'No sysServices and unknown sysDescr with debug on gives warning';
$test->{info}->debug(0);
$test->{info}->clear_cache();
# Test one oid per layer hash just to verify oid mapping, no need to test
# every hash key - chose an id that is unique per layer
# Layer 3
$cache_data = {
'_layers' => 4,
'_description' => 'My-Test-sysDescr',
'_id' => '.1.3.6.1.4.1.18'
};
$test->{info}->cache($cache_data);
is($test->{info}->device_type,
'SNMP::Info::Layer3::BayRS', 'Layer 3 device type by sysObjectID');
$test->{info}->clear_cache();
# Layer 2
$cache_data = {
'_layers' => 2,
'_description' => 'My-Test-sysDescr',
'_id' => '.1.3.6.1.4.1.11898'
};
$test->{info}->cache($cache_data);
is($test->{info}->device_type,
'SNMP::Info::Layer2::Orinoco', 'Layer 2 device type by sysObjectID');
$test->{info}->clear_cache();
# Layer 1
$cache_data = {
'_layers' => 1,
'_description' => 'My-Test-sysDescr',
'_id' => '.1.3.6.1.4.1.2925'
};
$test->{info}->cache($cache_data);
is(
$test->{info}->device_type,
'SNMP::Info::Layer1::Cyclades',
'Layer 1 device type by sysObjectID'
);
$test->{info}->clear_cache();
# Layer 7
$cache_data = {
'_layers' => 64,
'_description' => 'My-Test-sysDescr',
'_id' => '.1.3.6.1.4.1.318'
};
$test->{info}->cache($cache_data);
is($test->{info}->device_type,
'SNMP::Info::Layer7::APC', 'Layer 1 device type by sysObjectID');
$test->{info}->clear_cache();
# Add Regex tests if needed
}
sub error : Tests(7) {
my $test = shift;
can_ok($test->{info}, 'error');
ok(!exists $test->{info}{error}, 'Error not present');
$test->{info}{error} = 'Test Error';
is($test->{info}->error(), 'Test Error', 'Test Error present');
is($test->{info}->error(), undef, 'Test Error cleared upon read');
$test->{info}{error} = 'Test Error 2';
is($test->{info}->error(1),
'Test Error 2', 'Test Error 2 present and no clear flag set');
is($test->{info}->error(0),
'Test Error 2', 'Test Error 2 still present on next read');
is($test->{info}->error(),
undef, 'Test Error 2 cleared upon read with flag set to false');
}
sub has_layer : Tests(6) {
my $test = shift;
can_ok $test->{info}, 'has_layer';
$test->{info}->clear_cache();
# Populate cache, one key/value so don't bother going through the
# cache() method.
# Layers holds the unmunged value (decimal)
$test->{info}{'_layers'} = 1;
is($test->{info}->has_layer(1), 1, 'Has layer 1');
$test->{info}{'_layers'} = 2;
is($test->{info}->has_layer(2), 1, 'Has layer 2');
$test->{info}{'_layers'} = 4;
is($test->{info}->has_layer(3), 1, 'Has layer 3');
# We don't use layers 4-6 for classification, skip testing
$test->{info}{'_layers'} = 64;
is($test->{info}->has_layer(7), 1, 'Has layer 7');
# Check for undef layers
$test->{info}{'_layers'} = undef;
is($test->{info}->has_layer(7), undef, 'Undef layers returns undef');
}
sub snmp_comm : Tests(4) {
my $test = shift;
can_ok $test->{info}, 'snmp_comm';
# Define before test to be sure instead of relying on initalization
$test->{info}{snmp_comm} = 'publicv1';
$test->{info}{snmp_ver} = 1;
is($test->{info}->snmp_comm(), 'publicv1',
'Version 1 returns SNMP community');
$test->{info}{snmp_comm} = 'publicv2';
$test->{info}{snmp_ver} = 2;
is($test->{info}->snmp_comm(), 'publicv2',
'Version 2 returns SNMP community');
$test->{info}{snmp_user} = 'initialv3';
$test->{info}{snmp_ver} = 3;
is($test->{info}->snmp_comm(), 'initialv3', 'Version 3 returns SNMP user');
}
sub snmp_ver : Tests(2) {
my $test = shift;
can_ok $test->{info}, 'snmp_ver';
# Define before test to be sure instead of relying on initalization
$test->{info}{snmp_ver} = 1;
is($test->{info}->snmp_ver(), 1, 'SNMP version returned');
}
sub specify : Tests(4) {
my $test = shift;
can_ok $test->{info}, 'specify';
$test->{info}->cache_clear();
# Specify uses device_type(), use same data as that test to setup
# test cases here since return values from device_type() with them
# have been tested
# device_type returns undef
$test->{info}->specify();
is(
$test->{info}->error(),
'SNMP::Info::specify() - Could not get info from device',
'Undef device type throws error'
);
$test->{info}->cache_clear();
# Populate cache for following tests
my $cache_data
= {'_layers' => '00000000', '_description' => 'My-Test-sysDescr',};
$test->{info}->cache($cache_data);
isa_ok($test->{info}->specify(),
'SNMP::Info', 'SNMP::Info device_type returns self');
$test->{info}->cache_clear();
# Layer 7 - SNMP::Info::Layer7::APC
$cache_data = {
'_layers' => 64,
'_description' => 'My-Test-sysDescr',
'_id' => '.1.3.6.1.4.1.318'
};
$test->{info}->cache($cache_data);
isa_ok($test->{info}->specify(),
'SNMP::Info::Layer7::APC',
'Layer 7 device type returns new object of same type');
$test->{info}->clear_cache();
}
sub cisco_comm_indexing : Tests(2) {
my $test = shift;
can_ok $test->{info}, 'cisco_comm_indexing';
is($test->{info}->cisco_comm_indexing(), 0, 'Cisco community indexing off');
}
sub if_ignore : Tests(2) {
my $test = shift;
can_ok $test->{info}, 'if_ignore';
is_deeply($test->{info}->if_ignore(),
{}, 'No ignored interfaces for this class');
}
sub bulkwalk_no : Tests(2) {
my $test = shift;
can_ok $test->{info}, 'bulkwalk_no';
is($test->{info}->bulkwalk_no(), 0, 'Bulkwalk not turned off in this class');
}
sub i_speed : Tests(2) {
my $test = shift;
can_ok $test->{info}, 'i_speed';
# Method uses partial fetches which ignores the cache and reloads data
# therefore we must use the mocked session. Populate the session data
# so that the mock_getnext() has data to fetch.
my $data = {
# Need to use OID for ifSpeed since it could resolve to a fully qualified
# name as either RFC1213-MIB::ifSpeed or IF-MIB::ifSpeed dependent upon
# which MIB got loaded last which is based upon random hash ordering. Using
# a fully qualified name with mock session we would need to know which MIB
# "owned" the OID since the MIB hash is indexed by OID. This is not an
# issue in live code since what is fed to getnext for a fully qualified
# name is what is returned.
'.1.3.6.1.2.1.2.2.1.5' => {38 => 0, 49 => 4294967295, 501 => 1000000000,},
'IF-MIB::ifHighSpeed' => {38 => 0, 49 => 32000, 501 => 1000,},
};
my $expected = {38 => 0, 49 => '32 Gbps', 501 => '1.0 Gbps',};
$test->{info}{sess}{Data} = $data;
is_deeply($test->{info}->i_speed(),
$expected, 'High speed interface reported accurately');
}
sub i_speed_raw : Tests(3) {
my $test = shift;
can_ok $test->{info}, 'i_speed_raw';
# Method uses partial fetches which ignores the cache and reloads data
# therefore we must use the mocked session. Populate the session data
# so that the mock_getnext() has data to fetch.
my $data = {
# Need to use OID for ifSpeed since it could resolve to a fully qualified
# name as either RFC1213-MIB::ifSpeed or IF-MIB::ifSpeed dependent upon
# which MIB got loaded last which is based upon random hash ordering. Using
# a fully qualified name with mock session we would need to know which MIB
# "owned" the OID since the MIB hash is indexed by OID. This is not an
# issue in live code since what is fed to getnext for a fully qualified
# name is what is returned.
'.1.3.6.1.2.1.2.2.1.5' => {38 => 0, 49 => 4294967295, 501 => 1000000000,},
'IF-MIB::ifHighSpeed' => {38 => 0, 49 => 32000, 501 => 1000,},
};
my $expected = {38 => 0, 49 => '32 Gbps', 501 => '1.0 Gbps',};
my $expected_raw = {38 => 0, 49 => 32000000000, 501 => 1000000000,};
$test->{info}{sess}{Data} = $data;
is_deeply($test->{info}->i_speed_raw(),
$expected_raw, 'Raw high speed interface reported accurately');
# Note the cache is populated unmunged data now - not sure if that is
# expected behavior. Clear cache to get data to test that munges are restored.
$test->{info}->clear_cache();
is_deeply($test->{info}->i_speed(),
$expected, 'Munges restored after i_speed_raw() call');
}
# Topo routines will need to be tested in sub classes for conditionals
sub has_topo : Tests(2) {
my $test = shift;
can_ok($test->{info}, 'has_topo');
is($test->{info}->has_topo(), undef, 'Base class has no topo');
}
sub get_topo_data : Tests(2) {
my $test = shift;
can_ok($test->{info}, '_get_topo_data');
is($test->{info}->_get_topo_data(), undef, 'Base class has no topo data');
}
sub c_ip : Tests(2) {
my $test = shift;
can_ok($test->{info}, 'c_ip');
is($test->{info}->c_ip(), undef, 'Base class has no topo');
}
sub c_if : Tests(2) {
my $test = shift;
can_ok($test->{info}, 'c_if');
is($test->{info}->c_if(), undef, 'Base class has no topo');
}
sub c_port : Tests(2) {
my $test = shift;
can_ok($test->{info}, 'c_port');
is($test->{info}->c_port(), undef, 'Base class has no topo');
}
sub c_id : Tests(2) {
my $test = shift;
can_ok($test->{info}, 'c_id');
is($test->{info}->c_id(), undef, 'Base class has no topo');
}
sub c_platform : Tests(2) {
my $test = shift;
can_ok($test->{info}, 'c_platform');
is($test->{info}->c_platform(), undef, 'Base class has no topo');
}
sub c_cap : Tests(2) {
my $test = shift;
can_ok($test->{info}, 'c_cap');
is($test->{info}->c_cap(), undef, 'Base class has no topo');
}
# Munges aren't methods, the are functions so calling convention is different
sub munge_speed : Tests(2) {
my $test = shift;
can_ok($test->{info}, 'munge_speed');
is(SNMP::Info::munge_speed('2488000000'),
'OC-48', 'Speed munged according to map');
}
sub munge_highspeed : Tests(6) {
my $test = shift;
can_ok($test->{info}, 'munge_highspeed');
is(SNMP::Info::munge_highspeed('15000000'), '15 Tbps', 'Tbps munge');
is(SNMP::Info::munge_highspeed('1500000'),
'1.5 Tbps', 'Fractional Tbps munge');
is(SNMP::Info::munge_highspeed('15000'), '15 Gbps', 'Gbps munge');
is(SNMP::Info::munge_highspeed('1500'), '1.5 Gbps', 'Fractional Gbps munge');
is(SNMP::Info::munge_highspeed('100'), '100 Mbps', 'Mbps munge');
}
sub munge_ip : Tests(2) {
my $test = shift;
can_ok($test->{info}, 'munge_ip');
my $test_ip = pack("C4", split /\./, "123.4.5.6");
is(SNMP::Info::munge_ip($test_ip),
"123.4.5.6", 'Binary IP to dotted ASCII munge');
}
sub munge_mac : Tests(3) {
my $test = shift;
can_ok($test->{info}, 'munge_mac');
# The munge expects an octet string, pack a decimal string into
# representation munge is expecting
my $test_mac = pack("C*", split /\./, "01.35.69.103.137.171");
is(SNMP::Info::munge_mac($test_mac),
"01:23:45:67:89:ab", 'Octet string to colon separated ASCII hex string');
my $bogus_mac = pack("C*", split /\./, "01.35.69.103.137.171.02");
is(SNMP::Info::munge_mac($bogus_mac), undef,
'Bad octet string returns undef');
}
sub munge_prio_mac : Tests(3) {
my $test = shift;
can_ok($test->{info}, 'munge_prio_mac');
# The munge expects an octet string, pack a decimal string into
# representation munge is expecting
my $test_mac = pack("C*", split /\./, "01.35.69.103.137.171.205.239");
is(SNMP::Info::munge_prio_mac($test_mac),
"01:23:45:67:89:ab:cd:ef",
'Octet string to colon separated ASCII hex string');
my $bogus_mac = pack("C*", split /\./, "01.35.69.103.137.171.205.239.02");
is(SNMP::Info::munge_prio_mac($bogus_mac),
undef, 'Bad octet string returns undef');
}
sub munge_prio_port : Tests(3) {
my $test = shift;
can_ok($test->{info}, 'munge_prio_port');
# The munge expects an octet string, pack a decimal string into
# representation munge is expecting
my $test_mac = pack("C*", split /\./, "171.205");
is(SNMP::Info::munge_prio_port($test_mac),
"ab:cd", 'Octet string to colon separated ASCII hex string');
my $bogus_mac = pack("C*", split /\./, "171.205.02");
is(SNMP::Info::munge_prio_port($bogus_mac),
undef, 'Bad octet string returns undef');
}
# Can't see where this code is actually used, remove?
sub munge_octet2hex : Tests(2) {
my $test = shift;
can_ok($test->{info}, 'munge_octet2hex');
# The munge expects an octet string, pack a decimal string into
# representation munge is expecting
my $test_mac = pack("C*", split /\./, "171.205");
is(SNMP::Info::munge_octet2hex($test_mac),
"abcd", 'Octet string to ASCII hex string');
}
sub munge_dec2bin : Tests(2) {
my $test = shift;
can_ok($test->{info}, 'munge_dec2bin');
# This is layers munge, use L3 test case
is(SNMP::Info::munge_dec2bin(4), '00000100', 'Binary char to ASCII binary');
}
sub munge_bits : Tests(2) {
my $test = shift;
can_ok($test->{info}, 'munge_bits');
my $bits = pack("B*", '00010110');
is(SNMP::Info::munge_bits($bits),
'00010110', 'SNMP2 BITS field to ASCII bit string');
}
# TODO
#sub munge_counter64 : Tests() {
# my $test = shift;
#
#}
sub munge_i_up : Tests(4) {
my $test = shift;
can_ok($test->{info}, 'munge_i_up');
is(SNMP::Info::munge_i_up(), undef, 'No arg returns undef');
is(SNMP::Info::munge_i_up(4), 'unknown', 'Unknown status');
is(SNMP::Info::munge_i_up(7), 'lowerLayerDown', 'Lower layer down status');
}
1;