[PATCH pve-firewall v4 02/27] firewall: references: add helpers to update object references

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

Renaming or deleting a firewall object (ipset or alias) that is still
referenced by rules, security groups or ipset members leaves dangling
references. The firewall fails to parse the affected rules and drops
them, so an edit can effectively disable a whole set of rules.

Introduce the update_refs() helper, which finds such references and
applies one of three actions to them: 'rename' points them at the new
name, 'disable' turns off the referencing rules, and 'drop' removes
them. An ipset member has no disabled state, so 'disable' removes
members as well. Matching is case-insensitive and rewritten references
are normalized to lowercase.

When operating on an object defined in the cluster config, update_refs()
also covers every downstream config (guest, host and vnet) across the
cluster. Downstream configs are locked and saved individually as they
are visited, so on a cluster object rename the config must be saved
with the new object present before updating the downstream configs;
otherwise a concurrent firewall compilation would choke on a reference
to an object that does not exist yet and drop the rule. For this
purpose, update_refs() takes a $save callback, which allows it to
decide when such a config save is required instead of relying on the
caller for correctness.

Object references are not guaranteed to be scoped (dc/, guest/, sdn/)
if the rules have been added by manually editing the configs (or before
scoped references were introduced). This is not an issue for cluster,
host and vnet configs, who cannot define their own objects and
therefore can only reference cluster objects. Guest configs may however
define their own objects. Unscoped references in guest rules are
therefore resolved by first checking for a definition in the relevant
guest config, and only then in the cluster config, to prevent
overwriting the wrong reference.

SDN IPSets can additionally be shadowed by IPSets defined in the cluster
config. This is handled by also checking for same-named IPSets in the
cluster config for SDN IPSets.

The ipset and alias endpoints in the following commits build on this.

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

diff --git a/src/PVE/Firewall/References.pm b/src/PVE/Firewall/References.pm
index a4ea967..8998380 100644
--- a/src/PVE/Firewall/References.pm
+++ b/src/PVE/Firewall/References.pm
@@ -3,9 +3,14 @@ package PVE::Firewall::References;
 use strict;
 use warnings;
 
+use PVE::Cluster;
+use PVE::Firewall;
+use PVE::Network::SDN::Vnets;
+
 use base 'Exporter';
 our @EXPORT_OK = qw(
     collect_refs
+    update_refs
 );
 
 sub collect_refs {
@@ -45,4 +50,331 @@ sub collect_refs {
     return $res;
 }
 
+=head3 rewrite_refs_in_env($conf, $rule_env, $op)
+
+Apply the rewrite described by C<$op> to C<$conf> and, if C<$rule_env> is 'cluster' or 'sdn', to
+all guest, host and vnet firewall configs across the cluster. Downstream configs are locked and the
+ones that changed are saved.
+
+The caller is responsible for locking and saving C<$conf> itself.
+
+Return a trace describing all changes made to the config files, each scoped by config.
+
+=cut
+
+sub rewrite_refs_in_env {
+    my ($conf, $rule_env, $op) = @_;
+
+    my $changes = [];
+
+    my $visit = sub {
+        my ($fw_conf, $env, $is_guest, $scope) = @_;
+
+        my $conf_changes = rewrite_refs_in_conf($fw_conf, $op, $env, $is_guest);
+        push $changes->@*, map { { $_->%*, scope => $scope } } $conf_changes->@*;
+
+        return scalar($conf_changes->@*);
+    };
+
+    my $self_scope = 'cluster';
+    if ($rule_env ne 'cluster' && $rule_env ne 'sdn') {
+        $self_scope = defined($conf->{vmid}) ? "$rule_env/$conf->{vmid}" : $rule_env;
+    }
+    $visit->($conf, $rule_env, 0, $self_scope);
+
+    return $changes if $rule_env ne 'cluster' && $rule_env ne 'sdn';
+
+    # on renames, the configs below are rewritten to reference the object under its new name. during
+    # this process, the object has to be resolvable under both names, otherwise concurrent firewall
+    # compilations will choke on unresolvable objects.
+    $op->{save}->($conf) if $op->{save};
+
+    my $vmlist = PVE::Cluster::get_vmlist();
+    my $vmids = ($vmlist // {})->{ids} // {};
+    for my $vmid (keys $vmids->%*) {
+        PVE::Firewall::lock_vmfw_conf(
+            $vmid,
+            10,
+            sub {
+                my $guest_env = $vmlist->{ids}->{$vmid}->{type} eq 'lxc' ? 'ct' : 'vm';
+                my $guest_conf = PVE::Firewall::load_vmfw_conf($conf, $guest_env, $vmid);
+                if ($visit->($guest_conf, $rule_env, 1, "$guest_env/$vmid")) {
+                    PVE::Firewall::save_vmfw_conf($vmid, $guest_conf);
+                }
+            },
+        );
+    }
+
+    for my $node (PVE::Cluster::get_nodelist()->@*) {
+        my $host_conf_path = "/etc/pve/nodes/$node/host.fw";
+        PVE::Firewall::lock_hostfw_conf(
+            $node,
+            10,
+            sub {
+                my $host_conf = PVE::Firewall::load_hostfw_conf($conf, $host_conf_path);
+                if ($visit->($host_conf, $rule_env, 0, "host/$node")) {
+                    PVE::Firewall::save_hostfw_conf($host_conf, $host_conf_path);
+                }
+            },
+        );
+    }
+
+    my $vnets = (PVE::Network::SDN::Vnets::config(1) // {})->{ids} // {};
+    for my $vnet (keys $vnets->%*) {
+        PVE::Firewall::lock_vnetfw_conf(
+            $vnet,
+            10,
+            sub {
+                my $vnet_conf = PVE::Firewall::load_vnetfw_conf($conf, 'vnet', $vnet);
+                if ($visit->($vnet_conf, $rule_env, 0, "vnet/$vnet")) {
+                    PVE::Firewall::save_vnetfw_conf($vnet, $vnet_conf);
+                }
+            },
+        );
+    }
+
+    return $changes;
+}
+
+# field name + value prefix for firewall object references
+my $object_ref_specs = {
+    ipset => { prefix => '+', self => 'ipset' },
+    aliases => { prefix => '', self => 'aliases' },
+};
+
+# fields to check for object references
+my $ref_fields = ['source', 'dest', 'cidr'];
+
+=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.
+
+=cut
+
+sub matched_ref {
+    my ($item, $repl) = @_;
+
+    for my $field ($ref_fields->@*) {
+        my $ref = lc($item->{$field} // '');
+        return $ref if exists($repl->{$ref});
+    }
+
+    return undef;
+}
+
+=head3 rewrite_items($items, $ctx, $section, $name)
+
+For each item in C<$items> that references one of the objects in its replacement map, apply the
+action defined in C<$ctx>, recording one change per item in C<$ctx->{changes}>.
+
+C<$section> and C<$name> declare where the items come from and end up in those records.
+
+Return the updated items arrayref.
+
+=cut
+
+sub rewrite_items {
+    my ($items, $ctx, $section, $name) = @_;
+
+    my $repl = $ctx->{repl};
+    my $action = $ctx->{action};
+
+    # an IPSet member has no disabled state, so disabling it means removing it
+    my $remove = $action eq 'drop' || ($action eq 'disable' && $section eq 'ipset');
+
+    $items //= [];
+    my @result;
+
+    for my $pos (0 .. $items->$#*) {
+        my $item = $items->[$pos];
+
+        my $ref = matched_ref($item, $repl);
+        if (!defined($ref)) {
+            # no match, keep item
+            push @result, $item;
+            next;
+        }
+
+        push $ctx->{changes}->@*,
+            {
+                section => $section,
+                name => $name,
+                pos => $pos,
+                ref => $ref,
+                new => $repl->{$ref},
+                action => $action,
+            };
+
+        next if $remove;
+
+        if ($action eq 'rename') {
+            for my $field ($ref_fields->@*) {
+                my $value = lc($item->{$field} // '');
+                $item->{$field} = $repl->{$value} if exists($repl->{$value});
+            }
+        } else {
+            $item->{enable} = 0;
+        }
+
+        push @result, $item;
+    }
+
+    return \@result;
+}
+
+=head3 build_ref_map($op, $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.
+
+A reference may be scoped, and which scopes a given object answers to depends on where it is defined
+and on whether C<$conf> is a cluster or guest config:
+
+=over
+
+=item a cluster object answers to C<dc/>, and to a bare reference unless C<$conf> is a guest config
+defining an object of the same name, which would shadow the cluster object instead
+
+=item an SDN object answers to C<sdn/>, and to a bare reference unless the same name is shadowed by
+a guest-local or a cluster object
+
+=item a guest object answers to C<guest/> and to a bare reference
+
+=back
+
+=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 $prefix = $spec->{prefix};
+    my $self = $spec->{self};
+    my $new = $op->{new};
+
+    my $map = {};
+
+    for my $name ($op->{old}->@*) {
+        my $shadowed = $is_guest && $conf->{$self}->{$name};
+
+        my $scopes = [];
+        if ($env eq 'cluster') {
+            push $scopes->@*, 'dc/';
+            push $scopes->@*, '' if !$shadowed;
+        } elsif ($env eq 'sdn') {
+            push $scopes->@*, 'sdn/';
+            push $scopes->@*, '' if !$shadowed && !$op->{cluster_conf}->{$self}->{$name};
+        } else {
+            push $scopes->@*, '', 'guest/';
+        }
+
+        $map->{"$prefix$_$name"} = defined($new) ? "$prefix$_$new" : undef for $scopes->@*;
+    }
+
+    return $map;
+}
+
+=head3 rewrite_refs_in_conf($conf, $op, $env, $is_guest)
+
+Apply the action of C<$op> to all references in C<$conf> to the objects it names. C<$env> is the
+environment the objects come from and C<$is_guest> says whether C<$conf> is a guest config. Together
+they decide how references are resolved, see C<build_ref_map>'s POD.
+
+C<$op> (built by C<update_refs>) describes the rewrite:
+
+    kind            # the object kind, see update_refs()
+    old             # arrayref of lowercased names whose references are to be rewritten
+    new             # the new name, lowercased, when renaming, undef otherwise
+    action          # 'rename' | 'disable' | 'drop'
+    cluster_conf    # the cluster config
+
+Return the changes made.
+
+Only exposed for testing, see C<update_refs>'s POD for details.
+
+=cut
+
+sub rewrite_refs_in_conf {
+    my ($conf, $op, $env, $is_guest) = @_;
+
+    my $ctx = {
+        repl => build_ref_map($op, $conf, $env, $is_guest),
+        action => $op->{action},
+        changes => [],
+    };
+
+    $conf->{rules} = rewrite_items($conf->{rules}, $ctx, 'rules');
+
+    for my $part ([groups => 'group'], [ipset => 'ipset']) {
+        my ($key, $section) = $part->@*;
+        my $map = $conf->{$key} // {};
+        for my $name (keys $map->%*) {
+            $map->{$name} = rewrite_items($map->{$name}, $ctx, $section, $name);
+        }
+    }
+
+    return $ctx->{changes};
+}
+
+=head3 update_refs($opts)
+
+Rename, disable or drop all references to a firewall object across the environment.
+
+References are matched in rules, security groups and IPSet members. Matching is case-insensitive
+and renames are written back lowercased.
+
+C<$opts> holds:
+
+    conf     # the firewall config the object is defined in
+    kind     # 'ipset' or 'aliases'
+    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
+    action   # 'rename', 'disable' or 'drop', or undef to leave the references alone
+    save     # persists C<conf>, required for a cluster-wide rename
+
+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
+C<conf> itself have been rewritten and before any downstream config is: downstream configs are
+rewritten to reference the object under its new name, and a concurrent compilation parsing the
+cluster config would fail to resolve that name until it has been written.
+
+The caller is responsible for locking and saving C<conf> itself.
+
+Return the number of references changed.
+
+=cut
+
+sub update_refs {
+    my ($opts) = @_;
+
+    my ($conf, $kind, $old, $new, $env, $action) = $opts->@{qw(conf kind old new env action)};
+
+    return 0 if !defined($action);
+
+    die "invalid action '$action'" if $action !~ m/^(rename|disable|drop)$/;
+    die "\$new must be set if \$action is 'rename'" if $action eq 'rename' && !defined($new);
+    die "\$save is required to rename across the cluster"
+        if $action eq 'rename' && ($env eq 'cluster' || $env eq 'sdn') && !$opts->{save};
+
+    my $lc_old = [map { lc($_) } (ref($old) eq 'ARRAY' ? $old->@* : $old)];
+
+    die "cannot rename more than one object at once\n"
+        if $action eq 'rename' && scalar($lc_old->@*) != 1;
+
+    my $op = {
+        kind => $kind,
+        old => $lc_old,
+        new => $action eq 'rename' ? lc($new) : undef,
+        action => $action,
+        cluster_conf => $conf,
+        save => $opts->{save},
+    };
+
+    return scalar(rewrite_refs_in_env($conf, $env, $op)->@*);
+}
+
 1;
-- 
2.47.3