large refactor for Util.pm; use Moo for Daemon Actions
This commit is contained in:
Oliver Gorwits
@@ -1,15 +1,16 @@
|
||||
#!/usr/bin/env perl
|
||||
|
||||
use Dancer ':script';
|
||||
use Dancer qw/:moose :script/;
|
||||
use Dancer::Plugin::DBIC 'schema';
|
||||
|
||||
# add dispatch methods for each port control action
|
||||
use base 'Netdisco::Daemon::Actions::Device';
|
||||
use base 'Netdisco::Daemon::Actions::Port';
|
||||
|
||||
use Daemon::Generic::While1;
|
||||
use Netdisco::Util qw/load_nd_config is_discoverable/;
|
||||
use Netdisco::Util::DeviceProperties 'is_discoverable';
|
||||
use Try::Tiny;
|
||||
use Moo;
|
||||
|
||||
# add dispatch methods for each port control action
|
||||
with "Netdisco::Daemon::Actions::$_"
|
||||
for (qw/Device Port/);
|
||||
|
||||
newdaemon(
|
||||
progname => 'netdisco-daemon',
|
||||
|
||||
@@ -1,7 +1,10 @@
|
||||
package Netdisco::Daemon::Actions::Device;
|
||||
|
||||
use Netdisco::Util ':port_control';
|
||||
use Try::Tiny;
|
||||
use Netdisco::Util::Connect qw/snmp_connect get_device/;
|
||||
use Netdisco::Daemon::Actions::Util ':all';
|
||||
|
||||
use namespace::clean;
|
||||
use Moo::Role;
|
||||
|
||||
sub set_location {
|
||||
my ($self, $job) = @_;
|
||||
@@ -17,16 +20,15 @@ sub _set_device_generic {
|
||||
my ($self, $ip, $slot, $data) = @_;
|
||||
$data ||= '';
|
||||
|
||||
try {
|
||||
# snmp connect using rw community
|
||||
my $info = snmp_connect($ip)
|
||||
or return _error("Failed to connect to device [$ip] to update $slot");
|
||||
or return error("Failed to connect to device [$ip] to update $slot");
|
||||
|
||||
my $method = 'set_'. $slot;
|
||||
my $rv = $info->$method($data);
|
||||
|
||||
if (!defined $rv) {
|
||||
return _error(sprintf 'Failed to set %s on [%s]: %s',
|
||||
return error(sprintf 'Failed to set %s on [%s]: %s',
|
||||
$slot, $ip, ($info->error || ''));
|
||||
}
|
||||
|
||||
@@ -34,21 +36,17 @@ sub _set_device_generic {
|
||||
$info->clear_cache;
|
||||
my $new_data = ($info->$slot || '');
|
||||
if ($new_data ne $data) {
|
||||
return _error("Verify of $slot update failed on [$ip]: $new_data");
|
||||
return error("Verify of $slot update failed on [$ip]: $new_data");
|
||||
}
|
||||
|
||||
# get device details from db
|
||||
my $device = get_device($ip)
|
||||
or return _error("Updated $slot on [$ip] to [$data] but failed to update DB");
|
||||
or return error("Updated $slot on [$ip] to [$data] but failed to update DB");
|
||||
|
||||
# update netdisco DB
|
||||
$device->update({$slot => $data});
|
||||
|
||||
return _done("Updated $slot on [$ip] to [$data]");
|
||||
}
|
||||
catch {
|
||||
return _error("Failed to update $slot on [$ip]: $_");
|
||||
};
|
||||
return done("Updated $slot on [$ip] to [$data]");
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
@@ -1,7 +1,11 @@
|
||||
package Netdisco::Daemon::Actions::Port;
|
||||
|
||||
use Netdisco::Util ':port_control';
|
||||
use Try::Tiny;
|
||||
use Netdisco::Util::Connect ':all';
|
||||
use Netdisco::Util::Permissions 'port_reconfig_check';
|
||||
use Netdisco::Daemon::Actions::Util ':all';
|
||||
|
||||
use namespace::clean;
|
||||
use Moo::Role;
|
||||
|
||||
sub portcontrol {
|
||||
my ($self, $job) = @_;
|
||||
@@ -10,45 +14,40 @@ sub portcontrol {
|
||||
my $pn = $job->port;
|
||||
(my $dir = $job->subaction) =~ s/-\w+//;
|
||||
|
||||
try {
|
||||
my $port = get_port($ip, $pn)
|
||||
or return _error("Unknown port name [$pn] on device [$ip]");
|
||||
or return error("Unknown port name [$pn] on device [$ip]");
|
||||
|
||||
my $reconfig_check = port_reconfig_check($port);
|
||||
return _error("Cannot alter port: $reconfig_check")
|
||||
return error("Cannot alter port: $reconfig_check")
|
||||
if length $reconfig_check;
|
||||
|
||||
# snmp connect using rw community
|
||||
my $info = snmp_connect($ip)
|
||||
or return _error("Failed to connect to device [$ip] to control port");
|
||||
or return error("Failed to connect to device [$ip] to control port");
|
||||
|
||||
my $iid = get_iid($port)
|
||||
or return _error("Failed to get port ID for [$pn] from [$ip]");
|
||||
or return error("Failed to get port ID for [$pn] from [$ip]");
|
||||
|
||||
my $rv = $info->set_i_up_admin(lc($dir), $iid);
|
||||
|
||||
return _error("Failed to set [$pn] port status to [$dir] on [$ip]")
|
||||
return error("Failed to set [$pn] port status to [$dir] on [$ip]")
|
||||
if !defined $rv;
|
||||
|
||||
# confirm the set happened
|
||||
$info->clear_cache;
|
||||
my $state = ($info->i_up_admin($iid) || '');
|
||||
if ($state ne $dir) {
|
||||
return _error("Verify of [$pn] port status failed on [$ip]: $state");
|
||||
return error("Verify of [$pn] port status failed on [$ip]: $state");
|
||||
}
|
||||
|
||||
# get device details from db
|
||||
my $device = $port->device
|
||||
or return _error("Updated [$pn] port status on [$ip] but failed to update DB");
|
||||
or return error("Updated [$pn] port status on [$ip] but failed to update DB");
|
||||
|
||||
# update netdisco DB
|
||||
$device->update({up_admin => $state});
|
||||
|
||||
return _done("Updated [$pn] port status on [$ip] to [$state]");
|
||||
}
|
||||
catch {
|
||||
return _error("Failed to update [$pn] port status on [$ip]: $_");
|
||||
};
|
||||
return done("Updated [$pn] port status on [$ip] to [$state]");
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
15
Netdisco/lib/Netdisco/Daemon/Actions/Util.pm
Normal file
15
Netdisco/lib/Netdisco/Daemon/Actions/Util.pm
Normal file
@@ -0,0 +1,15 @@
|
||||
package Netdisco::Daemon::Actions::Util;
|
||||
|
||||
# support utilities for Daemon Actions
|
||||
|
||||
use base 'Exporter';
|
||||
our @EXPORT = ();
|
||||
our @EXPORT_OK = qw/ done error /;
|
||||
our %EXPORT_TAGS = (
|
||||
all => [qw/ done error /],
|
||||
);
|
||||
|
||||
sub done { return ('done', shift) }
|
||||
sub error { return ('error', shift) }
|
||||
|
||||
1;
|
||||
@@ -1,384 +0,0 @@
|
||||
package Netdisco::Util;
|
||||
|
||||
use Dancer qw/:syntax :script/;
|
||||
use Dancer::Plugin::DBIC 'schema';
|
||||
|
||||
use NetAddr::IP::Lite;
|
||||
use SNMP::Info;
|
||||
use Config::Tiny;
|
||||
use File::Slurp;
|
||||
use Try::Tiny;
|
||||
|
||||
use base 'Exporter';
|
||||
our @EXPORT = ();
|
||||
our @EXPORT_OK = qw/
|
||||
load_nd_config
|
||||
is_discoverable
|
||||
is_vlan_interface port_has_phone
|
||||
get_device get_port get_iid
|
||||
vlan_reconfig_check port_reconfig_check
|
||||
snmp_connect
|
||||
sort_port
|
||||
_done _error
|
||||
/;
|
||||
our %EXPORT_TAGS = (port_control => [qw/
|
||||
get_device get_port snmp_connect
|
||||
port_reconfig_check
|
||||
_done _error
|
||||
/]);
|
||||
|
||||
=head1 Netdisco::Util
|
||||
|
||||
A set of helper subroutines to support parts of the Netdisco application.
|
||||
|
||||
There are no default exports, however the C<:port_control> tag will export the
|
||||
C<get_device> and C<snmp_connect> subroutines.
|
||||
|
||||
=cut
|
||||
|
||||
sub _done { return ('done', shift) }
|
||||
sub _error { return ('error', shift) }
|
||||
|
||||
=head2 is_discoverable( $ip )
|
||||
|
||||
Given an IP address, returns C<true> if Netdisco on this host is permitted to
|
||||
discover its configuration by the local Netdisco configuration file.
|
||||
|
||||
The configuration items C<discover_no> and C<discover_only> are checked
|
||||
against the given IP.
|
||||
|
||||
Returns false if the host is not permitted to discover the target device.
|
||||
|
||||
=cut
|
||||
|
||||
sub is_discoverable {
|
||||
my $ip = shift;
|
||||
|
||||
my $device = NetAddr::IP::Lite->new($ip) or return 0;
|
||||
my $discover_no = var('nd_config')->{_}->{discover_no};
|
||||
my $discover_only = var('nd_config')->{_}->{discover_only};
|
||||
|
||||
if (length $discover_no) {
|
||||
my @d_no = split /,\s*/, $discover_no;
|
||||
foreach my $item (@d_no) {
|
||||
my $ip = NetAddr::IP::Lite->new($item) or return 0;
|
||||
return 0 if $ip->contains($device);
|
||||
}
|
||||
}
|
||||
|
||||
if (length $discover_only) {
|
||||
my $okay = 0;
|
||||
my @d_only = split /,\s*/, $discover_only;
|
||||
foreach my $item (@d_only) {
|
||||
my $ip = NetAddr::IP::Lite->new($item) or return 0;
|
||||
++$okay if $ip->contains($device);
|
||||
}
|
||||
return 0 if not $okay;
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
=head2 load_nd_config( $filename )
|
||||
|
||||
Given the absolute file name of the Netdisco configuration, loads the
|
||||
configuration from disk and returns it as a Hash reference.
|
||||
|
||||
All entries in the configuration appear under the "underscore" Hash key:
|
||||
|
||||
my $config = load_nd_config('/etc/netdisco/netdisco.conf');
|
||||
say $config->{_}->{snmptimeout};
|
||||
|
||||
In addition, the configuration is saved into the Dancer I<vars> store under
|
||||
the C<nd_config> key:
|
||||
|
||||
say var('nd_config')->{_}->{snmptimeout};
|
||||
|
||||
Dies if it cannot load the configuration file.
|
||||
|
||||
=cut
|
||||
|
||||
sub load_nd_config {
|
||||
my $file = shift or die "missing netdisco config file name.\n";
|
||||
my $config = {};
|
||||
|
||||
if (-e $file) {
|
||||
# read file and alter line continuations to be single lines
|
||||
my $config_content = read_file($file);
|
||||
$config_content =~ s/\\\n//sg;
|
||||
|
||||
# parse config naively as .ini
|
||||
$config = Config::Tiny->new()->read_string($config_content);
|
||||
die (Config::Tiny->errstr ."\n") if !defined $config;
|
||||
}
|
||||
|
||||
# store for later access
|
||||
var(nd_config => $config);
|
||||
|
||||
return $config;
|
||||
}
|
||||
|
||||
=head2 get_device( $ip )
|
||||
|
||||
Given an IP address, returns a L<DBIx::Class::Row> object for the Device in
|
||||
the Netdisco database. The IP can be for any interface on the device.
|
||||
|
||||
Returns C<undef> if the device or interface IP is not known to Netdisco.
|
||||
|
||||
=cut
|
||||
|
||||
sub get_device {
|
||||
my $ip = shift;
|
||||
|
||||
my $alias = schema('netdisco')->resultset('DeviceIp')
|
||||
->search({alias => $ip})->first;
|
||||
return if not eval { $alias->ip };
|
||||
|
||||
return schema('netdisco')->resultset('Device')
|
||||
->find({ip => $alias->ip});
|
||||
}
|
||||
|
||||
sub get_port {
|
||||
my ($device, $portname) = @_;
|
||||
|
||||
# accept either ip or dbic object
|
||||
$device = get_device($device)
|
||||
if not ref $device;
|
||||
|
||||
my $port = schema('Netdisco')->resultset('DevicePort')
|
||||
->find({ip => $device->ip, port => $portname});
|
||||
|
||||
return $port;
|
||||
}
|
||||
|
||||
sub get_iid {
|
||||
my ($info, $port) = @_;
|
||||
|
||||
# accept either port name or dbic object
|
||||
$port = $port->port if ref $port;
|
||||
|
||||
my $interfaces = $info->interfaces;
|
||||
my %rev_if = reverse %$interfaces;
|
||||
my $iid = $rev_if{$port};
|
||||
|
||||
return $iid;
|
||||
}
|
||||
|
||||
sub is_vlan_interface {
|
||||
my $port = shift;
|
||||
|
||||
my $is_vlan = (($port->type and
|
||||
$port->type =~ /^(53|propVirtual|l2vlan|l3ipvlan|135|136|137)$/i)
|
||||
or ($port->port and $port->port =~ /vlan/i)
|
||||
or ($port->name and $port->name =~ /vlan/i)) ? 1 : 0;
|
||||
|
||||
return $is_vlan;
|
||||
}
|
||||
|
||||
sub port_has_phone {
|
||||
my $port = shift;
|
||||
|
||||
my $has_phone = ($port->remote_type
|
||||
and $port->remote_type =~ /ip.phone/i) ? 1 : 0;
|
||||
|
||||
return $has_phone;
|
||||
}
|
||||
|
||||
sub vlan_reconfig_check {
|
||||
my $port = shift;
|
||||
my $ip = $port->ip;
|
||||
my $name = $port->port;
|
||||
my $nd_config = var('nd_config')->{_};
|
||||
|
||||
my $is_vlan = is_vlan_interface($port);
|
||||
|
||||
# vlan (routed) interface check
|
||||
return "forbidden: [$name] is a vlan interface on [$ip]"
|
||||
if $is_vlan;
|
||||
|
||||
return "forbidden: not permitted to change native vlan"
|
||||
if not $nd_config->{vlanctl};
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub port_reconfig_check {
|
||||
my $port = shift;
|
||||
my $ip = $port->ip;
|
||||
my $name = $port->port;
|
||||
my $nd_config = var('nd_config')->{_};
|
||||
|
||||
my $has_phone = has_phone($port);
|
||||
my $is_vlan = is_vlan_interface($port);
|
||||
|
||||
# uplink check
|
||||
return "forbidden: port [$name] on [$ip] is an uplink"
|
||||
if $port->remote_type and not $has_phone and not $nd_config->{allow_uplinks};
|
||||
|
||||
# phone check
|
||||
return "forbidden: port [$name] on [$ip] is a phone"
|
||||
if $has_phone and $nd_config->{portctl_nophones};
|
||||
|
||||
# vlan (routed) interface check
|
||||
return "forbidden: [$name] is a vlan interface on [$ip]"
|
||||
if $is_vlan and not $nd_config->{portctl_vlans};
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
=head2 snmp_connect( $ip )
|
||||
|
||||
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.
|
||||
|
||||
The Netdisco configuration file must have first been loaded using
|
||||
C<load_nd_config> otherwise the connection will fail (it is required for SNMP
|
||||
settings).
|
||||
|
||||
Returns C<undef> if the connection fails.
|
||||
|
||||
=cut
|
||||
|
||||
sub snmp_connect {
|
||||
my $ip = shift;
|
||||
my $nd_config = var('nd_config')->{_};
|
||||
|
||||
# get device details from db
|
||||
my $device = get_device($ip)
|
||||
or return ();
|
||||
|
||||
# TODO: really only supporing v2c at the moment
|
||||
my %snmp_args = (
|
||||
DestHost => $device->ip,
|
||||
Version => ($device->snmp_ver || $nd_config->{snmpver} || 2),
|
||||
Retries => ($nd_config->{snmpretries} || 2),
|
||||
Timeout => ($nd_config->{snmptimeout} || 1000000),
|
||||
MibDirs => _build_mibdirs(),
|
||||
AutoSpecify => 1,
|
||||
Debug => ($ENV{INFO_TRACE} || 0),
|
||||
);
|
||||
|
||||
(my $comm = $nd_config->{community_rw}) =~ s/\s+//g;
|
||||
my @communities = split /,/, $comm;
|
||||
|
||||
my $info = undef;
|
||||
COMMUNITY: foreach my $c (@communities) {
|
||||
try {
|
||||
$info = SNMP::Info->new(%snmp_args, Community => $c);
|
||||
last COMMUNITY if (
|
||||
$info
|
||||
and (not defined $info->error)
|
||||
and length $info->uptime
|
||||
);
|
||||
};
|
||||
}
|
||||
|
||||
return $info;
|
||||
}
|
||||
|
||||
sub _build_mibdirs {
|
||||
my $mibhome = var('nd_config')->{_}->{mibhome};
|
||||
(my $mibdirs = var('nd_config')->{_}->{mibdirs}) =~ s/\s+//g;
|
||||
|
||||
$mibdirs =~ s/\$mibhome/$mibhome/g;
|
||||
return [ split /,/, $mibdirs ];
|
||||
}
|
||||
|
||||
=head2 sort_port( $a, $b )
|
||||
|
||||
Sort port names of various types used by device vendors. Interface is as
|
||||
Perl's own C<sort> - two input args and an integer return value.
|
||||
|
||||
=cut
|
||||
|
||||
sub sort_port {
|
||||
my ($aval, $bval) = @_;
|
||||
|
||||
# hack for foundry "10GigabitEthernet" -> cisco-like "TenGigabitEthernet"
|
||||
$aval = "Ten$1" if $aval =~ qr/^10(GigabitEthernet.+)$/;
|
||||
$bval = "Ten$1" if $bval =~ qr/^10(GigabitEthernet.+)$/;
|
||||
|
||||
my $numbers = qr{^(\d+)$};
|
||||
my $numeric = qr{^([\d\.]+)$};
|
||||
my $dotted_numeric = qr{^(\d+)\.(\d+)$};
|
||||
my $letter_number = qr{^([a-zA-Z]+)(\d+)$};
|
||||
my $wordcharword = qr{^([^:\/.]+)[\ :\/\.]+([^:\/.]+)(\d+)?$}; #port-channel45
|
||||
my $netgear = qr{^Slot: (\d+) Port: (\d+) }; # "Slot: 0 Port: 15 Gigabit - Level"
|
||||
my $ciscofast = qr{^
|
||||
# Word Number slash (Gigabit0/)
|
||||
(\D+)(\d+)[\/:]
|
||||
# Groups of symbol float (/5.5/5.5/5.5), separated by slash or colon
|
||||
([\/:\.\d]+)
|
||||
# Optional dash (-Bearer Channel)
|
||||
(-.*)?
|
||||
$}x;
|
||||
|
||||
my @a = (); my @b = ();
|
||||
|
||||
if ($aval =~ $dotted_numeric) {
|
||||
@a = ($1,$2);
|
||||
} elsif ($aval =~ $letter_number) {
|
||||
@a = ($1,$2);
|
||||
} elsif ($aval =~ $netgear) {
|
||||
@a = ($1,$2);
|
||||
} elsif ($aval =~ $numbers) {
|
||||
@a = ($1);
|
||||
} elsif ($aval =~ $ciscofast) {
|
||||
@a = ($2,$1);
|
||||
push @a, split(/[:\/]/,$3), $4;
|
||||
} elsif ($aval =~ $wordcharword) {
|
||||
@a = ($1,$2,$3);
|
||||
} else {
|
||||
@a = ($aval);
|
||||
}
|
||||
|
||||
if ($bval =~ $dotted_numeric) {
|
||||
@b = ($1,$2);
|
||||
} elsif ($bval =~ $letter_number) {
|
||||
@b = ($1,$2);
|
||||
} elsif ($bval =~ $netgear) {
|
||||
@b = ($1,$2);
|
||||
} elsif ($bval =~ $numbers) {
|
||||
@b = ($1);
|
||||
} elsif ($bval =~ $ciscofast) {
|
||||
@b = ($2,$1);
|
||||
push @b, split(/[:\/]/,$3),$4;
|
||||
} elsif ($bval =~ $wordcharword) {
|
||||
@b = ($1,$2,$3);
|
||||
} else {
|
||||
@b = ($bval);
|
||||
}
|
||||
|
||||
# Equal until proven otherwise
|
||||
my $val = 0;
|
||||
while (scalar(@a) or scalar(@b)){
|
||||
# carried around from the last find.
|
||||
last if $val != 0;
|
||||
|
||||
my $a1 = shift @a;
|
||||
my $b1 = shift @b;
|
||||
|
||||
# A has more components - loses
|
||||
unless (defined $b1){
|
||||
$val = 1;
|
||||
last;
|
||||
}
|
||||
|
||||
# A has less components - wins
|
||||
unless (defined $a1) {
|
||||
$val = -1;
|
||||
last;
|
||||
}
|
||||
|
||||
if ($a1 =~ $numeric and $b1 =~ $numeric){
|
||||
$val = $a1 <=> $b1;
|
||||
} elsif ($a1 ne $b1) {
|
||||
$val = $a1 cmp $b1;
|
||||
}
|
||||
}
|
||||
|
||||
return $val;
|
||||
}
|
||||
|
||||
1;
|
||||
140
Netdisco/lib/Netdisco/Util/Connect.pm
Normal file
140
Netdisco/lib/Netdisco/Util/Connect.pm
Normal file
@@ -0,0 +1,140 @@
|
||||
package Netdisco::Util::Connect;
|
||||
|
||||
use Dancer qw/:syntax :script/;
|
||||
use Dancer::Plugin::DBIC 'schema';
|
||||
|
||||
use SNMP::Info;
|
||||
use Try::Tiny;
|
||||
|
||||
use base 'Exporter';
|
||||
our @EXPORT = ();
|
||||
our @EXPORT_OK = qw/
|
||||
get_device get_port get_iid snmp_connect
|
||||
/;
|
||||
our %EXPORT_TAGS = (
|
||||
all => [qw/
|
||||
get_device get_port get_iid snmp_connect
|
||||
/],
|
||||
);
|
||||
|
||||
=head1 Netdisco::Util::Connect
|
||||
|
||||
A set of helper subroutines to support parts of the Netdisco application.
|
||||
|
||||
There are no default exports, however the C<:all> tag will export all
|
||||
subroutines.
|
||||
|
||||
=head2 get_device( $ip )
|
||||
|
||||
Given an IP address, returns a L<DBIx::Class::Row> object for the Device in
|
||||
the Netdisco database. The IP can be for any interface on the device.
|
||||
|
||||
Returns C<undef> if the device or interface IP is not known to Netdisco.
|
||||
|
||||
=cut
|
||||
|
||||
sub get_device {
|
||||
my $ip = shift;
|
||||
|
||||
my $alias = schema('netdisco')->resultset('DeviceIp')
|
||||
->search({alias => $ip})->first;
|
||||
return if not eval { $alias->ip };
|
||||
|
||||
return schema('netdisco')->resultset('Device')
|
||||
->find({ip => $alias->ip});
|
||||
}
|
||||
|
||||
=head2 get_port( $device, $portname )
|
||||
|
||||
=cut
|
||||
|
||||
sub get_port {
|
||||
my ($device, $portname) = @_;
|
||||
|
||||
# accept either ip or dbic object
|
||||
$device = get_device($device)
|
||||
if not ref $device;
|
||||
|
||||
my $port = schema('Netdisco')->resultset('DevicePort')
|
||||
->find({ip => $device->ip, port => $portname});
|
||||
|
||||
return $port;
|
||||
}
|
||||
|
||||
=head2 get_iid( $info, $port )
|
||||
|
||||
=cut
|
||||
|
||||
sub get_iid {
|
||||
my ($info, $port) = @_;
|
||||
|
||||
# accept either port name or dbic object
|
||||
$port = $port->port if ref $port;
|
||||
|
||||
my $interfaces = $info->interfaces;
|
||||
my %rev_if = reverse %$interfaces;
|
||||
my $iid = $rev_if{$port};
|
||||
|
||||
return $iid;
|
||||
}
|
||||
|
||||
=head2 snmp_connect( $ip )
|
||||
|
||||
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.
|
||||
|
||||
The Netdisco configuration file must have first been loaded using
|
||||
C<load_nd_config> otherwise the connection will fail (it is required for SNMP
|
||||
settings).
|
||||
|
||||
Returns C<undef> if the connection fails.
|
||||
|
||||
=cut
|
||||
|
||||
sub snmp_connect {
|
||||
my $ip = shift;
|
||||
my $nd_config = var('nd_config')->{_};
|
||||
|
||||
# get device details from db
|
||||
my $device = get_device($ip)
|
||||
or return ();
|
||||
|
||||
# TODO: really only supporing v2c at the moment
|
||||
my %snmp_args = (
|
||||
DestHost => $device->ip,
|
||||
Version => ($device->snmp_ver || $nd_config->{snmpver} || 2),
|
||||
Retries => ($nd_config->{snmpretries} || 2),
|
||||
Timeout => ($nd_config->{snmptimeout} || 1000000),
|
||||
MibDirs => _build_mibdirs(),
|
||||
AutoSpecify => 1,
|
||||
Debug => ($ENV{INFO_TRACE} || 0),
|
||||
);
|
||||
|
||||
(my $comm = $nd_config->{community_rw}) =~ s/\s+//g;
|
||||
my @communities = split /,/, $comm;
|
||||
|
||||
my $info = undef;
|
||||
COMMUNITY: foreach my $c (@communities) {
|
||||
try {
|
||||
$info = SNMP::Info->new(%snmp_args, Community => $c);
|
||||
last COMMUNITY if (
|
||||
$info
|
||||
and (not defined $info->error)
|
||||
and length $info->uptime
|
||||
);
|
||||
};
|
||||
}
|
||||
|
||||
return $info;
|
||||
}
|
||||
|
||||
sub _build_mibdirs {
|
||||
my $mibhome = var('nd_config')->{_}->{mibhome};
|
||||
(my $mibdirs = var('nd_config')->{_}->{mibdirs}) =~ s/\s+//g;
|
||||
|
||||
$mibdirs =~ s/\$mibhome/$mibhome/g;
|
||||
return [ split /,/, $mibdirs ];
|
||||
}
|
||||
|
||||
1;
|
||||
96
Netdisco/lib/Netdisco/Util/DeviceProperties.pm
Normal file
96
Netdisco/lib/Netdisco/Util/DeviceProperties.pm
Normal file
@@ -0,0 +1,96 @@
|
||||
package Netdisco::Util::DeviceProperties;
|
||||
|
||||
use Dancer qw/:syntax :script/;
|
||||
use Dancer::Plugin::DBIC 'schema';
|
||||
|
||||
use NetAddr::IP::Lite;
|
||||
|
||||
use base 'Exporter';
|
||||
our @EXPORT = ();
|
||||
our @EXPORT_OK = qw/
|
||||
is_discoverable
|
||||
is_vlan_interface port_has_phone
|
||||
/;
|
||||
our %EXPORT_TAGS = (
|
||||
all => [qw/
|
||||
is_discoverable
|
||||
is_vlan_interface port_has_phone
|
||||
/],
|
||||
);
|
||||
|
||||
=head1 Netdisco::Util::DeviceProperties;
|
||||
|
||||
A set of helper subroutines to support parts of the Netdisco application.
|
||||
|
||||
There are no default exports, however the C<:all> tag will export all
|
||||
subroutines.
|
||||
|
||||
=head2 is_discoverable( $ip )
|
||||
|
||||
Given an IP address, returns C<true> if Netdisco on this host is permitted to
|
||||
discover its configuration by the local Netdisco configuration file.
|
||||
|
||||
The configuration items C<discover_no> and C<discover_only> are checked
|
||||
against the given IP.
|
||||
|
||||
Returns false if the host is not permitted to discover the target device.
|
||||
|
||||
=cut
|
||||
|
||||
sub is_discoverable {
|
||||
my $ip = shift;
|
||||
|
||||
my $device = NetAddr::IP::Lite->new($ip) or return 0;
|
||||
my $discover_no = var('nd_config')->{_}->{discover_no};
|
||||
my $discover_only = var('nd_config')->{_}->{discover_only};
|
||||
|
||||
if (length $discover_no) {
|
||||
my @d_no = split /,\s*/, $discover_no;
|
||||
foreach my $item (@d_no) {
|
||||
my $ip = NetAddr::IP::Lite->new($item) or return 0;
|
||||
return 0 if $ip->contains($device);
|
||||
}
|
||||
}
|
||||
|
||||
if (length $discover_only) {
|
||||
my $okay = 0;
|
||||
my @d_only = split /,\s*/, $discover_only;
|
||||
foreach my $item (@d_only) {
|
||||
my $ip = NetAddr::IP::Lite->new($item) or return 0;
|
||||
++$okay if $ip->contains($device);
|
||||
}
|
||||
return 0 if not $okay;
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
=head2 is_vlan_interface( $port )
|
||||
|
||||
=cut
|
||||
|
||||
sub is_vlan_interface {
|
||||
my $port = shift;
|
||||
|
||||
my $is_vlan = (($port->type and
|
||||
$port->type =~ /^(53|propVirtual|l2vlan|l3ipvlan|135|136|137)$/i)
|
||||
or ($port->port and $port->port =~ /vlan/i)
|
||||
or ($port->name and $port->name =~ /vlan/i)) ? 1 : 0;
|
||||
|
||||
return $is_vlan;
|
||||
}
|
||||
|
||||
=head2 port_has_phone( $port )
|
||||
|
||||
=cut
|
||||
|
||||
sub port_has_phone {
|
||||
my $port = shift;
|
||||
|
||||
my $has_phone = ($port->remote_type
|
||||
and $port->remote_type =~ /ip.phone/i) ? 1 : 0;
|
||||
|
||||
return $has_phone;
|
||||
}
|
||||
|
||||
1;
|
||||
76
Netdisco/lib/Netdisco/Util/Permissions.pm
Normal file
76
Netdisco/lib/Netdisco/Util/Permissions.pm
Normal file
@@ -0,0 +1,76 @@
|
||||
package Netdisco::Util::Permissions;
|
||||
|
||||
use Dancer qw/:syntax :script/;
|
||||
use Dancer::Plugin::DBIC 'schema';
|
||||
|
||||
use Netdisco::Util::DeviceProperties ':all';
|
||||
|
||||
use base 'Exporter';
|
||||
our @EXPORT = ();
|
||||
our @EXPORT_OK = qw/
|
||||
vlan_reconfig_check port_reconfig_check
|
||||
/;
|
||||
our %EXPORT_TAGS = (
|
||||
all => [qw/
|
||||
vlan_reconfig_check port_reconfig_check
|
||||
/],
|
||||
);
|
||||
|
||||
=head1 Netdisco::Util::Permissions
|
||||
|
||||
A set of helper subroutines to support parts of the Netdisco application.
|
||||
|
||||
There are no default exports, however the C<:all> tag will export all
|
||||
subroutines.
|
||||
|
||||
=head2 vlan_reconfig_check( $port )
|
||||
|
||||
=cut
|
||||
|
||||
sub vlan_reconfig_check {
|
||||
my $port = shift;
|
||||
my $ip = $port->ip;
|
||||
my $name = $port->port;
|
||||
my $nd_config = var('nd_config')->{_};
|
||||
|
||||
my $is_vlan = is_vlan_interface($port);
|
||||
|
||||
# vlan (routed) interface check
|
||||
return "forbidden: [$name] is a vlan interface on [$ip]"
|
||||
if $is_vlan;
|
||||
|
||||
return "forbidden: not permitted to change native vlan"
|
||||
if not $nd_config->{vlanctl};
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
=head2 port_reconfig_check( $port )
|
||||
|
||||
=cut
|
||||
|
||||
sub port_reconfig_check {
|
||||
my $port = shift;
|
||||
my $ip = $port->ip;
|
||||
my $name = $port->port;
|
||||
my $nd_config = var('nd_config')->{_};
|
||||
|
||||
my $has_phone = has_phone($port);
|
||||
my $is_vlan = is_vlan_interface($port);
|
||||
|
||||
# uplink check
|
||||
return "forbidden: port [$name] on [$ip] is an uplink"
|
||||
if $port->remote_type and not $has_phone and not $nd_config->{allow_uplinks};
|
||||
|
||||
# phone check
|
||||
return "forbidden: port [$name] on [$ip] is a phone"
|
||||
if $has_phone and $nd_config->{portctl_nophones};
|
||||
|
||||
# vlan (routed) interface check
|
||||
return "forbidden: [$name] is a vlan interface on [$ip]"
|
||||
if $is_vlan and not $nd_config->{portctl_vlans};
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
1;
|
||||
117
Netdisco/lib/Netdisco/Util/Web.pm
Normal file
117
Netdisco/lib/Netdisco/Util/Web.pm
Normal file
@@ -0,0 +1,117 @@
|
||||
package Netdisco::Util::Web;
|
||||
|
||||
use base 'Exporter';
|
||||
our @EXPORT = ();
|
||||
our @EXPORT_OK = qw/
|
||||
sort_port
|
||||
/;
|
||||
our %EXPORT_TAGS = (
|
||||
all => [qw/
|
||||
sort_port
|
||||
/],
|
||||
);
|
||||
|
||||
=head1 Netdisco::Util::Web
|
||||
|
||||
A set of helper subroutines to support parts of the Netdisco application.
|
||||
|
||||
There are no default exports, however the C<:all> tag will export all
|
||||
subroutines.
|
||||
|
||||
=head2 sort_port( $a, $b )
|
||||
|
||||
Sort port names of various types used by device vendors. Interface is as
|
||||
Perl's own C<sort> - two input args and an integer return value.
|
||||
|
||||
=cut
|
||||
|
||||
sub sort_port {
|
||||
my ($aval, $bval) = @_;
|
||||
|
||||
# hack for foundry "10GigabitEthernet" -> cisco-like "TenGigabitEthernet"
|
||||
$aval = "Ten$1" if $aval =~ qr/^10(GigabitEthernet.+)$/;
|
||||
$bval = "Ten$1" if $bval =~ qr/^10(GigabitEthernet.+)$/;
|
||||
|
||||
my $numbers = qr{^(\d+)$};
|
||||
my $numeric = qr{^([\d\.]+)$};
|
||||
my $dotted_numeric = qr{^(\d+)\.(\d+)$};
|
||||
my $letter_number = qr{^([a-zA-Z]+)(\d+)$};
|
||||
my $wordcharword = qr{^([^:\/.]+)[\ :\/\.]+([^:\/.]+)(\d+)?$}; #port-channel45
|
||||
my $netgear = qr{^Slot: (\d+) Port: (\d+) }; # "Slot: 0 Port: 15 Gigabit - Level"
|
||||
my $ciscofast = qr{^
|
||||
# Word Number slash (Gigabit0/)
|
||||
(\D+)(\d+)[\/:]
|
||||
# Groups of symbol float (/5.5/5.5/5.5), separated by slash or colon
|
||||
([\/:\.\d]+)
|
||||
# Optional dash (-Bearer Channel)
|
||||
(-.*)?
|
||||
$}x;
|
||||
|
||||
my @a = (); my @b = ();
|
||||
|
||||
if ($aval =~ $dotted_numeric) {
|
||||
@a = ($1,$2);
|
||||
} elsif ($aval =~ $letter_number) {
|
||||
@a = ($1,$2);
|
||||
} elsif ($aval =~ $netgear) {
|
||||
@a = ($1,$2);
|
||||
} elsif ($aval =~ $numbers) {
|
||||
@a = ($1);
|
||||
} elsif ($aval =~ $ciscofast) {
|
||||
@a = ($2,$1);
|
||||
push @a, split(/[:\/]/,$3), $4;
|
||||
} elsif ($aval =~ $wordcharword) {
|
||||
@a = ($1,$2,$3);
|
||||
} else {
|
||||
@a = ($aval);
|
||||
}
|
||||
|
||||
if ($bval =~ $dotted_numeric) {
|
||||
@b = ($1,$2);
|
||||
} elsif ($bval =~ $letter_number) {
|
||||
@b = ($1,$2);
|
||||
} elsif ($bval =~ $netgear) {
|
||||
@b = ($1,$2);
|
||||
} elsif ($bval =~ $numbers) {
|
||||
@b = ($1);
|
||||
} elsif ($bval =~ $ciscofast) {
|
||||
@b = ($2,$1);
|
||||
push @b, split(/[:\/]/,$3),$4;
|
||||
} elsif ($bval =~ $wordcharword) {
|
||||
@b = ($1,$2,$3);
|
||||
} else {
|
||||
@b = ($bval);
|
||||
}
|
||||
|
||||
# Equal until proven otherwise
|
||||
my $val = 0;
|
||||
while (scalar(@a) or scalar(@b)){
|
||||
# carried around from the last find.
|
||||
last if $val != 0;
|
||||
|
||||
my $a1 = shift @a;
|
||||
my $b1 = shift @b;
|
||||
|
||||
# A has more components - loses
|
||||
unless (defined $b1){
|
||||
$val = 1;
|
||||
last;
|
||||
}
|
||||
|
||||
# A has less components - wins
|
||||
unless (defined $a1) {
|
||||
$val = -1;
|
||||
last;
|
||||
}
|
||||
|
||||
if ($a1 =~ $numeric and $b1 =~ $numeric){
|
||||
$val = $a1 <=> $b1;
|
||||
} elsif ($a1 ne $b1) {
|
||||
$val = $a1 cmp $b1;
|
||||
}
|
||||
}
|
||||
|
||||
return $val;
|
||||
}
|
||||
|
||||
1;
|
||||
@@ -5,7 +5,7 @@ use Dancer::Plugin::Ajax;
|
||||
use Dancer::Plugin::DBIC;
|
||||
|
||||
use NetAddr::IP::Lite ':lower';
|
||||
use Netdisco::Util (); # for sort_port
|
||||
use Netdisco::Util::Web (); # for sort_port
|
||||
|
||||
hook 'before' => sub {
|
||||
# list of port detail columns
|
||||
@@ -240,7 +240,7 @@ ajax '/ajax/content/device/ports' => sub {
|
||||
if param('c_neighbors');
|
||||
|
||||
# sort ports (empty set would be a 'no records' msg)
|
||||
my $results = [ sort { &Netdisco::Util::sort_port($a->port, $b->port) } $set->all ];
|
||||
my $results = [ sort { &Netdisco::Util::Web::sort_port($a->port, $b->port) } $set->all ];
|
||||
return unless scalar @$results;
|
||||
|
||||
content_type('text/html');
|
||||
|
||||
Reference in New Issue
Block a user