Files
netdisco/lib/App/Netdisco/Transport/SNMP.pm

364 lines
11 KiB
Perl
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

package App::Netdisco::Transport::SNMP;
use Dancer qw/:syntax :script/;
use Dancer::Plugin::DBIC 'schema';
use App::Netdisco::Util::SNMP 'get_communities';
use App::Netdisco::Util::Device 'get_device';
use App::Netdisco::Util::Permission 'acl_matches';
use SNMP::Info;
use Try::Tiny;
use Module::Load ();
use Storable 'thaw';
use File::Slurper 'read_text';
use MIME::Base64 'decode_base64';
use Path::Class 'dir';
use File::Path 'make_path';
use File::Spec::Functions qw(catdir catfile);
use NetAddr::IP::Lite ':lower';
use List::Util qw/pairkeys pairfirst/;
use base 'Dancer::Object::Singleton';
=head1 NAME
App::Netdisco::Transport::SNMP
=head1 DESCRIPTION
Singleton for SNMP connections. Returns cached L<SNMP::Info> instance for a
given device IP, or else undef. All methods are class methods, for example:
my $snmp = App::Netdisco::Transport::SNMP->reader_for( ... );
=cut
__PACKAGE__->attributes(qw/ readers writers /);
sub init {
my ( $class, $self ) = @_;
$self->readers( {} );
$self->writers( {} );
return $self;
}
=head1 reader_for( $ip, $useclass? )
Given an IP address, returns an L<SNMP::Info> instance configured for and
connected to that device. The IP can be any on the device, and the management
interface will be connected to.
If the device is known to Netdisco and there is a cached SNMP community
string, that community will be tried first, and then other community strings
from the application configuration will be tried.
If C<$useclass> is provided, it will be used as the L<SNMP::Info> device
class instead of the class in the Netdisco database.
Returns C<undef> if the connection fails.
=cut
sub reader_for {
my ($class, $ip, $useclass) = @_;
my $device = get_device($ip) or return undef;
my $pseudo_cache = catfile( catdir(($ENV{NETDISCO_HOME} || $ENV{HOME}), 'logs', 'snapshots'), $device->ip );
if ($device->in_storage and $device->is_pseudo and ! -f $pseudo_cache) {
error sprintf 'transport error - cannot act on pseudo-device [%s] without offline cache', $device->ip;
return undef;
}
my $readers = $class->instance->readers or return undef;
return $readers->{$device->ip} if exists $readers->{$device->ip};
debug sprintf 'snmp reader cache warm: [%s]', $device->ip;
return ($readers->{$device->ip}
= _snmp_connect_generic('read', $device, $useclass));
}
=head1 test_connection( $ip )
Similar to C<reader_for> but will use the literal IP address passed, and does
not support specifying the device class. The purpose is to test the SNMP
connectivity to the device before a renumber.
Attempts to have no side effect, however there will be a stored SNMP
authentication hint (tag) in the database if the connection is successful.
Returns C<undef> if the connection fails.
=cut
sub test_connection {
my ($class, $ip) = @_;
my $addr = NetAddr::IP::Lite->new($ip) or return undef;
# avoid renumbering to localhost loopbacks
return undef if $addr->addr eq '0.0.0.0'
or acl_matches($addr->addr, 'group:__LOOPBACK_ADDRESSES__');
my $device = schema(vars->{'tenant'})->resultset('Device')
->new_result({ ip => $addr->addr }) or return undef;
my $readers = $class->instance->readers or return undef;
return $readers->{$device->ip} if exists $readers->{$device->ip};
debug sprintf 'snmp reader cache warm: [%s]', $device->ip;
return ($readers->{$device->ip} = _snmp_connect_generic('read', $device));
}
=head1 writer_for( $ip, $useclass? )
Same as C<reader_for> but uses the read-write community strings from the
application configuration file.
Returns C<undef> if the connection fails.
=cut
sub writer_for {
my ($class, $ip, $useclass) = @_;
my $device = get_device($ip) or return undef;
return undef if $device->in_storage and $device->is_pseudo;
my $writers = $class->instance->writers or return undef;
return $writers->{$device->ip} if exists $writers->{$device->ip};
debug sprintf 'snmp writer cache warm: [%s]', $device->ip;
return ($writers->{$device->ip}
= _snmp_connect_generic('write', $device, $useclass));
}
sub _snmp_connect_generic {
my ($mode, $device, $useclass) = @_;
$mode ||= 'read';
my %snmp_args = (
AutoSpecify => 0,
DestHost => $device->ip,
# the defined() allows 0 to be a settable value
Retries => defined(setting('snmpretries')) ? setting('snmpretries') : 2,
Timeout => (setting('snmptimeout') || 1000000),
NonIncreasing => (setting('nonincreasing') || 0),
BulkWalk => ((defined setting('bulkwalk_off') && setting('bulkwalk_off'))
? 0 : 1),
BulkRepeaters => (setting('bulkwalk_repeaters') || 20),
MibDirs => [ _build_mibdirs() ],
IgnoreNetSNMPConf => 1,
Debug => ($ENV{INFO_TRACE} || 0),
DebugSNMP => ($ENV{SNMP_TRACE} || 0),
);
# an override for RemotePort
($snmp_args{RemotePort}) =
(pairkeys pairfirst { acl_matches($device, $b) }
%{setting('snmp_remoteport') || {}}) || 161;
# an override for bulkwalk
$snmp_args{BulkWalk} = 0 if acl_matches($device, 'bulkwalk_no');
# further protect against buggy Net-SNMP, and disable bulkwalk
if ($snmp_args{BulkWalk}
and ($SNMP::VERSION eq '5.0203' || $SNMP::VERSION eq '5.0301')) {
warning sprintf
"[%s] turning off BulkWalk due to buggy Net-SNMP - please upgrade!",
$device->ip;
$snmp_args{BulkWalk} = 0;
}
# support for offline cache
my $pseudo_cache = catfile( catdir(($ENV{NETDISCO_HOME} || $ENV{HOME}), 'logs', 'snapshots'), $device->ip );
if (-f $pseudo_cache and ($device->is_pseudo or ! $device->in_storage)) {
$snmp_args{Cache} = thaw( decode_base64( read_text($pseudo_cache) ) );
$snmp_args{Offline} = 1;
# support pseudo/offline device renumber and also pseudo device autovivification
$device->set_column(is_pseudo => \'true') if ! $device->is_pseudo;
debug sprintf 'snmp transport running in offline mode for: [%s]', $device->ip;
}
# any net-snmp options to add or override
foreach my $k (keys %{ setting('net_snmp_options') }) {
$snmp_args{ $k } = setting('net_snmp_options')->{ $k };
}
if (scalar keys %{ setting('net_snmp_options') }
or not $snmp_args{BulkWalk}) {
foreach my $k (sort keys %snmp_args) {
next if $k eq 'MibDirs';
debug sprintf 'snmp transport conf: %s => %s', $k, $snmp_args{ $k };
}
}
# get the community string(s)
my @communities = get_communities($device, $mode);
# which SNMP versions to try and in what order
my @versions =
( acl_matches($device->ip, 'snmpforce_v3') ? (3)
: acl_matches($device->ip, 'snmpforce_v2') ? (2)
: acl_matches($device->ip, 'snmpforce_v1') ? (1)
: (reverse (1 .. (setting('snmpver') || 3))) );
# use existing or new device class
my @classes = ($useclass || 'SNMP::Info');
if ($device->snmp_class and not $useclass) {
unshift @classes, $device->snmp_class;
}
my $info = undef;
COMMUNITY: foreach my $comm (@communities) {
next unless $comm;
VERSION: foreach my $ver (@versions) {
next unless $ver;
next if $ver eq 3 and exists $comm->{community};
next if $ver ne 3 and !exists $comm->{community};
CLASS: foreach my $class (@classes) {
next unless $class;
my %local_args = (%snmp_args, Version => $ver);
$info = _try_connect($device, $class, $comm, $mode, \%local_args,
($useclass ? 0 : 1) );
last COMMUNITY if $info;
}
}
}
return $info;
}
sub _try_connect {
my ($device, $class, $comm, $mode, $snmp_args, $reclass) = @_;
my %comm_args = _mk_info_commargs($comm);
my $debug_comm = '<hidden>';
if ($ENV{ND2_SHOW_COMMUNITY} || $ENV{SHOW_COMMUNITY}) {
$debug_comm = ($comm->{community} ||
(sprintf 'v3:%s:%s/%s', ($comm->{user},
($comm->{auth}->{proto} || 'noAuth'),
($comm->{priv}->{proto} || 'noPriv'))) );
}
my $info = undef;
try {
debug
sprintf '[%s:%s] try_connect with ver: %s, class: %s, comm: %s',
$snmp_args->{DestHost}, $snmp_args->{RemotePort},
$snmp_args->{Version}, $class, $debug_comm;
Module::Load::load $class;
$info = $class->new(%$snmp_args, %comm_args) or return;
$info = ($mode eq 'read' ? _try_read($info, $device, $comm)
: _try_write($info, $device, $comm));
# first time a device is discovered, re-instantiate into specific class
if ($reclass and $info and $info->device_type ne $class) {
$class = $info->device_type;
debug
sprintf '[%s:%s] try_connect with ver: %s, new class: %s, comm: %s',
$snmp_args->{DestHost}, $snmp_args->{RemotePort},
$snmp_args->{Version}, $class, $debug_comm;
Module::Load::load $class;
$info = $class->new(%$snmp_args, %comm_args);
}
}
catch {
debug $_;
};
return $info;
}
sub _try_read {
my ($info, $device, $comm) = @_;
return undef unless (
(not defined $info->error)
and (defined $info->uptime or defined $info->hrSystemUptime or defined $info->sysUpTime)
and ($info->layers or $info->description)
and $info->class
);
$device->in_storage
? $device->update({snmp_ver => $info->snmp_ver})
: $device->set_column(snmp_ver => $info->snmp_ver);
if ($comm->{community}) {
$device->in_storage
? $device->update({snmp_comm => $comm->{community}})
: $device->set_column(snmp_comm => $comm->{community});
}
# regardless of device in storage, save the hint
$device->update_or_create_related('community',
{snmp_auth_tag_read => $comm->{tag}}) if $comm->{tag};
return $info;
}
sub _try_write {
my ($info, $device, $comm) = @_;
my $loc = $info->load_location;
$info->set_location($loc) or return undef;
return undef unless ($loc eq $info->load_location);
$device->in_storage
? $device->update({snmp_ver => $info->snmp_ver})
: $device->set_column(snmp_ver => $info->snmp_ver);
# one of these two cols must be set
$device->update_or_create_related('community', {
($comm->{tag} ? (snmp_auth_tag_write => $comm->{tag}) : ()),
($comm->{community} ? (snmp_comm_rw => $comm->{community}) : ()),
});
return $info;
}
sub _mk_info_commargs {
my $comm = shift;
return () unless ref {} eq ref $comm and scalar keys %$comm;
return (Community => $comm->{community})
if exists $comm->{community};
my $seclevel =
(exists $comm->{auth} ?
(exists $comm->{priv} ? 'authPriv' : 'authNoPriv' )
: 'noAuthNoPriv');
return (
SecName => $comm->{user},
SecLevel => $seclevel,
( exists $comm->{auth} ? (
AuthProto => uc ($comm->{auth}->{proto} || 'MD5'),
AuthPass => ($comm->{auth}->{pass} || ''),
( exists $comm->{priv} ? (
PrivProto => uc ($comm->{priv}->{proto} || 'DES'),
PrivPass => ($comm->{priv}->{pass} || ''),
) : ()),
) : ()),
);
}
sub _build_mibdirs {
my $home = (setting('mibhome') || dir(($ENV{NETDISCO_HOME} || $ENV{HOME}), 'netdisco-mibs'));
return map { dir($home, $_)->stringify }
@{ setting('mibdirs') || _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;
}
true;