309 lines
8.2 KiB
Perl
309 lines
8.2 KiB
Perl
package App::Netdisco::Util::Device;
|
|
|
|
use Dancer qw/:syntax :script/;
|
|
use Dancer::Plugin::DBIC 'schema';
|
|
use App::Netdisco::Util::Permission qw/check_acl_no check_acl_only/;
|
|
|
|
use base 'Exporter';
|
|
our @EXPORT = ();
|
|
our @EXPORT_OK = qw/
|
|
get_device
|
|
delete_device
|
|
renumber_device
|
|
match_devicetype
|
|
is_discoverable is_discoverable_now
|
|
is_arpnipable is_arpnipable_now
|
|
is_macsuckable is_macsuckable_now
|
|
/;
|
|
our %EXPORT_TAGS = (all => \@EXPORT_OK);
|
|
|
|
=head1 NAME
|
|
|
|
App::Netdisco::Util::Device
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
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.
|
|
|
|
=head1 EXPORT_OK
|
|
|
|
=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.
|
|
|
|
If for any reason C<$ip> is already a C<DBIx::Class> Device object, then it is
|
|
simply returned.
|
|
|
|
If the device or interface IP is not known to Netdisco a new Device object is
|
|
created for the IP, and returned. This object is in-memory only and not yet
|
|
stored to the database.
|
|
|
|
=cut
|
|
|
|
sub get_device {
|
|
my $ip = shift;
|
|
return unless $ip;
|
|
|
|
# naive check for existing DBIC object
|
|
return $ip if ref $ip;
|
|
|
|
# in case the management IP of one device is in use on another device,
|
|
# we first try to get an exact match for the IP as mgmt interface.
|
|
my $alias =
|
|
schema('netdisco')->resultset('DeviceIp')->find($ip, $ip)
|
|
||
|
|
schema('netdisco')->resultset('DeviceIp')->search({alias => $ip})->first;
|
|
$ip = $alias->ip if defined $alias;
|
|
|
|
return schema('netdisco')->resultset('Device')->with_times
|
|
->find_or_new({ip => $ip});
|
|
}
|
|
|
|
=head2 delete_device( $ip, $archive? )
|
|
|
|
Given an IP address, deletes the device from Netdisco, including all related
|
|
data such as logs and nodes. If the C<$archive> parameter is true, then nodes
|
|
will be maintained in an archive state.
|
|
|
|
Returns true if the transaction completes, else returns false.
|
|
|
|
=cut
|
|
|
|
sub delete_device {
|
|
my ($ip, $archive, $log) = @_;
|
|
my $device = get_device($ip) or return 0;
|
|
return 0 if not $device->in_storage;
|
|
|
|
my $happy = 0;
|
|
schema('netdisco')->txn_do(sub {
|
|
# will delete everything related too...
|
|
schema('netdisco')->resultset('Device')
|
|
->search({ ip => $device->ip })->delete({archive_nodes => $archive});
|
|
|
|
schema('netdisco')->resultset('UserLog')->create({
|
|
username => session('logged_in_user'),
|
|
userip => scalar eval {request->remote_address},
|
|
event => (sprintf "Delete device %s", $device->ip),
|
|
details => $log,
|
|
});
|
|
|
|
$happy = 1;
|
|
});
|
|
|
|
return $happy;
|
|
}
|
|
|
|
=head2 renumber_device( $current_ip, $new_ip )
|
|
|
|
Will update all records in Netdisco referring to the device with
|
|
C<$current_ip> to use C<$new_ip> instead, followed by renumbering the device
|
|
iteself.
|
|
|
|
Returns true if the transaction completes, else returns false.
|
|
|
|
=cut
|
|
|
|
sub renumber_device {
|
|
my ($ip, $new_ip) = @_;
|
|
my $device = get_device($ip) or return 0;
|
|
return 0 if not $device->in_storage;
|
|
|
|
my $happy = 0;
|
|
schema('netdisco')->txn_do(sub {
|
|
$device->renumber($new_ip)
|
|
or die "cannot renumber to: $new_ip"; # rollback
|
|
|
|
schema('netdisco')->resultset('UserLog')->create({
|
|
username => session('logged_in_user'),
|
|
userip => scalar eval {request->remote_address},
|
|
event => (sprintf "Renumber device %s to %s", $device->ip, $new_ip),
|
|
});
|
|
|
|
$happy = 1;
|
|
});
|
|
|
|
return $happy;
|
|
}
|
|
|
|
=head2 match_devicetype( $type, $setting_name )
|
|
|
|
Given a C<$type> (which may be any text value), returns true if any of the
|
|
list of regular expressions in C<$setting_name> is matched, otherwise returns
|
|
false.
|
|
|
|
=cut
|
|
|
|
sub match_devicetype {
|
|
my ($type, $setting_name) = @_;
|
|
return 0 unless $type and $setting_name;
|
|
return (scalar grep {$type =~ m/$_/}
|
|
@{setting($setting_name) || []});
|
|
}
|
|
|
|
sub _bail_msg { debug $_[0]; return 0; }
|
|
|
|
=head2 is_discoverable( $ip, $device_type? )
|
|
|
|
Given an IP address, returns C<true> if Netdisco on this host is permitted by
|
|
the local configuration to discover the device.
|
|
|
|
The configuration items C<discover_no> and C<discover_only> are checked
|
|
against the given IP.
|
|
|
|
If C<$device_type> is also given, then C<discover_no_type> will also be
|
|
checked.
|
|
|
|
Returns false if the host is not permitted to discover the target device.
|
|
|
|
=cut
|
|
|
|
sub is_discoverable {
|
|
my ($ip, $remote_type) = @_;
|
|
my $device = get_device($ip) or return 0;
|
|
|
|
if (match_devicetype($remote_type, 'discover_no_type')) {
|
|
return _bail_msg("is_discoverable: device matched discover_no_type");
|
|
}
|
|
|
|
return _bail_msg("is_discoverable: device matched discover_no")
|
|
if check_acl_no($device, 'discover_no');
|
|
|
|
return _bail_msg("is_discoverable: device failed to match discover_only")
|
|
unless check_acl_only($device, 'discover_only');
|
|
|
|
return 1;
|
|
}
|
|
|
|
=head2 is_discoverable_now( $ip, $device_type? )
|
|
|
|
Same as C<is_discoverable>, but also checks the last_discover field if the
|
|
device is in storage, and returns false if that host has been too recently
|
|
discovered.
|
|
|
|
Returns false if the host is not permitted to discover the target device.
|
|
|
|
=cut
|
|
|
|
sub is_discoverable_now {
|
|
my ($ip, $remote_type) = @_;
|
|
my $device = get_device($ip) or return 0;
|
|
|
|
if ($device->in_storage) {
|
|
if ($device->since_last_discover and setting('discover_min_age')
|
|
and $device->since_last_discover < setting('discover_min_age')) {
|
|
|
|
return _bail_msg("is_discoverable: time since last discover less than discover_min_age");
|
|
}
|
|
}
|
|
|
|
return is_discoverable(@_);
|
|
}
|
|
|
|
=head2 is_arpnipable( $ip )
|
|
|
|
Given an IP address, returns C<true> if Netdisco on this host is permitted by
|
|
the local configuration to arpnip the device.
|
|
|
|
The configuration items C<arpnip_no> and C<arpnip_only> are checked
|
|
against the given IP.
|
|
|
|
Returns false if the host is not permitted to arpnip the target device.
|
|
|
|
=cut
|
|
|
|
sub is_arpnipable {
|
|
my $ip = shift;
|
|
my $device = get_device($ip) or return 0;
|
|
|
|
return _bail_msg("is_arpnipable: device matched arpnip_no")
|
|
if check_acl_no($device, 'arpnip_no');
|
|
|
|
return _bail_msg("is_arpnipable: device failed to match arpnip_only")
|
|
unless check_acl_only($device, 'arpnip_only');
|
|
|
|
return 1;
|
|
}
|
|
|
|
=head2 is_arpnipable_now( $ip )
|
|
|
|
Same as C<is_arpnipable>, but also checks the last_arpnip field if the
|
|
device is in storage, and returns false if that host has been too recently
|
|
arpnipped.
|
|
|
|
Returns false if the host is not permitted to arpnip the target device.
|
|
|
|
=cut
|
|
|
|
sub is_arpnipable_now {
|
|
my ($ip) = @_;
|
|
my $device = get_device($ip) or return 0;
|
|
|
|
return _bail_msg("is_arpnipable: cannot arpnip an undiscovered device")
|
|
if not $device->in_storage;
|
|
|
|
if ($device->since_last_arpnip and setting('arpnip_min_age')
|
|
and $device->since_last_arpnip < setting('arpnip_min_age')) {
|
|
|
|
return _bail_msg("is_arpnipable: time since last arpnip less than arpnip_min_age");
|
|
}
|
|
|
|
return is_arpnipable(@_);
|
|
}
|
|
|
|
=head2 is_macsuckable( $ip )
|
|
|
|
Given an IP address, returns C<true> if Netdisco on this host is permitted by
|
|
the local configuration to macsuck the device.
|
|
|
|
The configuration items C<macsuck_no> and C<macsuck_only> are checked
|
|
against the given IP.
|
|
|
|
Returns false if the host is not permitted to macsuck the target device.
|
|
|
|
=cut
|
|
|
|
sub is_macsuckable {
|
|
my $ip = shift;
|
|
my $device = get_device($ip) or return 0;
|
|
|
|
return _bail_msg("is_macsuckable: device matched macsuck_no")
|
|
if check_acl_no($device, 'macsuck_no');
|
|
|
|
return _bail_msg("is_macsuckable: device failed to match macsuck_only")
|
|
unless check_acl_only($device, 'macsuck_only');
|
|
|
|
return 1;
|
|
}
|
|
|
|
=head2 is_macsuckable_now( $ip )
|
|
|
|
Same as C<is_macsuckable>, but also checks the last_macsuck field if the
|
|
device is in storage, and returns false if that host has been too recently
|
|
macsucked.
|
|
|
|
Returns false if the host is not permitted to macsuck the target device.
|
|
|
|
=cut
|
|
|
|
sub is_macsuckable_now {
|
|
my ($ip) = @_;
|
|
my $device = get_device($ip) or return 0;
|
|
|
|
return _bail_msg("is_macsuckable: cannot macsuck an undiscovered device")
|
|
if not $device->in_storage;
|
|
|
|
if ($device->since_last_macsuck and setting('macsuck_min_age')
|
|
and $device->since_last_macsuck < setting('macsuck_min_age')) {
|
|
|
|
return _bail_msg("is_macsuckable: time since last macsuck less than macsuck_min_age");
|
|
}
|
|
|
|
return is_macsuckable(@_);
|
|
}
|
|
|
|
1;
|