diff --git a/.gitignore b/.gitignore index ffadc6ab..7cba4a14 100644 --- a/.gitignore +++ b/.gitignore @@ -9,3 +9,4 @@ Makefile* Build _build blib +cover_db diff --git a/Build.PL b/Build.PL index b92eb6cd..9446b4d0 100644 --- a/Build.PL +++ b/Build.PL @@ -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 => [ # ], diff --git a/lib/SNMP/Info.pm b/lib/SNMP/Info.pm index 1d91863a..e216d7cd 100644 --- a/lib/SNMP/Info.pm +++ b/lib/SNMP/Info.pm @@ -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 diff --git a/xt/20_run.t b/xt/20_run.t new file mode 100644 index 00000000..f52fa62a --- /dev/null +++ b/xt/20_run.t @@ -0,0 +1,6 @@ +#!/usr/bin/env perl + +use strict; +use warnings; + +use Test::Class::Load qw; diff --git a/xt/lib/My/Test/Class.pm b/xt/lib/My/Test/Class.pm new file mode 100644 index 00000000..2e1300c5 --- /dev/null +++ b/xt/lib/My/Test/Class.pm @@ -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; + +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; diff --git a/xt/lib/SNMP/Info/Test.pm b/xt/lib/SNMP/Info/Test.pm new file mode 100644 index 00000000..96781d23 --- /dev/null +++ b/xt/lib/SNMP/Info/Test.pm @@ -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;