[PATCH pve-firewall v2 6/9] firewall: tests: add tests for object reference update logic

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

The reference updating logic has quite a few edge cases, especially
regarding the fact that cluster objects may be shadowed by guest
objects.

Add a few tests to consolidate the intended functionality. Note that
these tests do not cover the actual iteration over the different
configs in the cluster, rather they are focused on the core reference
rewriting logic.

Signed-off-by: Arthur Bied-Charreton <a.bied-charreton@proxmox.com>
---
 test/Makefile                |   1 +
 test/referenceupdatetests.pl | 178 +++++++++++++++++++++++++++++++++++
 2 files changed, 179 insertions(+)
 create mode 100755 test/referenceupdatetests.pl

diff --git a/test/Makefile b/test/Makefile
index fea9c21..15d2ae3 100644
--- a/test/Makefile
+++ b/test/Makefile
@@ -4,6 +4,7 @@ all:
 .PHONY: check
 check:
 	./fwtester.pl
+	./referenceupdatetests.pl
 
 .PHONY: install
 install: check
diff --git a/test/referenceupdatetests.pl b/test/referenceupdatetests.pl
new file mode 100755
index 0000000..e80cb50
--- /dev/null
+++ b/test/referenceupdatetests.pl
@@ -0,0 +1,178 @@
+#!/usr/bin/perl
+
+# tests for the alias/ipset reference updating logic
+
+use lib '../src';
+
+use v5.36;
+
+use Test::More;
+
+use PVE::Firewall::Helpers;
+
+my $ipset_spec = PVE::Firewall::Helpers::get_object_spec('ipset');
+my $alias_spec = PVE::Firewall::Helpers::get_object_spec('aliases');
+
+sub rewrite($conf, $spec, $old, $new, $env, $is_guest) {
+    return PVE::Firewall::Helpers::rewrite_refs_in_conf($conf, $spec, $old, $new, $env, $is_guest);
+}
+
+subtest 'ipset: cluster rename rewrites dc/ and bare refs' => sub {
+    my $conf = {
+        rules => [
+            { source => '+dc/foo' },
+            { dest => '+foo' },
+            { source => '+bar' },
+            { source => '+dc/bar' },
+        ],
+        groups => {
+            grp => [{ source => '+dc/foo' }, { dest => '+foo' }],
+        },
+        ipset => {
+            set => [{ cidr => '10.0.0.0/8' }],
+        },
+    };
+
+    my $modified = rewrite($conf, $ipset_spec, 'foo', 'baz', 'cluster', 0);
+
+    ok($modified, 'reports modified');
+    is($conf->{rules}->[0]->{source}, '+dc/baz', 'dc/ ref rewritten');
+    is($conf->{rules}->[1]->{dest}, '+baz', 'bare ref rewritten');
+    is($conf->{rules}->[2]->{source}, '+bar', 'unrelated bare ref kept');
+    is($conf->{rules}->[3]->{source}, '+dc/bar', 'unrelated dc/ ref kept');
+    is($conf->{groups}->{grp}->[0]->{source}, '+dc/baz', 'group dc/ ref rewritten');
+    is($conf->{groups}->{grp}->[1]->{dest}, '+baz', 'group bare ref rewritten');
+    is($conf->{ipset}->{set}->[0]->{cidr}, '10.0.0.0/8', 'ipset member not touched');
+};
+
+subtest 'ipset: cluster delete drops matching rules' => sub {
+    my $conf = {
+        rules => [
+            { source => '+dc/foo' }, { source => '+foo' }, { source => '+other' },
+        ],
+        groups => { grp => [{ dest => '+dc/foo' }, { dest => '+keep' }] },
+    };
+
+    my $modified = rewrite($conf, $ipset_spec, 'foo', undef, 'cluster', 0);
+
+    ok($modified, 'reports modified');
+    is(scalar($conf->{rules}->@*), 1, 'matching rules dropped');
+    is($conf->{rules}->[0]->{source}, '+other', 'unrelated rule kept');
+    is(scalar($conf->{groups}->{grp}->@*), 1, 'matching group rule dropped');
+    is($conf->{groups}->{grp}->[0]->{dest}, '+keep', 'unrelated group rule kept');
+};
+
+subtest 'ipset: guest shadows cluster object' => sub {
+    my $conf = {
+        rules => [
+            { source => '+foo' }, { dest => '+dc/foo' },
+        ],
+        ipset => { foo => [] },
+    };
+
+    my $modified = rewrite($conf, $ipset_spec, 'foo', 'baz', 'cluster', 1);
+
+    ok($modified, 'reports modified');
+    is($conf->{rules}->[0]->{source}, '+foo', 'shadowed bare ref not touched');
+    is($conf->{rules}->[1]->{dest}, '+dc/baz', 'explicit cluster ref rewritten');
+};
+
+subtest 'ipset: guest without own object' => sub {
+    my $conf = {
+        rules => [{ source => '+foo' }, { dest => '+dc/foo' }],
+        ipset => {},
+    };
+
+    rewrite($conf, $ipset_spec, 'foo', 'baz', 'cluster', 1);
+
+    is($conf->{rules}->[0]->{source}, '+baz', 'implicit cluster ref rewritten');
+    is($conf->{rules}->[1]->{dest}, '+dc/baz', 'explicit cluster ref rewritten');
+};
+
+subtest 'ipset: guest-level rename' => sub {
+    my $conf = {
+        rules => [
+            { source => '+foo' }, { dest => '+guest/foo' }, { source => '+dc/foo' },
+        ],
+    };
+
+    rewrite($conf, $ipset_spec, 'foo', 'baz', 'vm', 0);
+
+    is($conf->{rules}->[0]->{source}, '+baz', 'implicit guest ref rewritten');
+    is($conf->{rules}->[1]->{dest}, '+guest/baz', 'guest/ ref rewritten');
+    is($conf->{rules}->[2]->{source}, '+dc/foo', 'dc/ ref not touched in guest env');
+};
+
+subtest 'ipset: not confused with alias' => sub {
+    my $conf = { rules => [{ source => 'foo' }, { dest => '+foo' }] };
+
+    my $modified = rewrite($conf, $ipset_spec, 'foo', 'baz', 'cluster', 0);
+
+    ok($modified, 'reports modified');
+    is($conf->{rules}->[0]->{source}, 'foo', 'bare alias ref not touched');
+    is($conf->{rules}->[1]->{dest}, '+baz', 'ipset ref rewritten');
+};
+
+subtest 'alias: cluster rename rewrites rules and ipset members' => sub {
+    my $conf = {
+        rules => [{ source => 'al' }, { dest => 'dc/al' }, { source => 'other' }],
+        groups => { grp => [{ source => 'dc/al' }] },
+        ipset => {
+            set => [{ cidr => 'al' }, { cidr => 'dc/al' }, { cidr => '10.0.0.1' }],
+        },
+    };
+
+    my $modified = rewrite($conf, $alias_spec, 'al', 'new', 'cluster', 0);
+
+    ok($modified, 'reports modified');
+    is($conf->{rules}->[0]->{source}, 'new', 'bare alias in rule rewritten');
+    is($conf->{rules}->[1]->{dest}, 'dc/new', 'dc/ alias in rule rewritten');
+    is($conf->{rules}->[2]->{source}, 'other', 'unrelated rule kept');
+    is($conf->{groups}->{grp}->[0]->{source}, 'dc/new', 'alias in group rewritten');
+    is($conf->{ipset}->{set}->[0]->{cidr}, 'new', 'bare alias in ipset member rewritten');
+    is($conf->{ipset}->{set}->[1]->{cidr}, 'dc/new', 'dc/ alias in ipset member rewritten');
+    is($conf->{ipset}->{set}->[2]->{cidr}, '10.0.0.1', 'literal cidr member kept');
+};
+
+subtest 'alias: cluster delete drops rules and ipset members' => sub {
+    my $conf = {
+        rules => [{ source => 'al' }, { source => 'keep' }],
+        ipset => { set => [{ cidr => 'dc/al' }, { cidr => '10.0.0.1' }] },
+    };
+
+    rewrite($conf, $alias_spec, 'al', undef, 'cluster', 0);
+
+    is(scalar($conf->{rules}->@*), 1, 'matching rule dropped');
+    is($conf->{rules}->[0]->{source}, 'keep', 'unrelated rule kept');
+    is(scalar($conf->{ipset}->{set}->@*), 1, 'matching member dropped');
+    is($conf->{ipset}->{set}->[0]->{cidr}, '10.0.0.1', 'literal member kept');
+};
+
+subtest 'alias: not confused with ipset' => sub {
+    my $conf = { rules => [{ source => '+al' }, { dest => 'al' }] };
+
+    rewrite($conf, $alias_spec, 'al', 'new', 'cluster', 0);
+
+    is($conf->{rules}->[0]->{source}, '+al', 'ipset ref (+) not touched');
+    is($conf->{rules}->[1]->{dest}, 'new', 'alias ref rewritten');
+};
+
+subtest 'case-insensitive match, written back lowercase' => sub {
+    my $conf = { rules => [{ source => '+DC/FOO' }, { dest => '+Foo' }] };
+
+    rewrite($conf, $ipset_spec, 'foo', 'baz', 'cluster', 0);
+
+    is($conf->{rules}->[0]->{source}, '+dc/baz', 'dc/ ref matched and lowercased');
+    is($conf->{rules}->[1]->{dest}, '+baz', 'bare ref matched and lowercased');
+};
+
+subtest 'no match reports not modified' => sub {
+    my $conf = { rules => [{ source => '+other' }, { dest => 'somealias' }] };
+
+    my $modified = rewrite($conf, $ipset_spec, 'foo', 'baz', 'cluster', 0);
+
+    ok(!$modified, 'nothing matched -> not modified');
+    is($conf->{rules}->[0]->{source}, '+other', 'unrelated refs not touched');
+};
+
+done_testing();
-- 
2.47.3