diff --git a/lib/App/Netdisco/Util/Device.pm b/lib/App/Netdisco/Util/Device.pm index c141408f..98afbe0c 100644 --- a/lib/App/Netdisco/Util/Device.pm +++ b/lib/App/Netdisco/Util/Device.pm @@ -2,7 +2,8 @@ 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 App::Netdisco::Util::Permission + qw/check_acl_no check_acl_only acl_to_where_clause/; use base 'Exporter'; our @EXPORT = (); @@ -11,7 +12,7 @@ our @EXPORT_OK = qw/ delete_device renumber_device match_to_setting - device_ips_matching device_ips_not_matching + device_ips_matching is_discoverable is_discoverable_now is_arpnipable is_arpnipable_now is_macsuckable is_macsuckable_now @@ -145,21 +146,25 @@ sub match_to_setting { @{setting($setting_name) || []}); } -=head2 device_ips_matching( $setting_name | $acl_entry | \@acl, @IPs? ) +=head2 device_ips_matching( $setting_name | $acl_entry | \@acl, ... ) -Returns a list of Device IPs that match the given ACL. If the ACL is -missing then no device IPs will be returned. If the C< @IPs > list is -provided then it will be used otherwise the current devices in Netdisco's -database will be used as the source list. +Returns a list of Device IPs that match the given ACL. If the ACL is missing +then no device IPs will be returned. If a second ACL is also passed then that +will work as an exclusion list applied at the same time. =cut sub device_ips_matching { - my ($acl, @ips) = @_; - return () unless $acl; - my $config = (exists config->{"$acl"} ? setting($acl) : $acl); - my @startlist = (scalar @ips ? @ips : - schema('netdisco')->resultset('Device')->get_column('ip')->all); + my ($acl_only, $acl_no) = @_; + return () unless $acl_only; + my $only = acl_to_where_clause($acl_only); + my $no = acl_to_where_clause($acl_no); + my $no_query = schema('netdisco')->resultset('Device') + ->search({ $no }, { select => ['ip'] }); + + return schema('netdisco')->resultset('Device')->search({ $only, + ($no ? { ip => { -not_in => $no_query->as_query } } : ()) }) + ->get_column('ip')->all; } sub _bail_msg { debug $_[0]; return 0; } diff --git a/lib/App/Netdisco/Util/Permission.pm b/lib/App/Netdisco/Util/Permission.pm index 1ef33d40..d1947efa 100644 --- a/lib/App/Netdisco/Util/Permission.pm +++ b/lib/App/Netdisco/Util/Permission.pm @@ -10,7 +10,12 @@ use App::Netdisco::Util::DNS 'hostname_from_ip'; use base 'Exporter'; our @EXPORT = (); -our @EXPORT_OK = qw/check_acl check_acl_no check_acl_only/; +our @EXPORT_OK = qw/ + check_acl + check_acl_no + check_acl_only + acl_to_where_clause +/; our %EXPORT_TAGS = (all => \@EXPORT_OK); =head1 NAME @@ -217,4 +222,135 @@ sub check_acl { return ($all ? 1 : 0); } -1; +=head2 acl_to_where_clause( $setting_name | $acl_entry | \@acl ) + +Returns an L where clause which when applied to the devices +table should return the matching records only. + +If C<$setting_name> is a valid setting, then it will be resolved to the access +control list, else we assume you passed an ACL entry or ACL. + +A missing parameter will return the C value (usually C<1=1>). + +See L +for details of what C<$acl> may contain. + +=cut + +sub check_acl_only { + my ($setting_name) = @_; + return (1 => 1) unless $setting_name; + my $config = (exists config->{"$setting_name"} ? setting($setting_name) + : $setting_name); + + $config = [$config] if ref [] ne ref $config; + my $all = (scalar grep {$_ eq 'op:and'} @$config); + + my $ropt = { retry => 1, retrans => 1, udp_timeout => 1, tcp_timeout => 2 }; + my $qref = ref qr//; + my %where = (); + + INLIST: foreach (@$config) { + my $item = $_; # must copy so that we can modify safely + next INLIST if !defined $item or $item eq 'op:and'; + + if ($qref eq ref $item) { + push @{ $where{dns}{ + $name = ($name || hostname_from_ip($addr->addr, $ropt) || '!!none!!'); + if ($name =~ $item) { + return 1 if not $all; + } + else { + return 0 if $all; + } + next INLIST; + } + + my $neg = ($item =~ s/^!//); + + if ($item =~ m/^group:(.+)$/) { + my $group = $1; + setting('host_groups')->{$group} ||= []; + + if ($neg xor check_acl($thing, setting('host_groups')->{$group})) { + return 1 if not $all; + } + else { + return 0 if $all; + } + next INLIST; + } + + if ($item =~ m/^([^:]+):([^:]+)$/) { + my $prop = $1; + my $match = $2; + + # if not an object, we can't do much with properties + next INLIST unless blessed $thing; + + # lazy version of vendor: and model: + if ($neg xor ($thing->can($prop) and defined eval { $thing->$prop } + and $thing->$prop =~ m/^$match$/)) { + return 1 if not $all; + } + else { + return 0 if $all; + } + next INLIST; + } + + if ($item =~ m/[:.]([a-f0-9]+)-([a-f0-9]+)$/i) { + my $first = $1; + my $last = $2; + + if ($item =~ m/:/) { + next INLIST if $addr->bits != 128 and not $all; + + $first = hex $first; + $last = hex $last; + + (my $header = $item) =~ s/:[^:]+$/:/; + foreach my $part ($first .. $last) { + my $ip = NetAddr::IP::Lite->new($header . sprintf('%x',$part) . '/128') + or next; + if ($neg xor ($ip == $addr)) { + return 1 if not $all; + next INLIST; + } + } + return 0 if (not $neg and $all); + return 1 if ($neg and not $all); + } + else { + next INLIST if $addr->bits != 32 and not $all; + + (my $header = $item) =~ s/\.[^.]+$/./; + foreach my $part ($first .. $last) { + my $ip = NetAddr::IP::Lite->new($header . $part . '/32') + or next; + if ($neg xor ($ip == $addr)) { + return 1 if not $all; + next INLIST; + } + } + return 0 if (not $neg and $all); + return 1 if ($neg and not $all); + } + next INLIST; + } + + my $ip = NetAddr::IP::Lite->new($item) + or next INLIST; + next INLIST if $ip->bits != $addr->bits and not $all; + + if ($neg xor ($ip->contains($addr))) { + return 1 if not $all; + } + else { + return 0 if $all; + } + next INLIST; + } +} + +true;