tidy up calls to check_{node|device}_{no|only} to use only check_acl*

lib/App/Netdisco/Core/Macsuck.pm

@@ -3,8 +3,9 @@ package App::Netdisco::Core::Macsuck;
 use Dancer qw/:syntax :script/;
 use Dancer::Plugin::DBIC 'schema';
 
+use App::Netdisco::Util::Permission 'check_acl_no';
 use App::Netdisco::Util::PortMAC 'get_port_macs';
-use App::Netdisco::Util::Device qw/check_device_no match_devicetype/;
+use App::Netdisco::Util::Device 'match_devicetype';
 use App::Netdisco::Util::Node 'check_mac';
 use App::Netdisco::Util::SNMP 'snmp_comm_reindex';
 use Time::HiRes 'gettimeofday';
@@ -367,7 +368,7 @@ sub _walk_fwtable {
       # do not expose MAC address tables via SNMP. relies on prefetched
       # neighbors otherwise it would kill the DB with device lookups.
       my $neigh_cannot_macsuck = eval { # can fail
-          check_device_no($device_port->neighbor, 'macsuck_unsupported') ||
+          check_acl_no($device_port->neighbor, 'macsuck_unsupported') ||
           match_devicetype($device_port->remote_type, 'macsuck_unsupported_type') };
 
       if ($device_port->is_uplink) {

lib/App/Netdisco/Util/Device.pm

@@ -2,7 +2,7 @@ package App::Netdisco::Util::Device;
 
 use Dancer qw/:syntax :script/;
 use Dancer::Plugin::DBIC 'schema';
-use App::Netdisco::Util::Permission 'check_acl';
+use App::Netdisco::Util::Permission qw/check_acl_no check_acl_only/;
 
 use base 'Exporter';
 our @EXPORT = ();
@@ -11,8 +11,6 @@ our @EXPORT_OK = qw/
   delete_device
   renumber_device
   match_devicetype
-  check_device_no
-  check_device_only
   is_discoverable
   is_arpnipable
   is_macsuckable
@@ -146,50 +144,6 @@ sub match_devicetype {
                         @{setting($setting_name) || []});
 }
 
-=head2 check_device_no( $ip, $setting_name )
-
-Given the IP address of a device, returns true if the configuration setting
-C<$setting_name> matches that device, else returns false. If the setting
-is undefined or empty, then C<check_device_no> also returns false.
-
-See L<App::Netdisco::Util::Permission/check_acl> for details of what
-C<$setting_name> can contain.
-
-=cut
-
-sub check_device_no {
-  my ($ip, $setting_name) = @_;
-
-  return 0 unless $ip and $setting_name;
-  my $device = get_device($ip) or return 0;
-
-  my $config = setting($setting_name) || [];
-  return 0 if not scalar @$config;
-
-  return check_acl($device, $config);
-}
-
-=head2 check_device_only( $ip, $setting_name )
-
-Given the IP address of a device, returns true if the configuration setting
-C<$setting_name> matches that device, else returns false. If the setting
-is undefined or empty, then C<check_device_only> also returns true.
-
-See L<App::Netdisco::Util::Permission/check_acl> for details of what
-C<$setting_name> can contain.
-
-=cut
-
-sub check_device_only {
-  my ($ip, $setting_name) = @_;
-  my $device = get_device($ip) or return 0;
-
-  my $config = setting($setting_name) || [];
-  return 1 if not scalar @$config;
-
-  return check_acl($device, $config);
-}
-
 =head2 is_discoverable( $ip, $device_type? )
 
 Given an IP address, returns C<true> if Netdisco on this host is permitted by
@@ -216,10 +170,10 @@ sub is_discoverable {
   }
 
   return _bail_msg("is_discoverable: device matched discover_no")
-    if check_device_no($device, 'discover_no');
+    if check_acl_no($device, 'discover_no');
 
   return _bail_msg("is_discoverable: device failed to match discover_only")
-    unless check_device_only($device, 'discover_only');
+    unless check_acl_only($device, 'discover_only');
 
   # cannot check last_discover for as yet undiscovered devices :-)
   return 1 if not $device->in_storage;
@@ -250,10 +204,10 @@ sub is_arpnipable {
   my $device = get_device($ip) or return 0;
 
   return _bail_msg("is_arpnipable: device matched arpnip_no")
-    if check_device_no($device, 'arpnip_no');
+    if check_acl_no($device, 'arpnip_no');
 
   return _bail_msg("is_arpnipable: device failed to match arpnip_only")
-    unless check_device_only($device, 'arpnip_only');
+    unless check_acl_only($device, 'arpnip_only');
 
   return _bail_msg("is_arpnipable: cannot arpnip an undiscovered device")
     if not $device->in_storage;
@@ -284,10 +238,10 @@ sub is_macsuckable {
   my $device = get_device($ip) or return 0;
 
   return _bail_msg("is_macsuckable: device matched macsuck_no")
-    if check_device_no($device, 'macsuck_no');
+    if check_acl_no($device, 'macsuck_no');
 
   return _bail_msg("is_macsuckable: device failed to match macsuck_only")
-    unless check_device_only($device, 'macsuck_only');
+    unless check_acl_only($device, 'macsuck_only');
 
   return _bail_msg("is_macsuckable: cannot macsuck an undiscovered device")
     if not $device->in_storage;

lib/App/Netdisco/Util/Node.pm

@@ -4,14 +4,12 @@ use Dancer qw/:syntax :script/;
 use Dancer::Plugin::DBIC 'schema';
 
 use NetAddr::MAC;
-use App::Netdisco::Util::Permission 'check_acl';
+use App::Netdisco::Util::Permission qw/check_acl_no check_acl_only/;
 
 use base 'Exporter';
 our @EXPORT = ();
 our @EXPORT_OK = qw/
   check_mac
-  check_node_no
-  check_node_only
   is_nbtstatable
 /;
 our %EXPORT_TAGS = (all => \@EXPORT_OK);
@@ -121,50 +119,6 @@ sub check_mac {
   return $node;
 }
 
-=head2 check_node_no( $ip, $setting_name )
-
-Given the IP address of a node, returns true if the configuration setting
-C<$setting_name> matches that device, else returns false. If the setting
-is undefined or empty, then C<check_node_no> also returns false.
-
- print "rejected!" if check_node_no($ip, 'nbtstat_no');
-
-There are several options for what C<$setting_name> can contain. See
-L<App::Netdisco::Util::Permission> for the details.
-
-=cut
-
-sub check_node_no {
-  my ($ip, $setting_name) = @_;
-
-  my $config = setting($setting_name) || [];
-  return 0 if not scalar @$config;
-
-  return check_acl($ip, $config);
-}
-
-=head2 check_node_only( $ip, $setting_name )
-
-Given the IP address of a node, returns true if the configuration setting
-C<$setting_name> matches that node, else returns false. If the setting
-is undefined or empty, then C<check_node_only> also returns true.
-
- print "rejected!" unless check_node_only($ip, 'nbtstat_only');
-
-There are several options for what C<$setting_name> can contain. See
-L<App::Netdisco::Util::Permission> for the details.
-
-=cut
-
-sub check_node_only {
-  my ($ip, $setting_name) = @_;
-
-  my $config = setting($setting_name) || [];
-  return 1 if not scalar @$config;
-
-  return check_acl($ip, $config);
-}
-
 =head2 is_nbtstatable( $ip )
 
 Given an IP address, returns C<true> if Netdisco on this host is permitted by
@@ -180,9 +134,9 @@ Returns false if the host is not permitted to nbtstat the target node.
 sub is_nbtstatable {
   my $ip = shift;
 
-  return if check_node_no($ip, 'nbtstat_no');
+  return if check_acl_no($ip, 'nbtstat_no');
 
-  return unless check_node_only($ip, 'nbtstat_only');
+  return unless check_acl_only($ip, 'nbtstat_only');
 
   return 1;
 }

lib/App/Netdisco/Util/Permission.pm

@@ -10,7 +10,7 @@ use App::Netdisco::Util::DNS 'hostname_from_ip';
 
 use base 'Exporter';
 our @EXPORT = ();
-our @EXPORT_OK = qw/check_acl/;
+our @EXPORT_OK = qw/check_acl check_acl_no check_acl_only/;
 our %EXPORT_TAGS = (all => \@EXPORT_OK);
 
 =head1 NAME
@@ -26,54 +26,52 @@ subroutines.
 
 =head1 EXPORT_OK
 
-=head2 check_acl( $ip, \@config | $configitem )
+=head2 check_acl_no( $ip | $device, $setting_name )
 
-Given a Device or IP address, compares it to the items in C<< \@config >>
+Given the IP address of a device, returns true if the configuration setting
-then returns true or false. You can control whether any item must match or
+C<$setting_name> matches that device, else returns false. If the setting is
-all must match, and items can be negated to invert the match logic.
+undefined or empty, then C<check_acl_no> also returns false.
 
-There are several options for what C<< \@config >> can contain:
+See L<App::Netdisco::Manual::Configuration> for details of what
+C<$setting_name> can contain.
 
-=over 4
+=cut
 
-=item *
+sub check_acl_no {
+  my ($thing, $setting_name) = @_;
+  return 0 unless $thing and $setting_name;
+  return check_acl($thing, setting($setting_name));
+}
 
-Hostname, IP address, IP prefix (subnet)
+=head2 check_acl_only( $ip | $device, $setting_name )
 
-=item *
+Given the IP address of a device, returns true if the configuration setting
+C<$setting_name> matches that device, else returns false. If the setting is
+undefined or empty, then C<check_acl_only> also returns true.
 
-IP address range, using a hyphen on the last octet/hextet, and no whitespace
+See L<App::Netdisco::Manual::Configuration> for details of what
+C<$setting_name> can contain.
 
-=item *
+=cut
 
-Regular expression in YAML format (no enforced anchors) which will match the
+sub check_acl_only {
-device DNS name (using a fresh DNS lookup, so works on new discovery), e.g.:
+  my ($thing, $setting_name) = @_;
+  return 0 unless $thing and $setting_name;
+  # logic to make an empty config be equivalent to 'any' (i.e. a match)
+  my $config = setting($setting_name);
+  return 1 if not $config # undef or empty string
+              or ((ref [] eq ref $config) and not scalar @$config);
+  return check_acl($thing, $config);
+}
 
- - !!perl/regexp ^sep0.*$
+=head2 check_acl( $ip | $device, $configitem | \@config )
 
-=item *
+Given a Device or IP address, compares it to the items in C<< \@config >> then
+returns true or false. You can control whether any item must match or all must
+match, and items can be negated to invert the match logic.
 
-"C<property:regexp>" - matched against a device property, such as C<model> or
+There are several options for what C<< \@config >> can contain. See
-C<vendor> (with enforced begin/end regexp anchors).
+L<App::Netdisco::Manual::Configuration> for the details.
-
-=item *
-
-"C<group:grpname>" to refer to a named access control list that is in the
-C<host_groups> configuration (C<grpname> is the group name).
-
-=item *
-
-"C<op:and>" to require all items to match (or not match) the provided IP or
-device. Note that this includes IP address version mismatches (v4-v6).
-
-=back
-
-To negate any entry, prefix it with "C<!>", for example "C<!192.0.2.0/29>". In
-that case, the item must I<not> match the device. This does not apply to
-regular expressions (which you can achieve with nonmatching lookahead).
-
-To match any device, use "C<any>". To match no devices we suggest using
-"C<broadcast>" in the list.
 
 =cut
 

lib/App/Netdisco/Util/SNMP.pm

@@ -1,8 +1,8 @@
 package App::Netdisco::Util::SNMP;
 
 use Dancer qw/:syntax :script/;
-use App::Netdisco::Util::Device qw/get_device check_device_no/;
+use App::Netdisco::Util::Device 'get_device';
-use App::Netdisco::Util::Permission qw/check_acl/;
+use App::Netdisco::Util::Permission qw/check_acl_no check_acl/;
 
 use SNMP::Info;
 use Try::Tiny;
@@ -81,7 +81,7 @@ sub _snmp_connect_generic {
   );
 
   # an override for bulkwalk
-  $snmp_args{BulkWalk} = 0 if check_device_no($device, 'bulkwalk_no');
+  $snmp_args{BulkWalk} = 0 if check_acl_no($device, 'bulkwalk_no');
 
   # further protect against buggy Net-SNMP, and disable bulkwalk
   if ($snmp_args{BulkWalk}
@@ -98,9 +98,9 @@ sub _snmp_connect_generic {
 
   # which SNMP versions to try and in what order
   my @versions =
-    ( check_device_no($device->ip, 'snmpforce_v3') ? (3)
+    ( check_acl_no($device->ip, 'snmpforce_v3') ? (3)
-    : check_device_no($device->ip, 'snmpforce_v2') ? (2)
+    : check_acl_no($device->ip, 'snmpforce_v2') ? (2)
-    : check_device_no($device->ip, 'snmpforce_v1') ? (1)
+    : check_acl_no($device->ip, 'snmpforce_v1') ? (1)
     : (reverse (1 .. (setting('snmpver') || 3))) );
 
   # use existing or new device class