[PATCH pve-firewall v4 12/27] firewall: references: handle security groups

[Arthur Bied-Charreton <a.bied-charreton@proxmox.com>]

Security groups may be referenced by the action of a rule, rather than
the source, dest and cidr fields that ipsets and aliases are referenced
in.

Move field lists into the object spec and let a spec limit its
references to a single rule type so a group named 'drop' is not matched
by the action of a normal DROP rule.

Groups may only be defined in the cluster config so they cannot be
shadowed and references to them are always unscoped.

Signed-off-by: Arthur Bied-Charreton <a.bied-charreton@proxmox.com>
---
 src/PVE/Firewall/References.pm | 52 +++++++++++++++++++++-------------
 src/test/test_update_refs.pl   | 38 +++++++++++++++++++++++++
 2 files changed, 70 insertions(+), 20 deletions(-)

diff --git a/src/PVE/Firewall/References.pm b/src/PVE/Firewall/References.pm
index f32c7db..67ba4d0 100644
--- a/src/PVE/Firewall/References.pm
+++ b/src/PVE/Firewall/References.pm
@@ -143,27 +143,37 @@ sub rewrite_refs_in_env {
     return $changes;
 }
 
-# field name + value prefix for firewall object references
+# how a reference to a firewall object looks and where it is found:
+#
+#   prefix: the prefix a reference carries
+#   self:   the section a config defines the object in, used to resolve shadowing
+#   fields: the fields that can hold a reference
+#   type:   the rule type references are limited to
 my $object_ref_specs = {
-    ipset => { prefix => '+', self => 'ipset' },
-    aliases => { prefix => '', self => 'aliases' },
+    ipset => { prefix => '+', self => 'ipset', fields => ['source', 'dest', 'cidr'] },
+    aliases => { prefix => '', self => 'aliases', fields => ['source', 'dest', 'cidr'] },
+    # a security group may only be referenced by the action of the rule invoking it. matching
+    # any other rule could rewrite a DROP action when renaming a group named 'drop', for example.
+    groups => { prefix => '', self => 'groups', fields => ['action'], type => 'group' },
 };
 
-# fields to check for object references
-my $ref_fields = ['source', 'dest', 'cidr'];
+=head3 matched_ref($item, $ctx)
 
-=head3 matched_ref($item, $repl)
-
-Return the reference C<$item> holds that C<$repl> has an entry for, or C<undef> if there is none.
+Return the reference C<$item> holds that the replacement map of C<$ctx> has an entry for, or
+C<undef> if there is none.
 
 =cut
 
 sub matched_ref {
-    my ($item, $repl) = @_;
+    my ($item, $ctx) = @_;
+
+    my $spec = $ctx->{spec};
 
-    for my $field ($ref_fields->@*) {
+    return undef if $spec->{type} && ($item->{type} // '') ne $spec->{type};
+
+    for my $field ($spec->{fields}->@*) {
         my $ref = lc($item->{$field} // '');
-        return $ref if exists($repl->{$ref});
+        return $ref if exists($ctx->{repl}->{$ref});
     }
 
     return undef;
@@ -195,7 +205,7 @@ sub rewrite_items {
     for my $pos (0 .. $items->$#*) {
         my $item = $items->[$pos];
 
-        my $ref = matched_ref($item, $repl);
+        my $ref = matched_ref($item, $ctx);
         if (!defined($ref)) {
             # no match, keep item
             push @result, $item;
@@ -215,7 +225,7 @@ sub rewrite_items {
         next if $remove;
 
         if ($action eq 'rename') {
-            for my $field ($ref_fields->@*) {
+            for my $field ($ctx->{spec}->{fields}->@*) {
                 my $value = lc($item->{$field} // '');
                 $item->{$field} = $repl->{$value} if exists($repl->{$value});
             }
@@ -229,7 +239,7 @@ sub rewrite_items {
     return \@result;
 }
 
-=head3 build_ref_map($op, $conf, $env, $is_guest)
+=head3 build_ref_map($op, $spec, $conf, $env, $is_guest)
 
 Map every allowed reference to the objects in C<$op> that resolves in C<$conf> to what it should
 become, i.e. either the renamed reference or C<undef> if C<$op> has no new name.
@@ -252,9 +262,7 @@ a guest-local or a cluster object
 =cut
 
 sub build_ref_map {
-    my ($op, $conf, $env, $is_guest) = @_;
-
-    my $spec = $object_ref_specs->{ $op->{kind} } // die "unknown object kind '$op->{kind}'\n";
+    my ($op, $spec, $conf, $env, $is_guest) = @_;
 
     my $prefix = $spec->{prefix};
     my $self = $spec->{self};
@@ -305,8 +313,11 @@ Only exposed for testing, see C<update_refs>'s POD for details.
 sub rewrite_refs_in_conf {
     my ($conf, $op, $env, $is_guest) = @_;
 
+    my $spec = $object_ref_specs->{ $op->{kind} } // die "unknown object kind '$op->{kind}'\n";
+
     my $ctx = {
-        repl => build_ref_map($op, $conf, $env, $is_guest),
+        spec => $spec,
+        repl => build_ref_map($op, $spec, $conf, $env, $is_guest),
         action => $op->{action},
         changes => [],
     };
@@ -341,7 +352,7 @@ and renames are written back lowercased.
 C<$opts> holds:
 
     conf     # the firewall config the object is defined in
-    kind     # 'ipset' or 'aliases'
+    kind     # 'ipset', 'aliases' or 'groups'
     old      # the name the references carry, or an arrayref of names to disable or drop
     new      # the name to rewrite them to, only used when renaming
     env      # 'cluster', 'sdn', or 'vm'/'ct' for a guest-defined object
@@ -352,7 +363,8 @@ C<$opts> holds:
 
 The caller is responsible for locking and saving C<conf> itself.
 
-IPSet members have no disabled state, so C<disable> removes them as well.
+A security group may only be referenced by the action of a rule so those references are confined to
+rules. IPSet members have no disabled state, so C<disable> removes them as well.
 
 If C<conf> is the cluster config, i.e. if C<env> is C<cluster> or C<sdn>, guest, host and vnet
 configs are sequentially locked, updated and saved. C<save> is called once the references in
diff --git a/src/test/test_update_refs.pl b/src/test/test_update_refs.pl
index f148eed..359c4c4 100755
--- a/src/test/test_update_refs.pl
+++ b/src/test/test_update_refs.pl
@@ -325,6 +325,44 @@ subtest 'rename changes record the new reference' => sub {
     );
 };
 
+subtest 'groups: rename rewrites the action of group rules' => sub {
+    my $conf = {
+        rules => [
+            { type => 'group', action => 'web' },
+            { type => 'in', action => 'ACCEPT', source => 'web' },
+        ],
+        groups => {
+            web => [{ type => 'in', action => 'ACCEPT' }],
+        },
+        ipset => {
+            set => [{ cidr => 'web' }],
+        },
+    };
+
+    my $changes = rewrite($conf, 'groups', 'web', 'www', 'cluster', 0);
+
+    is($conf->{rules}->[0]->{action}, 'www', 'group rule points at the new name');
+    is($conf->{rules}->[1]->{action}, 'ACCEPT', 'a plain rule keeps its action');
+    is($conf->{rules}->[1]->{source}, 'web', 'a source matching the group name is left alone');
+    is($conf->{ipset}->{set}->[0]->{cidr}, 'web', 'an IPSet member is left alone');
+    is(scalar($changes->@*), 1, 'only the group rule is reported');
+};
+
+subtest 'groups: a group named after an action does not match plain rules' => sub {
+    my $conf = {
+        rules => [
+            { type => 'out', action => 'DROP' }, { type => 'group', action => 'drop' },
+        ],
+    };
+
+    my $changes = rewrite($conf, 'groups', 'drop', undef, 'cluster', 0);
+
+    is($conf->{rules}->[0]->{action}, 'DROP', 'the DROP rule is untouched');
+    ok(!$conf->{rules}->[0]->{enable}, 'the DROP rule is not disabled');
+    is($conf->{rules}->[1]->{enable}, 0, 'the group rule is disabled');
+    is(scalar($changes->@*), 1, 'only the group rule is reported');
+};
+
 subtest 'update_refs: rejects invalid argument combinations' => sub {
     my $run = sub {
         my (%args) = @_;
-- 
2.47.3