add AND operator and negation support to ACLs

lib/App/Netdisco/Util/DNS.pm

@@ -2,8 +2,8 @@ package App::Netdisco::Util::DNS;
 
 use strict;
 use warnings;
-
 use Dancer ':script';
+
 use Net::DNS;
 use AnyEvent::DNS;
 use NetAddr::IP::Lite ':lower';

lib/App/Netdisco/Util/Permission.pm

@@ -1,7 +1,8 @@
 package App::Netdisco::Util::Permission;
 
+use strict;
+use warnings;
 use Dancer qw/:syntax :script/;
-use Dancer::Plugin::DBIC 'schema';
 
 use Scalar::Util 'blessed';
 use NetAddr::IP::Lite ':lower';
@@ -27,12 +28,13 @@ subroutines.
 
 =head2 check_acl( $ip, \@config )
 
-Given an IP address, returns true if any of the items in C<< \@config >>
+Given a Device or IP address, compares it to the items in C<< \@config >>
-matches that address, otherwise returns false.
+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.
 
-Normally you use C<check_device_no> and C<check_device_only>, passing the name of the
+Normally you use C<< *_no >> and C<< *_only >> settings, passing the name of
-configuration setting to load. This helper instead requires not the name of
+the configuration setting to load. This helper instead requires not the name
-the setting, but its value.
+of the setting, but its value (a list of network or device identifiers).
 
 There are several options for what C<< \@config >> can contain:
 
@@ -40,30 +42,43 @@ There are several options for what C<< \@config >> can contain:
 
 =item *
 
-Hostname, IP address, IP prefix
+Hostname, IP address, IP prefix (subnet)
 
 =item *
 
-IP address range, using a hyphen and no whitespace
+IP address range, using a hyphen on the last octet/hextet, and no whitespace
 
 =item *
 
-Regular Expression in YAML format (no enforced anchors) which will match the
+Regular expression in YAML format (no enforced anchors) which will match the
 device DNS name (using a fresh DNS lookup, so works on new discovery), e.g.:
 
  - !!perl/regexp ^sep0.*$
 
 =item *
 
-C<"property:regex"> - matched against a device property, such as C<model> or
+"C<property:regexp>" - matched against a device property, such as C<model> or
-C<vendor> (with enforced begin/end regex anchors)
+C<vendor> (with enforced begin/end regexp anchors).
+
+=item *
+
+"C<op:and>" to require all items to match (or not if negated) the provided IP
+or device. Note that this includes IP address version mismatches (v4-v6).
 
 =back
 
-To simply match all devices, use "C<any>" or IP Prefix "C<0.0.0.0/0>".
+To negate any entry, prefix it with "C<!>", for example "C<!192.0.2.0/29>". In
-Property regular expressions are anchored (that is, they must match the whole
+that case, the item must I<not> match the device. This does not apply to
-string). To match no devices we recommend an entry of "C<localhost>" in the
+regualr expressions (which you can achieve with nonmatching lookahead).
-setting.
+
+To match any device, use "C<any>". To match no devices we suggest using
+"C<broadcast>" in the list.
+
+Device property regular expressions are anchored (that is, they must match the
+whole string). Device name regexp are not anchored.
+
+Default operation is to return true if I<any> of the items matches. To enforce
+requirement that I<all> items match, include "C<op:and>" anywhere in the list.
 
 =cut
 
@@ -71,28 +86,40 @@ sub check_acl {
   my ($thing, $config) = @_;
   my $real_ip = (blessed $thing ? $thing->ip : $thing);
   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);
+
+  INLIST: foreach my $item (@$config) {
+      next INLIST if $item eq 'op:and';
 
-  foreach my $item (@$config) {
       if (ref qr// eq ref $item) {
-          my $name = hostname_from_ip($addr->addr) or next;
+          if ($name =~ $item) {
-          return 1 if $name =~ $item;
+            return 1 if not $all;
-          next;
+          }
+          else {
+            return 0 if $all;
+          }
+          next INLIST;
       }
 
+      my $neg = ($item =~ s/^!//);
+
       if ($item =~ m/^([^:]+)\s*:\s*([^:]+)$/) {
           my $prop  = $1;
           my $match = $2;
 
           # if not in storage, we can't do much with device properties
-          next unless blessed $thing and $thing->in_storage;
+          next INLIST unless blessed $thing and $thing->in_storage;
 
           # lazy version of vendor: and model:
-          if ($thing->can($prop) and defined $thing->$prop
+          if ($neg xor ($thing->can($prop) and defined $thing->$prop
-              and $thing->$prop =~ m/^$match$/) {
+              and $thing->$prop =~ m/^$match$/)) {
-              return 1;
+            return 1 if not $all;
           }
-
+          else {
-          next;
+            return 0 if $all;
+          }
+          next INLIST;
       }
 
       if ($item =~ m/([a-f0-9]+)-([a-f0-9]+)$/i) {
@@ -100,7 +127,7 @@ sub check_acl {
           my $last  = $2;
 
           if ($item =~ m/:/) {
-              next unless $addr->bits == 128;
+              next INLIST if $addr->bits != 128 and not $all;
 
               $first = hex $first;
               $last  = hex $last;
@@ -109,31 +136,46 @@ sub check_acl {
               foreach my $part ($first .. $last) {
                   my $ip = NetAddr::IP::Lite->new($header . sprintf('%x',$part) . '/128')
                     or next;
-                  return 1 if $ip == $addr;
+                  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 unless $addr->bits == 32;
+              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;
-                  return 1 if $ip == $addr;
+                  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;
-          next;
       }
 
       my $ip = NetAddr::IP::Lite->new($item)
-        or next;
+        or next INLIST;
-      next unless $ip->bits == $addr->bits;
+      next INLIST if $ip->bits != $addr->bits and not $all;
 
-      return 1 if $ip->contains($addr);
+      if ($neg xor ($ip->contains($addr))) {
+        return 1 if not $all;
+      }
+      else {
+        return 0 if $all;
+      }
+      next INLIST;
   }
 
-  return 0;
+  return ($all ? 1 : 0);
 }
 
 1;

t/20-checkacl.t

@@ -0,0 +1,94 @@
+#!/usr/bin/env perl
+
+use strict; use warnings FATAL => 'all';
+use Test::More 1.302083;
+
+BEGIN {
+  use_ok( 'App::Netdisco::Util::Permission', 'check_acl' );
+}
+
+my @conf = (
+  # +ve match       -ve match
+  'localhost',     '!www.example.com', # 0, 1
+  '127.0.0.1',     '!192.0.2.1',       # 2, 3
+  '::1',           '!2001:db8::1',     # 4, 5
+  '127.0.0.0/29',  '!192.0.2.0/24',    # 6, 7
+  '::1/128',       '!2001:db8::/32',   # 8, 9
+
+  '127.0.0.1-10',  '!192.0.2.1-10',    # 10,11
+  '::1-10',        '!2001:db8::1-10',  # 12,13
+
+  qr/^localhost$/, qr/^www.example.com$/,    # 14,15
+  qr/(?!:www.example.com)/, '!127.0.0.0/29', # 16,17
+  '!127.0.0.1-10', qr/(?!:localhost)/,       # 18,19
+
+  'op:and', # 20
+);
+
+# name, ipv4, ipv6, v4 prefix, v6 prefix
+ok(check_acl('localhost',[$conf[0]]), 'same name');
+ok(check_acl('127.0.0.1',[$conf[2]]), 'same ipv4');
+ok(check_acl('::1',[$conf[4]]), 'same ipv6');
+ok(check_acl('127.0.0.0/29',[$conf[6]]), 'same v4 prefix');
+ok(check_acl('::1/128',[$conf[8]]), 'same v6 prefix');
+
+# failed name, ipv4, ipv6, v4 prefix, v6 prefix
+is(check_acl('www.microsoft.com',[$conf[0]]),  0, 'failed name');
+is(check_acl('172.20.0.1',[$conf[2]]),         0, 'failed ipv4');
+is(check_acl('2001:db8::5',[$conf[4]]),        0, 'failed ipv6');
+is(check_acl('172.16.1.3/29',[$conf[6]]),      0, 'failed v4 prefix');
+is(check_acl('2001:db8:f00d::/64',[$conf[8]]), 0, 'failed v6 prefix');
+
+# negated name, ipv4, ipv6, v4 prefix, v6 prefix
+ok(check_acl('localhost',[$conf[1]]), 'not same name');
+ok(check_acl('127.0.0.1',[$conf[3]]), 'not same ipv4');
+ok(check_acl('::1',[$conf[5]]), 'not same ipv6');
+ok(check_acl('127.0.0.0/29',[$conf[7]]), 'not same v4 prefix');
+ok(check_acl('::1/128',[$conf[9]]), 'not same v6 prefix');
+
+# v4 range, v6 range
+ok(check_acl('127.0.0.1',[$conf[10]]), 'in v4 range');
+ok(check_acl('::1',[$conf[12]]), 'in v6 range');
+
+# failed v4 range, v6 range
+is(check_acl('172.20.0.1',[$conf[10]]), 0, 'failed v4 range');
+is(check_acl('2001:db8::5',[$conf[12]]), 0, 'failed v6 range');
+
+# negated v4 range, v6 range
+ok(check_acl('127.0.0.1',[$conf[11]]), 'not in v4 range');
+ok(check_acl('::1',[$conf[13]]), 'not in v6 range');
+
+# hostname regexp
+ok(check_acl('localhost',[$conf[14]]), 'name regexp');
+ok(check_acl('127.0.0.1',[$conf[14]]), 'IP regexp');
+is(check_acl('www.google.com',[$conf[14]]), 0, 'failed regexp');
+
+# OR of prefix, range, regexp, property (2 of, 3 of, 4 of)
+ok(check_acl('127.0.0.1',[@conf[8,0]]), 'OR: prefix, name');
+ok(check_acl('127.0.0.1',[@conf[8,12,0]]), 'OR: prefix, range, name');
+ok(check_acl('127.0.0.1',[@conf[8,12,15,0]]), 'OR: prefix, range, regexp, name');
+
+# OR of negated prefix, range, regexp, property (2 of, 3 of, 4 of)
+ok(check_acl('127.0.0.1',[@conf[17,0]]), 'OR: !prefix, name');
+ok(check_acl('127.0.0.1',[@conf[17,18,0]]), 'OR: !prefix, !range, name');
+ok(check_acl('127.0.0.1',[@conf[17,18,19,0]]), 'OR: !prefix, !range, !regexp, name');
+
+# AND of prefix, range, regexp, property (2 of, 3 of, 4 of)
+ok(check_acl('127.0.0.1',[@conf[6,0,20]]), 'AND: prefix, name');
+ok(check_acl('127.0.0.1',[@conf[6,10,0,20]]), 'AND: prefix, range, name');
+ok(check_acl('127.0.0.1',[@conf[6,10,14,0,20]]), 'AND: prefix, range, regexp, name');
+
+# failed AND on prefix, range, regexp
+is(check_acl('127.0.0.1',[@conf[8,10,14,0,20]]), 0, 'failed AND: prefix!, range, regexp, name');
+is(check_acl('127.0.0.1',[@conf[6,12,14,0,20]]), 0, 'failed AND: prefix, range!, regexp, name');
+is(check_acl('127.0.0.1',[@conf[6,10,15,0,20]]), 0, 'failed AND: prefix, range, regexp!, name');
+
+# AND of negated prefix, range, regexp, property (2 of, 3 of, 4 of)
+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');
+
+# device property
+# negated device property
+
+done_testing;