basic implementation of named acls (need to tidy up calls to check_acl)

lib/App/Netdisco/Util/Permission.pm

@@ -26,7 +26,7 @@ subroutines.
 
 =head1 EXPORT_OK
 
-=head2 check_acl( $ip, \@config )
+=head2 check_acl( $ip, \@config | $configitem )
 
 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
@@ -58,6 +58,11 @@ C<vendor> (with enforced begin/end regexp anchors).
 
 =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).
 
@@ -74,11 +79,14 @@ To match any device, use "C<any>". To match no devices we suggest using
 
 sub check_acl {
   my ($thing, $config) = @_;
+  return 0 unless defined $thing and defined $config;
+
   my $real_ip = (
     (blessed $thing and $thing->can('ip')) ? $thing->ip : (
       (blessed $thing and $thing->can('addr')) ? $thing->addr : $thing ));
   return 0 if blessed $real_ip; # class we do not understand
 
+  $config  = [$config] if ref [] ne ref $config;
   my $addr = NetAddr::IP::Lite->new($real_ip);
   my $name = hostname_from_ip($addr->addr) || '!!NO_HOSTNAME!!';
   my $all  = (scalar grep {m/^op:and$/} @$config);
@@ -98,7 +106,20 @@ sub check_acl {
 
       my $neg = ($item =~ s/^!//);
 
-      if ($item =~ m/^([^:]+)\s*:\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;
 

share/config.yml

@@ -115,6 +115,7 @@ login_logo: ""
 
 # mibhome is discovered from environment
 # mibdirs defaults to contents of mibhome
+host_groups: {}
 community: ['public']
 community_rw: ['private']
 snmp_auth: []

xt/20-checkacl.t

@@ -4,9 +4,12 @@ use strict; use warnings FATAL => 'all';
 use Test::More 1.302083;
 
 BEGIN {
+  use_ok( 'App::Netdisco::Configuration', 'check_acl' );
   use_ok( 'App::Netdisco::Util::Permission', 'check_acl' );
 }
 
+use Dancer qw/:script !pass/;
+
 my @conf = (
   # +ve match       -ve match
   'localhost',     '!www.example.com', # 0, 1
@@ -22,7 +25,9 @@ my @conf = (
   qr/(?!:www.example.com)/, '!127.0.0.0/29', # 16,17
   '!127.0.0.1-10', qr/(?!:localhost)/,       # 18,19
 
-  'op:and', # 20
+  'op:and',    # 20
+  'group:groupreftest',  # 21
+  '!group:groupreftest', # 22
 );
 
 # name, ipv4, ipv6, v4 prefix, v6 prefix
@@ -88,6 +93,12 @@ ok(check_acl('127.0.0.1',[@conf[9,0,20]]), 'AND: !prefix, name');
 ok(check_acl('127.0.0.1',[@conf[7,11,0,20]]), 'AND: !prefix, !range, name');
 ok(check_acl('127.0.0.1',[@conf[9,13,16,0,20]]), 'AND: !prefix, !range, !regexp, name');
 
+is(check_acl('192.0.2.1',[$conf[22]]), 1, '!missing group ref');
+is(check_acl('192.0.2.1',[$conf[21]]), 0, 'failed missing group ref');
+setting('host_groups')->{'groupreftest'} = ['192.0.2.1'];
+is(check_acl('192.0.2.1',[$conf[21]]), 1, 'group ref');
+is(check_acl('192.0.2.1',[$conf[22]]), 0, 'failed !missing group ref');
+
 # device property
 # negated device property