From 4e4012c0519d0d8b5a8505587036b929df41940b Mon Sep 17 00:00:00 2001 From: Oliver Gorwits Date: Sun, 9 Dec 2012 15:17:25 +0000 Subject: [PATCH] large refactor for Util.pm; use Moo for Daemon Actions --- Netdisco/bin/netdisco-daemon | 13 +- .../lib/Netdisco/Daemon/Actions/Device.pm | 60 ++- Netdisco/lib/Netdisco/Daemon/Actions/Port.pm | 67 ++- Netdisco/lib/Netdisco/Daemon/Actions/Util.pm | 15 + Netdisco/lib/Netdisco/Util.pm | 384 ------------------ Netdisco/lib/Netdisco/Util/Connect.pm | 140 +++++++ .../lib/Netdisco/Util/DeviceProperties.pm | 96 +++++ Netdisco/lib/Netdisco/Util/Permissions.pm | 76 ++++ Netdisco/lib/Netdisco/Util/Web.pm | 117 ++++++ Netdisco/lib/Netdisco/Web/Device.pm | 4 +- 10 files changed, 515 insertions(+), 457 deletions(-) create mode 100644 Netdisco/lib/Netdisco/Daemon/Actions/Util.pm delete mode 100644 Netdisco/lib/Netdisco/Util.pm create mode 100644 Netdisco/lib/Netdisco/Util/Connect.pm create mode 100644 Netdisco/lib/Netdisco/Util/DeviceProperties.pm create mode 100644 Netdisco/lib/Netdisco/Util/Permissions.pm create mode 100644 Netdisco/lib/Netdisco/Util/Web.pm diff --git a/Netdisco/bin/netdisco-daemon b/Netdisco/bin/netdisco-daemon index 45e48638..a6665625 100755 --- a/Netdisco/bin/netdisco-daemon +++ b/Netdisco/bin/netdisco-daemon @@ -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', diff --git a/Netdisco/lib/Netdisco/Daemon/Actions/Device.pm b/Netdisco/lib/Netdisco/Daemon/Actions/Device.pm index e9939dcf..8e08ae77 100644 --- a/Netdisco/lib/Netdisco/Daemon/Actions/Device.pm +++ b/Netdisco/lib/Netdisco/Daemon/Actions/Device.pm @@ -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,38 +20,33 @@ 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"); + # snmp connect using rw community + my $info = snmp_connect($ip) + or return error("Failed to connect to device [$ip] to update $slot"); - my $method = 'set_'. $slot; - my $rv = $info->$method($data); + my $method = 'set_'. $slot; + my $rv = $info->$method($data); - if (!defined $rv) { - return _error(sprintf 'Failed to set %s on [%s]: %s', - $slot, $ip, ($info->error || '')); - } - - # confirm the set happened - $info->clear_cache; - my $new_data = ($info->$slot || ''); - if ($new_data ne $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"); - - # update netdisco DB - $device->update({$slot => $data}); - - return _done("Updated $slot on [$ip] to [$data]"); + if (!defined $rv) { + return error(sprintf 'Failed to set %s on [%s]: %s', + $slot, $ip, ($info->error || '')); } - catch { - return _error("Failed to update $slot on [$ip]: $_"); - }; + + # confirm the set happened + $info->clear_cache; + my $new_data = ($info->$slot || ''); + if ($new_data ne $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"); + + # update netdisco DB + $device->update({$slot => $data}); + + return done("Updated $slot on [$ip] to [$data]"); } 1; diff --git a/Netdisco/lib/Netdisco/Daemon/Actions/Port.pm b/Netdisco/lib/Netdisco/Daemon/Actions/Port.pm index 1585ffe0..3e746204 100644 --- a/Netdisco/lib/Netdisco/Daemon/Actions/Port.pm +++ b/Netdisco/lib/Netdisco/Daemon/Actions/Port.pm @@ -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]"); + my $port = get_port($ip, $pn) + or return error("Unknown port name [$pn] on device [$ip]"); - my $reconfig_check = port_reconfig_check($port); - return _error("Cannot alter port: $reconfig_check") - if length $reconfig_check; + my $reconfig_check = port_reconfig_check($port); + 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"); + # snmp connect using rw community + my $info = snmp_connect($ip) + 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]"); + my $iid = get_iid($port) + 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]") - if !defined $rv; + 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"); - } - - # get device details from db - my $device = $port->device - 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]"); + # 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"); } - catch { - return _error("Failed to update [$pn] port status on [$ip]: $_"); - }; + + # get device details from db + my $device = $port->device + 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]"); } 1; diff --git a/Netdisco/lib/Netdisco/Daemon/Actions/Util.pm b/Netdisco/lib/Netdisco/Daemon/Actions/Util.pm new file mode 100644 index 00000000..d6322cb9 --- /dev/null +++ b/Netdisco/lib/Netdisco/Daemon/Actions/Util.pm @@ -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; diff --git a/Netdisco/lib/Netdisco/Util.pm b/Netdisco/lib/Netdisco/Util.pm deleted file mode 100644 index cf5cdfe0..00000000 --- a/Netdisco/lib/Netdisco/Util.pm +++ /dev/null @@ -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 and C subroutines. - -=cut - -sub _done { return ('done', shift) } -sub _error { return ('error', shift) } - -=head2 is_discoverable( $ip ) - -Given an IP address, returns C if Netdisco on this host is permitted to -discover its configuration by the local Netdisco configuration file. - -The configuration items C and C 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 store under -the C 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 object for the Device in -the Netdisco database. The IP can be for any interface on the device. - -Returns C 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 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 otherwise the connection will fail (it is required for SNMP -settings). - -Returns C 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 - 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; diff --git a/Netdisco/lib/Netdisco/Util/Connect.pm b/Netdisco/lib/Netdisco/Util/Connect.pm new file mode 100644 index 00000000..e346c489 --- /dev/null +++ b/Netdisco/lib/Netdisco/Util/Connect.pm @@ -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 object for the Device in +the Netdisco database. The IP can be for any interface on the device. + +Returns C 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 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 otherwise the connection will fail (it is required for SNMP +settings). + +Returns C 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; diff --git a/Netdisco/lib/Netdisco/Util/DeviceProperties.pm b/Netdisco/lib/Netdisco/Util/DeviceProperties.pm new file mode 100644 index 00000000..0f1df530 --- /dev/null +++ b/Netdisco/lib/Netdisco/Util/DeviceProperties.pm @@ -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 if Netdisco on this host is permitted to +discover its configuration by the local Netdisco configuration file. + +The configuration items C and C 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; diff --git a/Netdisco/lib/Netdisco/Util/Permissions.pm b/Netdisco/lib/Netdisco/Util/Permissions.pm new file mode 100644 index 00000000..ad1c10e1 --- /dev/null +++ b/Netdisco/lib/Netdisco/Util/Permissions.pm @@ -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; diff --git a/Netdisco/lib/Netdisco/Util/Web.pm b/Netdisco/lib/Netdisco/Util/Web.pm new file mode 100644 index 00000000..75726084 --- /dev/null +++ b/Netdisco/lib/Netdisco/Util/Web.pm @@ -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 - 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; diff --git a/Netdisco/lib/Netdisco/Web/Device.pm b/Netdisco/lib/Netdisco/Web/Device.pm index 397a7dbd..6e0c1f4f 100644 --- a/Netdisco/lib/Netdisco/Web/Device.pm +++ b/Netdisco/lib/Netdisco/Web/Device.pm @@ -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');