Enhance the ACL options to include AND and negation

Squashed commit of the following:

commit 7673f3ee1e
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Sat May 6 14:19:19 2017 +0100

    allow check_acl to accept Device or NetAddr::IP instance

commit c31059bc01
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Sat May 6 14:19:00 2017 +0100

    update docs

commit deaeab2670
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Sat May 6 14:18:27 2017 +0100

    SNMP only stanza has access to full check_acl features

commit 4a44fa5863
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Mon May 1 18:49:38 2017 +0100

    add AND operator and negation support to ACLs
This commit is contained in:
Oliver Gorwits
2017-05-06 15:00:17 +01:00
parent 3654468913
commit 03f41f1177
6 changed files with 252 additions and 147 deletions

View File

@@ -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';

View File

@@ -129,29 +129,8 @@ 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:
=over 4
=item *
Hostname, IP address, IP prefix
=item *
IP address range, using a hyphen and no whitespace
=item *
Regular Expression in YAML format which will match the node DNS name, e.g.:
- !!perl/regexp ^sep0.*$
=back
To simply match all nodes, use "C<any>" or IP Prefix "C<0.0.0.0/0>". All
regular expressions are anchored (that is, they must match the whole string).
To match no nodes we recommend an entry of "C<localhost>" in the setting.
There are several options for what C<$setting_name> can contain. See
L<App::Netdisco::Util::Permission> for the details.
=cut
@@ -172,29 +151,8 @@ 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:
=over 4
=item *
Hostname, IP address, IP prefix
=item *
IP address range, using a hyphen and no whitespace
=item *
Regular Expression in YAML format which will match the node DNS name, e.g.:
- !!perl/regexp ^sep0.*$
=back
To simply match all nodes, use "C<any>" or IP Prefix "C<0.0.0.0/0>". All
regular expressions are anchored (that is, they must match the whole string).
To match no nodes we recommend an entry of "C<localhost>" in the setting.
There are several options for what C<$setting_name> can contain. See
L<App::Netdisco::Util::Permission> for the details.
=cut

View File

@@ -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,9 @@ subroutines.
=head2 check_acl( $ip, \@config )
Given an IP address, returns true if any of the items in C<< \@config >>
matches that address, otherwise returns false.
Normally you use C<check_device_no> and C<check_device_only>, passing the name of the
configuration setting to load. This helper instead requires not the name of
the setting, but its value.
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.
There are several options for what C<< \@config >> can contain:
@@ -40,59 +38,82 @@ 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<vendor> (with enforced begin/end regex anchors)
"C<property:regexp>" - matched against a device property, such as C<model> or
C<vendor> (with enforced begin/end regexp anchors).
=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 simply match all devices, use "C<any>" or IP Prefix "C<0.0.0.0/0>".
Property regular expressions are anchored (that is, they must match the whole
string). To match no devices we recommend an entry of "C<localhost>" in the
setting.
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
sub check_acl {
my ($thing, $config) = @_;
my $real_ip = (blessed $thing ? $thing->ip : $thing);
my $addr = NetAddr::IP::Lite->new($real_ip);
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
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;
return 1 if $name =~ $item;
next;
if ($name =~ $item) {
return 1 if not $all;
}
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
and $thing->$prop =~ m/^$match$/) {
return 1;
if ($neg xor ($thing->can($prop) and defined $thing->$prop
and $thing->$prop =~ m/^$match$/)) {
return 1 if not $all;
}
next;
else {
return 0 if $all;
}
next INLIST;
}
if ($item =~ m/([a-f0-9]+)-([a-f0-9]+)$/i) {
@@ -100,7 +121,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 +130,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;
next INLIST;
}
my $ip = NetAddr::IP::Lite->new($item)
or next;
next unless $ip->bits == $addr->bits;
or next INLIST;
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;

View File

@@ -300,7 +300,7 @@ sub _build_communities {
if not $stanza->{tag}
and !exists $stanza->{community};
if ($stanza->{$mode} and check_acl($device->ip, $stanza->{only})) {
if ($stanza->{$mode} and check_acl($device, $stanza->{only})) {
if ($device->in_storage and
$stored_tag and $stored_tag eq $stanza->{tag}) {
# last known-good by tag