135/netdisco
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

large refactor for Util.pm; use Moo for Daemon Actions

Browse Source
This commit is contained in:
Oliver Gorwits
2012-12-09 15:17:25 +00:00
parent 426a6fd4ca
commit 4e4012c051
10 changed files with 515 additions and 457 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13
Netdisco/bin/netdisco-daemon
View File

@@ -1,15 +1,16 @@
#!/usr/bin/env perl #!/usr/bin/env perl
use Dancer ':script'; use Dancer qw/:moose :script/;
use Dancer::Plugin::DBIC 'schema'; 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 Daemon::Generic::While1;
use Netdisco::Util qw/load_nd_config is_discoverable/; use Netdisco::Util::DeviceProperties 'is_discoverable';
use Try::Tiny; use Try::Tiny;
use Moo;
# add dispatch methods for each port control action
with "Netdisco::Daemon::Actions::$_"
for (qw/Device Port/);
newdaemon( newdaemon(
progname => 'netdisco-daemon', progname => 'netdisco-daemon',

22
Netdisco/lib/Netdisco/Daemon/Actions/Device.pm
View File

@@ -1,7 +1,10 @@
package Netdisco::Daemon::Actions::Device; package Netdisco::Daemon::Actions::Device;
use Netdisco::Util ':port_control'; use Netdisco::Util::Connect qw/snmp_connect get_device/;
use Try::Tiny; use Netdisco::Daemon::Actions::Util ':all';
use namespace::clean;
use Moo::Role;
sub set_location { sub set_location {
my ($self, $job) = @_; my ($self, $job) = @_;
@@ -17,16 +20,15 @@ sub _set_device_generic {
my ($self, $ip, $slot, $data) = @_; my ($self, $ip, $slot, $data) = @_;
$data ||= ''; $data ||= '';
try {
# snmp connect using rw community # snmp connect using rw community
my $info = snmp_connect($ip) 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 $method = 'set_'. $slot;
my $rv = $info->$method($data); my $rv = $info->$method($data);
if (!defined $rv) { 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 || '')); $slot, $ip, ($info->error || ''));
} }
@@ -34,21 +36,17 @@ sub _set_device_generic {
$info->clear_cache; $info->clear_cache;
my $new_data = ($info->$slot || ''); my $new_data = ($info->$slot || '');
if ($new_data ne $data) { 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 # get device details from db
my $device = get_device($ip) 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 # update netdisco DB
$device->update({$slot => $data}); $device->update({$slot => $data});
return _done("Updated $slot on [$ip] to [$data]"); return done("Updated $slot on [$ip] to [$data]");
}
catch {
return _error("Failed to update $slot on [$ip]: $_");
};
} }
1; 1;

29
Netdisco/lib/Netdisco/Daemon/Actions/Port.pm
View File

@@ -1,7 +1,11 @@
package Netdisco::Daemon::Actions::Port; package Netdisco::Daemon::Actions::Port;
use Netdisco::Util ':port_control'; use Netdisco::Util::Connect ':all';
use Try::Tiny; use Netdisco::Util::Permissions 'port_reconfig_check';
use Netdisco::Daemon::Actions::Util ':all';
use namespace::clean;
use Moo::Role;
sub portcontrol { sub portcontrol {
my ($self, $job) = @_; my ($self, $job) = @_;
@@ -10,45 +14,40 @@ sub portcontrol {
my $pn = $job->port; my $pn = $job->port;
(my $dir = $job->subaction) =~ s/-\w+//; (my $dir = $job->subaction) =~ s/-\w+//;
try {
my $port = get_port($ip, $pn) 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); 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; if length $reconfig_check;
# snmp connect using rw community # snmp connect using rw community
my $info = snmp_connect($ip) 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) 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); 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; if !defined $rv;
# confirm the set happened # confirm the set happened
$info->clear_cache; $info->clear_cache;
my $state = ($info->i_up_admin($iid) || ''); my $state = ($info->i_up_admin($iid) || '');
if ($state ne $dir) { 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 # get device details from db
my $device = $port->device 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 # update netdisco DB
$device->update({up_admin => $state}); $device->update({up_admin => $state});
return _done("Updated [$pn] port status on [$ip] to [$state]"); return done("Updated [$pn] port status on [$ip] to [$state]");
}
catch {
return _error("Failed to update [$pn] port status on [$ip]: $_");
};
} }
1; 1;

15
Netdisco/lib/Netdisco/Daemon/Actions/Util.pm Normal file
View 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;

384
Netdisco/lib/Netdisco/Util.pm
View File

@@ -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
View 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
View 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
View 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
View 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;

4
Netdisco/lib/Netdisco/Web/Device.pm
View File

@@ -5,7 +5,7 @@ use Dancer::Plugin::Ajax;
use Dancer::Plugin::DBIC; use Dancer::Plugin::DBIC;
use NetAddr::IP::Lite ':lower'; use NetAddr::IP::Lite ':lower';
use Netdisco::Util (); # for sort_port use Netdisco::Util::Web (); # for sort_port
hook 'before' => sub { hook 'before' => sub {
# list of port detail columns # list of port detail columns
@@ -240,7 +240,7 @@ ajax '/ajax/content/device/ports' => sub {
if param('c_neighbors'); if param('c_neighbors');
# sort ports (empty set would be a 'no records' msg) # 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; return unless scalar @$results;
content_type('text/html'); content_type('text/html');