[PATCH pve-firewall 3/5] aliases: Add option to update references on rename/delete

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

Renaming or deleting an alias that is referenced by rules or security
groups would leave dangling references, creating broken configurations.

Add option to the POST and DELETE endpoints for /firewall/aliases to
update or delete those references from cluster, hosts, and guests
firewall configs.

If these endpoints are hit from the cluster environment (/cluster/),
all firewall config files in the cluster (cluster + all nodes + all
guests) have to be checked and possibly updated.

Signed-off-by: Arthur Bied-Charreton <a.bied-charreton@proxmox.com>
---
 src/PVE/API2/Firewall/Aliases.pm | 115 +++++++++++++++++++++++++++++++
 1 file changed, 115 insertions(+)

diff --git a/src/PVE/API2/Firewall/Aliases.pm b/src/PVE/API2/Firewall/Aliases.pm
index eaafe68..2a06822 100644
--- a/src/PVE/API2/Firewall/Aliases.pm
+++ b/src/PVE/API2/Firewall/Aliases.pm
@@ -5,6 +5,7 @@ use warnings;
 use PVE::Exception qw(raise raise_param_exc);
 use PVE::JSONSchema qw(get_standard_option);
 
+use PVE::API2::Firewall::Helpers qw(filter_map foreach_conf_in_env);
 use PVE::Firewall;
 
 use base qw(PVE::RESTHandler);
@@ -217,6 +218,12 @@ sub register_update_alias {
     $properties->{cidr} = $api_properties->{cidr};
     $properties->{comment} = $api_properties->{comment};
     $properties->{digest} = get_standard_option('pve-config-digest');
+    $properties->{'update-references'} = {
+        type => 'boolean',
+        optional => 1,
+        description => 'Update dangling references when renaming the alias.',
+        default => 0,
+    };
 
     $class->register_method({
         name => 'update_alias',
@@ -261,6 +268,9 @@ sub register_update_alias {
                     if ($rename && ($name ne $rename)) {
                         raise_param_exc({ name => "alias '$param->{rename}' already exists" })
                             if defined($aliases->{$rename});
+                        rename_alias_refs(
+                            $fw_conf, $name, $param->{rename}, $class->rule_env(),
+                        ) if $param->{'update-references'};
                         $aliases->{$name}->{name} = $param->{rename};
                         $aliases->{$rename} = $aliases->{$name};
                         delete $aliases->{$name};
@@ -282,6 +292,12 @@ sub register_delete_alias {
 
     $properties->{name} = $api_properties->{name};
     $properties->{digest} = get_standard_option('pve-config-digest');
+    $properties->{'delete-references'} = {
+        type => 'boolean',
+        optional => 1,
+        description => 'Delete dangling references after deleting the alias.',
+        default => 0,
+    };
 
     $class->register_method({
         name => 'remove_alias',
@@ -310,6 +326,10 @@ sub register_delete_alias {
                     PVE::Tools::assert_if_modified($digest, $param->{digest});
 
                     my $name = lc($param->{name});
+
+                    delete_alias_refs($fw_conf, $param->{name}, $class->rule_env())
+                        if $param->{'delete-references'};
+
                     delete $aliases->{$name};
 
                     $class->save_aliases($param, $fw_conf, $aliases);
@@ -321,6 +341,101 @@ sub register_delete_alias {
     });
 }
 
+# Apply $rewrite to each rule or IPSet entry in $conf referencing $alias, modifying $conf in place.
+#
+# $rewrite->($obj) is expected to return the new rule/entry, or undef to remove it.
+#
+# Returns a boolean indicating whether $conf was modified.
+#
+# If $is_guest is set to 1, references will be solved assuming $conf is a guest FW config.
+# This is important because 2 different aliases with the same name may be defined at the
+# cluster level and at the guest level, in which case the guest's alias shadows the cluster's.
+sub rewrite_alias_refs_in_conf {
+    my ($conf, $alias, $rule_env, $is_guest, $rewrite) = @_;
+    my $lc_alias = lc($alias);
+    my $modified = 0;
+
+    my @patterns;
+    if ($rule_env eq 'cluster') {
+        @patterns = ("dc/$lc_alias");
+        push @patterns, $lc_alias if !($is_guest && $conf->{aliases}->{$lc_alias});
+    } else {
+        @patterns = ($lc_alias, "guest/$lc_alias");
+    }
+
+    my $rule_matches = sub {
+        my ($rule) = @_;
+        grep { lc($rule->{source} // '') eq $_ || lc($rule->{dest} // '') eq $_ } @patterns;
+    };
+    my $entry_matches = sub {
+        grep { lc($_[0]->{cidr} // '') eq $_ } @patterns;
+    };
+
+    ($conf->{rules}, my $changed) = filter_map($conf->{rules}, $rewrite, $rule_matches);
+    $modified ||= $changed;
+
+    my $ipsets = $conf->{ipset} // {};
+    for my $name (keys %$ipsets) {
+        ($ipsets->{$name}, $changed) = filter_map($ipsets->{$name}, $rewrite, $entry_matches);
+        $modified ||= $changed;
+    }
+
+    if ($rule_env eq 'cluster') {
+        my $groups = $conf->{groups} // {};
+        for my $group (keys %$groups) {
+            ($groups->{$group}, $changed) = filter_map($groups->{$group}, $rewrite, $rule_matches);
+            $modified ||= $changed;
+        }
+    }
+
+    return $modified;
+}
+
+# Apply $rewrite to each rule or IPSet entry in the current environment ($rule_env) referencing
+# $alias, modifying $conf in place. The caller is responsible for locking and saving $conf.
+#
+# If $rule_env is 'cluster', this function will also map over all guest and node firewall configs
+# in the cluster, locking and saving them in the process, since those may reference aliases defined
+# in the cluster config.
+sub rewrite_alias_refs_in_env {
+    my ($conf, $alias, $rule_env, $rewrite) = @_;
+    return foreach_conf_in_env(
+        $conf,
+        $rule_env,
+        sub {
+            my ($fw_conf, $effective_env, $is_guest) = @_;
+            return rewrite_alias_refs_in_conf(
+                $fw_conf, $alias, $effective_env, $is_guest, $rewrite,
+            );
+        },
+    );
+}
+
+sub delete_alias_refs {
+    my ($conf, $alias, $rule_env) = @_;
+    return rewrite_alias_refs_in_env($conf, $alias, $rule_env, sub { undef });
+}
+
+sub rename_alias_refs {
+    my ($conf, $alias, $new_name, $rule_env) = @_;
+    my $lc_alias = lc($alias);
+    return rewrite_alias_refs_in_env(
+        $conf,
+        $lc_alias,
+        $rule_env,
+        sub {
+            my ($obj) = @_;
+            for my $field (qw(source dest cidr)) {
+                my $val = lc($obj->{$field} // '');
+                if ($val eq "dc/$lc_alias") { $obj->{$field} = "dc/$new_name" }
+                elsif ($val eq $lc_alias) { $obj->{$field} = $new_name }
+                elsif ($val eq "guest/$lc_alias") { $obj->{$field} = "guest/$new_name" }
+            }
+            return $obj;
+        },
+    );
+}
+
 sub register_handlers {
     my ($class) = @_;
 
-- 
2.47.3