272 lines
7.2 KiB
Perl
272 lines
7.2 KiB
Perl
# 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;
|