135/netdisco
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Refactored ACL support with multi-object compare

Browse Source 
Squashed commit of the following:

commit 4081e22202693bd7c4ea00e95daad8e628c6fd5a
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Mon May 29 21:02:07 2023 +0100

    large rename of check_acl* to acl_matches*

commit 3cfa284ddd24d68765c255578cc5c184afbdcd83
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Fri May 19 20:39:03 2023 +0100

    update permission doc

commit 8c7bb93cc5e9fafb770f98f446e45cbd94b14894
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Wed May 17 21:50:07 2023 +0100

    migrate most check_acl_only to acl_matches_only

commit c47f699f2a22f08f2f3e093ed0f24c891e6f9a82
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Wed May 17 21:39:19 2023 +0100

    rename check_acl* to be acl_matches*

commit a884a22c3ab1f3262118c3a47ed8e25b0b0a7336
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Sun May 14 16:50:42 2023 +0100

    update macsuck_no_deviceports to use acl_matches

commit 8c256af728721329b64d071fa529dfc844073ac6
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Sun May 7 22:54:33 2023 +0100

    update hide_deviceports to use acl_matches multi @things

commit cd5d9978aba1da459be4fed4500f395df13f7784
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Sun May 7 22:53:38 2023 +0100

    check_acl fix to allow all @things to offer a property before fallback to missing as empty string

commit 1a3ab9a7646e9f994f03126d45fc36e9e5a13ed5
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Tue May 2 15:31:17 2023 +0100

    add ignore_deviceports to portproperties discover; improve comments

commit 51385ce89458dc939587dae902fda431719c22c9
Merge: b97c07d2 3f8ffe78
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Tue May 2 15:21:48 2023 +0100

    Merge branch 'master' into og-acl_multidict

commit b97c07d237d750c1d9eb3095d8ff3908512eac2a
Author: Oliver Gorwits <oliver@cpan.org>
Date:   Sat Mar 25 14:37:53 2023 +0000

    add support for arrayref of items, and unblessed hash, to check_acl
This commit is contained in:
Oliver Gorwits
2023-05-29 21:32:07 +01:00
parent 3f8ffe787f
commit 9355f5c2b9
27 changed files with 463 additions and 335 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
lib/App/Netdisco/Util/Device.pm
View File

@@ -2,7 +2,7 @@ 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/acl_matches acl_matches_only/;
use File::Spec::Functions qw(catdir catfile);
use File::Path 'make_path';
@@ -184,10 +184,10 @@ sub is_discoverable {
if (match_to_setting($remote_type, 'discover_no_type'));
return _bail_msg("is_discoverable: $device matched discover_no")
if check_acl_no($device, 'discover_no');
if acl_matches($device, 'discover_no');
return _bail_msg("is_discoverable: $device failed to match discover_only")
unless check_acl_only($device, 'discover_only');
unless acl_matches_only($device, 'discover_only');
return 1;
}
@@ -236,14 +236,14 @@ sub is_arpnipable {
return _bail_msg("is_arpnipable: $device has no layer 3 capability")
if ($device->in_storage() and not ($device->has_layer(3)
or check_acl_no($device, 'force_arpnip')
or check_acl_no($device, 'ignore_layers')));
or acl_matches($device, 'force_arpnip')
or acl_matches($device, 'ignore_layers')));
return _bail_msg("is_arpnipable: $device matched arpnip_no")
if check_acl_no($device, 'arpnip_no');
if acl_matches($device, 'arpnip_no');
return _bail_msg("is_arpnipable: $device failed to match arpnip_only")
unless check_acl_only($device, 'arpnip_only');
unless acl_matches_only($device, 'arpnip_only');
return 1;
}
@@ -292,17 +292,17 @@ sub is_macsuckable {
return _bail_msg("is_macsuckable: $device has no layer 2 capability")
if ($device->in_storage() and not ($device->has_layer(2)
or check_acl_no($device, 'force_macsuck')
or check_acl_no($device, 'ignore_layers')));
or acl_matches($device, 'force_macsuck')
or acl_matches($device, 'ignore_layers')));
return _bail_msg("is_macsuckable: $device matched macsuck_no")
if check_acl_no($device, 'macsuck_no');
if acl_matches($device, 'macsuck_no');
return _bail_msg("is_macsuckable: $device matched macsuck_unsupported")
if check_acl_no($device, 'macsuck_unsupported');
if acl_matches($device, 'macsuck_unsupported');
return _bail_msg("is_macsuckable: $device failed to match macsuck_only")
unless check_acl_only($device, 'macsuck_only');
unless acl_matches_only($device, 'macsuck_only');
return 1;
}

4
lib/App/Netdisco/Util/FastResolver.pm
View File

@@ -5,7 +5,7 @@ use warnings;
use Dancer ':script';
use AnyEvent::DNS;
use App::Netdisco::Util::Permission 'check_acl_no';
use App::Netdisco::Util::Permission 'acl_matches';
use base 'Exporter';
our @EXPORT = ();
@@ -58,7 +58,7 @@ sub hostnames_resolve_async {
IP: foreach my $hash_ref (@$ips) {
my $ip = $hash_ref->{'ip'} || $hash_ref->{'alias'} || $hash_ref->{'device'};
next IP if check_acl_no($ip, $skip);
next IP if acl_matches($ip, $skip);
# check /etc/hosts file and short-circuit if found
foreach my $name (reverse sort keys %$ETCHOSTS) {

6
lib/App/Netdisco/Util/Node.pm
View File

@@ -4,7 +4,7 @@ use Dancer qw/:syntax :script/;
use Dancer::Plugin::DBIC 'schema';
use NetAddr::MAC;
use App::Netdisco::Util::Permission qw/check_acl_no check_acl_only/;
use App::Netdisco::Util::Permission qw/acl_matches acl_matches_only/;
use base 'Exporter';
our @EXPORT = ();
@@ -138,9 +138,9 @@ Returns false if the host is not permitted to nbtstat the target node.
sub is_nbtstatable {
my $ip = shift;
return if check_acl_no($ip, 'nbtstat_no');
return if acl_matches($ip, 'nbtstat_no');
return unless check_acl_only($ip, 'nbtstat_only');
return unless acl_matches_only($ip, 'nbtstat_only');
return 1;
}

268
lib/App/Netdisco/Util/Permission.pm
View File

@@ -10,7 +10,7 @@ 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/acl_matches acl_matches_only/;
our %EXPORT_TAGS = (all => \@EXPORT_OK);
=head1 NAME
@@ -26,11 +26,17 @@ subroutines.
=head1 EXPORT_OK
=head2 check_acl_no( $ip | $instance, $setting_name | $acl_entry | \@acl )
=head2 acl_matches( $ip | $object | \%hash | \@item_list, $setting_name | $acl_entry | \@acl )
Given an IP address or object instance, returns true if the configuration
setting C<$setting_name> matches, else returns false. If the content of the
setting is undefined or empty, then C<check_acl_no> also returns false.
Given an IP address, object instance, or hash, returns true if the
configuration setting C<$setting_name> matches, else returns false.
Usage of this function is strongly advised to be of the form:
QUIT/SKIP IF acl_matches
The function fails safe, so if the content of the setting or ACL is undefined
or an empty string, then C<acl_matches> also returns true.
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.
@@ -40,19 +46,37 @@ for details of what C<$acl> may contain.
=cut
sub check_acl_no {
sub acl_matches {
my ($thing, $setting_name) = @_;
return 1 unless $thing and $setting_name;
# fail-safe so undef config should return true
return true unless $thing and $setting_name;
my $config = (exists config->{"$setting_name"} ? setting($setting_name)
: $setting_name);
return check_acl($thing, $config);
}
=head2 check_acl_only( $ip | $instance, $setting_name | $acl_entry | \@acl )
=head2 check_acl_no( $ip | $object | \%hash | \@item_list, $setting_name | $acl_entry | \@acl )
Given an IP address or object instance, returns true if the configuration
setting C<$setting_name> matches, else returns false. If the content of the
setting is undefined or empty, then C<check_acl_only> also returns true.
This is an alias for L<acl_matches>.
=cut
sub check_acl_no { goto &acl_matches }
=head2 acl_matches_only( $ip | $object | \%hash | \@item_list, $setting_name | $acl_entry | \@acl )
Given an IP address, object instance, or hash, returns true if the
configuration setting C<$setting_name> matches, else returns false.
Usage of this function is strongly advised to be of the form:
QUIT/SKIP UNLESS acl_matches_only
The function fails safe, so if the content of the setting or ACL is undefined
or an empty string, then C<acl_matches_only> also returns false.
Further, if the setting or ACL resolves to a list but the list has no items,
then C<acl_matches_only> returns true (as if there is a successful match).
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.
@@ -62,25 +86,40 @@ for details of what C<$acl> may contain.
=cut
sub check_acl_only {
sub acl_matches_only {
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)
# fail-safe so undef config should return false
return false unless $thing and $setting_name;
my $config = (exists config->{"$setting_name"} ? setting($setting_name)
: $setting_name);
return 1 if not $config # undef or empty string
# logic to make an empty config be equivalent to 'any' (i.e. a match)
# empty list check means truth check passes for match or empty list
return true if not $config # undef or empty string
or ((ref [] eq ref $config) and not scalar @$config);
return check_acl($thing, $config);
}
=head2 check_acl( $ip | $instance, $acl_entry | \@acl )
=head2 check_acl_only( $ip | $object | \%hash | \@item_list, $setting_name | $acl_entry | \@acl )
Given an IP address or object instance, compares it to the items in C<< \@acl
>> 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.
This is an alias for L<acl_matches_only>.
Accepts instances of classes representing Netdisco Devices, Netdisco Device
IPs, and L<NetAddr::IP> family objects.
=cut
sub check_acl_only { goto &acl_matches_only }
=head2 check_acl( $ip | $object | \%hash | \@item_list, $acl_entry | \@acl )
Given an IP address, object instance, or hash, compares it to the items in
C<< \@acl >> 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.
Also accepts an array reference of multiple IP addresses, object instances,
and hashes, and will test against each in turn, for each ACL rule.
The slots C<alias>, C<ip>, C<switch>, and C<addr> are looked for in the
instance or hash and used to compare a bare IP address (so it works with most
Netdisco database classes, and the L<NetAddr::IP> class). Any instance or hash
slot can be used as an ACL named property.
There are several options for what C<< \@acl >> may contain. See
L<the Netdisco wiki|https://github.com/netdisco/netdisco/wiki/Configuration#access-control-lists>
@@ -89,156 +128,199 @@ for the details.
=cut
sub check_acl {
my ($thing, $config) = @_;
return 0 unless defined $thing and defined $config;
my ($things, $config) = @_;
return false unless defined $things and defined $config;
return false if ref [] eq ref $things and not scalar @$things;
$things = [$things] if ref [] ne ref $things;
my $real_ip = $thing;
if (blessed $thing) {
$real_ip = (
$thing->can('alias') ? $thing->alias : (
$thing->can('ip') ? $thing->ip : (
$thing->can('addr') ? $thing->addr : $thing )));
my $real_ip = ''; # valid to be empty
ITEM: foreach my $item (@$things) {
foreach my $slot (qw/alias ip switch addr/) {
if (blessed $item) {
$real_ip = $item->$slot if $item->can($slot)
and eval { $item->$slot };
}
elsif (ref {} eq ref $item) {
$real_ip = $item->{$slot} if exists $item->{$slot}
and $item->{$slot};
}
last ITEM if $real_ip;
}
}
ITEM: foreach my $item (@$things) {
last ITEM if $real_ip;
$real_ip = $item if (ref $item eq q{}) and $item;
}
return 0 if blessed $real_ip; # class we do not understand
$real_ip ||= ''; # valid to be empty
$config = [$config] if ref q{} eq ref $config;
$config = [$config] if ref $config eq q{};
if (ref [] ne ref $config) {
error "error: acl is not a single item or list (cannot compare to '$real_ip')";
return 0;
return false;
}
my $all = (scalar grep {$_ eq 'op:and'} @$config);
# common case of using plain IP in ACL, so string compare for speed
my $find = (scalar grep {not reftype $_ and $_ eq $real_ip} @$config);
return 1 if $real_ip and $find and not $all;
return true if $real_ip and $find and not $all;
my $addr = NetAddr::IP::Lite->new($real_ip);
my $name = undef; # only look up once, and only if qr// is used
my $ropt = { retry => 1, retrans => 1, udp_timeout => 1, tcp_timeout => 2 };
my $qref = ref qr//;
INLIST: foreach (@$config) {
my $item = $_; # must copy so that we can modify safely
next INLIST if !defined $item or $item eq 'op:and';
RULE: foreach (@$config) {
my $rule = $_; # must copy so that we can modify safely
next RULE if !defined $rule or $rule eq 'op:and';
if ($qref eq ref $item) {
if ($qref eq ref $rule) {
# if no IP addr, cannot match its dns
next INLIST unless $addr;
next RULE unless $addr;
$name = ($name || hostname_from_ip($addr->addr, $ropt) || '!!none!!');
if ($name =~ $item) {
return 1 if not $all;
if ($name =~ $rule) {
return true if not $all;
}
else {
return 0 if $all;
return false if $all;
}
next INLIST;
next RULE;
}
my $neg = ($item =~ s/^!//);
my $neg = ($rule =~ s/^!//);
if ($item =~ m/^group:(.+)$/) {
if ($rule =~ m/^group:(.+)$/) {
my $group = $1;
setting('host_groups')->{$group} ||= [];
if ($neg xor check_acl($thing, setting('host_groups')->{$group})) {
return 1 if not $all;
if ($neg xor check_acl($things, setting('host_groups')->{$group})) {
return true if not $all;
}
else {
return 0 if $all;
return false if $all;
}
next INLIST;
next RULE;
}
if ($item =~ m/^([^:]+):([^:]*)$/) {
# prop:val
if ($rule =~ m/^([^:]+):([^:]*)$/) {
my $prop = $1;
my $match = $2 || '';
my $found = false;
# if not an object, we can't do much with properties
next INLIST unless blessed $thing;
# property exists, undef is allowed to match empty string
ITEM: foreach my $item (@$things) {
if (blessed $item) {
if ($neg xor ($item->can($prop) and
((!defined eval { $item->$prop } and $match eq q{})
or
(defined eval { $item->$prop } and ref $item->$prop eq q{} and $item->$prop =~ m/^$match$/)) )) {
return true if not $all;
$found = true;
last ITEM;
}
}
elsif (ref {} eq ref $item) {
if ($neg xor (exists $item->{$prop} and
((!defined $item->{$prop} and $match eq q{})
or
(defined $item->{$prop} and ref $item->{$prop} eq q{} and $item->{$prop} =~ m/^$match$/)) )) {
return true if not $all;
$found = true;
last ITEM;
}
}
}
# prop:val
if ($neg xor ($thing->can($prop) and
defined eval { $thing->$prop } and
ref $thing->$prop eq q{}
and $thing->$prop =~ m/^$match$/) ) {
return 1 if not $all;
# missing property matches empty string
# (which is done in a second pass to allow all @$things to be
# inspected for existing properties)
ITEM: foreach my $item (@$things) {
last ITEM if $found;
if (blessed $item) {
if ($neg xor ($match eq q{} and ! $item->can($prop))) {
return true if not $all;
$found = true;
last ITEM;
}
}
elsif (ref {} eq ref $item) {
# empty or missing property
if ($neg xor ($match eq q{} and ! exists $item->{$prop})) {
return true if not $all;
$found = true;
last ITEM;
}
}
}
# empty or missing property
elsif ($neg xor ($match eq q{} and
(!defined eval { $thing->$prop } or $thing->$prop eq q{})) ) {
return 1 if not $all;
}
else {
return 0 if $all;
}
next INLIST;
return false if $all;
next RULE;
}
if ($item =~ m/[:.]([a-f0-9]+)-([a-f0-9]+)$/i) {
if ($rule =~ m/[:.]([a-f0-9]+)-([a-f0-9]+)$/i) {
my $first = $1;
my $last = $2;
# if no IP addr, cannot match IP range
next INLIST unless $addr;
next RULE unless $addr;
if ($item =~ m/:/) {
next INLIST if $addr->bits != 128 and not $all;
if ($rule =~ m/:/) {
next RULE if $addr->bits != 128 and not $all;
$first = hex $first;
$last = hex $last;
(my $header = $item) =~ s/:[^:]+$/:/;
(my $header = $rule) =~ 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 true if not $all;
next RULE;
}
}
return 0 if (not $neg and $all);
return 1 if ($neg and not $all);
return false if (not $neg and $all);
return true if ($neg and not $all);
}
else {
next INLIST if $addr->bits != 32 and not $all;
next RULE if $addr->bits != 32 and not $all;
(my $header = $item) =~ s/\.[^.]+$/./;
(my $header = $rule) =~ 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 true if not $all;
next RULE;
}
}
return 0 if (not $neg and $all);
return 1 if ($neg and not $all);
return false if (not $neg and $all);
return true if ($neg and not $all);
}
next INLIST;
next RULE;
}
# could be something in error, and IP/host is only option left
next INLIST if ref $item;
next RULE if ref $rule;
# if no IP addr, cannot match IP prefix
next INLIST unless $addr;
next RULE unless $addr;
my $ip = NetAddr::IP::Lite->new($item)
or next INLIST;
next INLIST if $ip->bits != $addr->bits and not $all;
my $ip = NetAddr::IP::Lite->new($rule)
or next RULE;
next RULE if $ip->bits != $addr->bits and not $all;
if ($neg xor ($ip->contains($addr))) {
return 1 if not $all;
return true if not $all;
}
else {
return 0 if $all;
return false if $all;
}
next INLIST;
next RULE;
}
return ($all ? 1 : 0);
return ($all ? true : false);
}
1;
true;

6
lib/App/Netdisco/Util/Port.pm
View File

@@ -4,7 +4,7 @@ use Dancer qw/:syntax :script/;
use Dancer::Plugin::DBIC 'schema';
use App::Netdisco::Util::Device 'get_device';
use App::Netdisco::Util::Permission qw/check_acl_no check_acl_only/;
use App::Netdisco::Util::Permission qw/acl_matches acl_matches_only/;
use base 'Exporter';
our @EXPORT = ();
@@ -107,9 +107,9 @@ sub port_reconfig_check {
# check for limits on devices
return "forbidden: device [$ip] is in denied ACL"
if check_acl_no($ip, 'portctl_no');
if acl_matches($ip, 'portctl_no');
return "forbidden: device [$ip] is not in permitted ACL"
unless check_acl_only($ip, 'portctl_only');
unless acl_matches_only($ip, 'portctl_only');
# only permitted to change interface name
return "forbidden: not permitted to change port configuration"