Squashed commit of the following: commit789c528fcfAuthor: Oliver Gorwits <oliver@cpan.org> Date: Mon Apr 1 19:31:07 2013 +0100 update manifest and fix typo commitb95d0951f2Author: Oliver Gorwits <oliver@cpan.org> Date: Mon Apr 1 19:22:41 2013 +0100 refactor ::Util namespace commita8dde50343Author: Oliver Gorwits <oliver@cpan.org> Date: Sun Mar 31 13:45:27 2013 +0100 no need to search for device - IP should already be exact
90 lines
2.0 KiB
Perl
90 lines
2.0 KiB
Perl
package App::Netdisco::Util::Device;
|
|
|
|
use Dancer qw/:syntax :script/;
|
|
use Dancer::Plugin::DBIC 'schema';
|
|
|
|
use NetAddr::IP::Lite ':lower';
|
|
|
|
use base 'Exporter';
|
|
our @EXPORT = ();
|
|
our @EXPORT_OK = qw/
|
|
get_device
|
|
is_discoverable
|
|
/;
|
|
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 FUNCTIONS
|
|
|
|
=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 is_discoverable( $ip )
|
|
|
|
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.
|
|
|
|
Returns false if the host is not permitted to discover the target device.
|
|
|
|
=cut
|
|
|
|
sub is_discoverable {
|
|
my $q = shift;
|
|
|
|
my $device = get_device($q) or return 0;
|
|
my $addr = NetAddr::IP::Lite->new($device->ip);
|
|
|
|
my $discover_no = setting('discover_no') || [];
|
|
my $discover_only = setting('discover_only') || [];
|
|
|
|
if (scalar @$discover_no) {
|
|
foreach my $item (@$discover_no) {
|
|
my $ip = NetAddr::IP::Lite->new($item) or return 0;
|
|
return 0 if $ip->contains($addr);
|
|
}
|
|
}
|
|
|
|
if (scalar @$discover_only) {
|
|
my $okay = 0;
|
|
foreach my $item (@$discover_only) {
|
|
my $ip = NetAddr::IP::Lite->new($item) or return 0;
|
|
++$okay if $ip->contains($addr);
|
|
}
|
|
return 0 if not $okay;
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
1;
|