[PATCH pve-firewall v4 10/27] firewall: api: run reference updates as tasks

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

A 'dangling-references' action other than 'keep' rewrites the rules that
referenced the object, which for a cluster-scoped object means going
through all guest, host and vnet firewall configs in the cluster,
potentially updating each of them.

The update_refs() helper logs each change made to each config. Fork
workers for renames and removals in order for the logs to land in the
task log, which is visible cluster-wide, instead of the syslog, which
is only visible on the node that happened to handle the request. Plain
creates or updates that only change a comment still run synchronously.

Checks that can be performed without holding the lock are made before
forking so a rejected request can still fail right away instead of
requiring the caller to go read the task.

Signed-off-by: Arthur Bied-Charreton <a.bied-charreton@proxmox.com>
---
 src/PVE/API2/Firewall/Aliases.pm | 238 +++++++++++++++++-------------
 src/PVE/API2/Firewall/IPSet.pm   | 241 ++++++++++++++++++-------------
 src/PVE/Firewall/References.pm   |  20 +++
 3 files changed, 297 insertions(+), 202 deletions(-)

diff --git a/src/PVE/API2/Firewall/Aliases.pm b/src/PVE/API2/Firewall/Aliases.pm
index cb9b448..36d091e 100644
--- a/src/PVE/API2/Firewall/Aliases.pm
+++ b/src/PVE/API2/Firewall/Aliases.pm
@@ -3,7 +3,7 @@ package PVE::API2::Firewall::AliasesBase;
 use strict;
 use warnings;
 
-use PVE::Firewall::References qw(update_refs);
+use PVE::Firewall::References qw(update_refs run_ref_update);
 use PVE::Exception qw(raise raise_param_exc);
 use PVE::JSONSchema qw(get_standard_option);
 
@@ -84,6 +84,36 @@ my $aliases_to_list = sub {
     return $list;
 };
 
+my $check_digest = sub {
+    my ($aliases, $param) = @_;
+
+    my $list = &$aliases_to_list($aliases);
+    my (undef, $digest) = PVE::Firewall::copy_list_with_digest($list);
+
+    PVE::Tools::assert_if_modified($digest, $param->{digest});
+};
+
+my $check_update = sub {
+    my ($aliases, $param, $dangling_refs) = @_;
+
+    $check_digest->($aliases, $param);
+
+    my $name = lc($param->{name});
+    raise_param_exc({ name => "no such alias" }) if !$aliases->{$name};
+
+    my $rename = $param->{rename};
+    $rename = lc($rename) if $rename;
+
+    if (
+        $rename
+        && $name ne $rename
+        && defined($aliases->{$rename})
+        && $dangling_refs ne 'force-rename'
+    ) {
+        raise_param_exc({ name => "alias '$param->{rename}' already exists" });
+    }
+};
+
 sub register_get_aliases {
     my ($class) = @_;
 
@@ -245,87 +275,93 @@ sub register_update_alias {
             additionalProperties => 0,
             properties => $properties,
         },
-        returns => { type => "null" },
+        returns => { type => 'string', optional => 1 },
         code => sub {
             my ($param) = @_;
 
-            $class->lock_config(
-                $param,
-                sub {
-                    my ($param) = @_;
-
-                    my $dangling_refs = $param->{'dangling-references'} // 'keep';
-
-                    # 'force-rename' only differs in skipping the check above, the references are
-                    # renamed either way
-                    my $ref_action;
-                    if ($dangling_refs eq 'force-rename') {
-                        $ref_action = 'rename';
-                    } elsif ($dangling_refs ne 'keep') {
-                        $ref_action = $dangling_refs;
-                    }
-
-                    my ($fw_conf, $aliases) = $class->load_config($param);
-
-                    my $list = &$aliases_to_list($aliases);
-
-                    my (undef, $digest) = PVE::Firewall::copy_list_with_digest($list);
-
-                    PVE::Tools::assert_if_modified($digest, $param->{digest});
-
-                    my $name = lc($param->{name});
-
-                    raise_param_exc({ name => "no such alias" }) if !$aliases->{$name};
-
-                    my $data = { name => $param->{name}, cidr => $param->{cidr} };
-                    $data->{comment} = $param->{comment} if $param->{comment};
+            my $dangling_refs = $param->{'dangling-references'} // 'keep';
+
+            # 'force-rename' only differs in skipping the check above, the references are renamed
+            # either way
+            my $ref_action;
+            if ($dangling_refs eq 'force-rename') {
+                $ref_action = 'rename';
+            } elsif ($dangling_refs ne 'keep') {
+                $ref_action = $dangling_refs;
+            }
+
+            my $renaming = $param->{rename} && lc($param->{name}) ne lc($param->{rename});
+            my $subject =
+                $renaming ? "alias '$param->{name}' renamed to '$param->{rename}'" : undef;
+
+            my $code = sub {
+                $class->lock_config(
+                    $param,
+                    sub {
+                        my ($param) = @_;
+
+                        my ($fw_conf, $aliases) = $class->load_config($param);
+
+                        $check_update->($aliases, $param, $dangling_refs);
+
+                        my $name = lc($param->{name});
+
+                        my $data = { name => $param->{name}, cidr => $param->{cidr} };
+                        $data->{comment} = $param->{comment} if $param->{comment};
+
+                        $aliases->{$name} = $data;
+
+                        my $rename = $param->{rename};
+                        $rename = lc($rename) if $rename;
+
+                        if ($rename && ($name ne $rename)) {
+                            $aliases->{$rename} =
+                                { $aliases->{$name}->%*, name => $param->{rename} };
+
+                            my $saved = 0;
+                            my $save = sub {
+                                $class->save_aliases($param, $fw_conf, $aliases);
+                                $saved = 1;
+                            };
+
+                            eval {
+                                update_refs({
+                                    conf => $fw_conf,
+                                    kind => 'aliases',
+                                    old => $name,
+                                    new => $param->{rename},
+                                    env => $class->rule_env(),
+                                    action => $ref_action,
+                                    subject => $subject,
+                                    save => $save,
+                                });
+                            };
+                            if (my $err = $@) {
+                                die "rename interrupted, the alias exists under both names; "
+                                    . "retry with 'force-rename' to finish: $err"
+                                    if $saved;
+                                die "could not update references to alias '$name': $err";
+                            }
+
+                            delete $aliases->{$name};
+                        }
 
-                    $aliases->{$name} = $data;
+                        $class->save_aliases($param, $fw_conf, $aliases);
+                    },
+                );
+            };
 
-                    my $rename = $param->{rename};
-                    $rename = lc($rename) if $rename;
-
-                    if ($rename && ($name ne $rename)) {
-                        raise_param_exc({ name => "alias '$param->{rename}' already exists" })
-                            if defined($aliases->{$rename})
-                            && $dangling_refs ne 'force-rename';
-
-                        $aliases->{$rename} =
-                            { $aliases->{$name}->%*, name => $param->{rename} };
-
-                        my $saved = 0;
-                        my $save = sub {
-                            $class->save_aliases($param, $fw_conf, $aliases);
-                            $saved = 1;
-                        };
-
-                        eval {
-                            update_refs({
-                                conf => $fw_conf,
-                                kind => 'aliases',
-                                old => $name,
-                                new => $param->{rename},
-                                env => $class->rule_env(),
-                                action => $ref_action,
-                                subject => "alias '$name' renamed to '$rename'",
-                                save => $save,
-                            });
-                        };
-                        if (my $err = $@) {
-                            die "rename interrupted, the alias exists under both names; "
-                                . "retry with 'force-rename' to finish: $err"
-                                if $saved;
-                            die "could not update references to alias '$name': $err";
-                        }
+            if (!$renaming) {
+                $code->();
+                return undef;
+            }
 
-                        delete $aliases->{$name};
-                    }
+            # fail on the request instead of inside the task.
+            my (undef, $aliases) = $class->load_config($param);
 
-                    $class->save_aliases($param, $fw_conf, $aliases);
-                },
-            );
+            $check_update->($aliases, $param, $dangling_refs);
 
-            return undef;
+            return run_ref_update('fw-alias-rename', $param->{vmid} // $param->{name}, $code);
         },
     });
 }
@@ -359,41 +395,47 @@ sub register_delete_alias {
             additionalProperties => 0,
             properties => $properties,
         },
-        returns => { type => "null" },
+        returns => { type => 'string', optional => 1 },
         code => sub {
             my ($param) = @_;
 
-            $class->lock_config(
-                $param,
-                sub {
-                    my ($param) = @_;
+            my $action = $param->{'dangling-references'} // 'keep';
+            my $subject = "alias '$param->{name}' deleted";
 
-                    my ($fw_conf, $aliases) = $class->load_config($param);
+            my $code = sub {
+                $class->lock_config(
+                    $param,
+                    sub {
+                        my ($param) = @_;
 
-                    my $list = &$aliases_to_list($aliases);
-                    my (undef, $digest) = PVE::Firewall::copy_list_with_digest($list);
-                    PVE::Tools::assert_if_modified($digest, $param->{digest});
+                        my ($fw_conf, $aliases) = $class->load_config($param);
 
-                    my $name = lc($param->{name});
+                        $check_digest->($aliases, $param);
 
-                    my $action = $param->{'dangling-references'} // 'keep';
+                        my $name = lc($param->{name});
 
-                    update_refs({
-                        conf => $fw_conf,
-                        kind => 'aliases',
-                        old => $param->{name},
-                        env => $class->rule_env(),
-                        action => $action eq 'keep' ? undef : $action,
-                        subject => "alias '$param->{name}' deleted",
-                    });
+                        update_refs({
+                            conf => $fw_conf,
+                            kind => 'aliases',
+                            old => $param->{name},
+                            env => $class->rule_env(),
+                            action => $action eq 'keep' ? undef : $action,
+                            subject => $subject,
+                        });
 
-                    delete $aliases->{$name};
+                        delete $aliases->{$name};
 
-                    $class->save_aliases($param, $fw_conf, $aliases);
-                },
-            );
+                        $class->save_aliases($param, $fw_conf, $aliases);
+                    },
+                );
+            };
 
-            return undef;
+            # fail on the request instead of inside the task
+            my (undef, $aliases) = $class->load_config($param);
+
+            $check_digest->($aliases, $param);
+
+            return run_ref_update('fw-alias-delete', $param->{vmid} // $param->{name}, $code);
         },
     });
 }
diff --git a/src/PVE/API2/Firewall/IPSet.pm b/src/PVE/API2/Firewall/IPSet.pm
index fe4f8c9..a4356e4 100644
--- a/src/PVE/API2/Firewall/IPSet.pm
+++ b/src/PVE/API2/Firewall/IPSet.pm
@@ -2,7 +2,7 @@ package PVE::API2::Firewall::IPSetBase;
 
 use strict;
 use warnings;
-use PVE::Firewall::References qw(update_refs);
+use PVE::Firewall::References qw(update_refs run_ref_update);
 use PVE::Exception qw(raise raise_param_exc);
 use PVE::JSONSchema qw(get_standard_option);
 
@@ -162,37 +162,45 @@ sub register_delete_ipset {
             additionalProperties => 0,
             properties => $properties,
         },
-        returns => { type => 'null' },
+        returns => { type => 'string', optional => 1 },
         code => sub {
             my ($param) = @_;
 
-            $class->lock_config(
-                $param,
-                sub {
-                    my ($param) = @_;
+            my $action = $param->{'dangling-references'} // 'keep';
+            my $subject = "ipset '$param->{name}' deleted";
 
-                    my ($cluster_conf, $fw_conf, $ipset) = $class->load_config($param);
+            my $code = sub {
+                $class->lock_config(
+                    $param,
+                    sub {
+                        my ($param) = @_;
 
-                    die "IPSet '$param->{name}' is not empty\n"
-                        if scalar(@$ipset) && !$param->{force};
+                        my ($cluster_conf, $fw_conf, $ipset) = $class->load_config($param);
 
-                    my $action = $param->{'dangling-references'} // 'keep';
+                        die "IPSet '$param->{name}' is not empty\n"
+                            if scalar(@$ipset) && !$param->{force};
 
-                    update_refs({
-                        conf => $fw_conf,
-                        kind => 'ipset',
-                        old => $param->{name},
-                        env => $class->rule_env(),
-                        action => $action eq 'keep' ? undef : $action,
-                        subject => "ipset '$param->{name}' deleted",
-                    });
+                        update_refs({
+                            conf => $fw_conf,
+                            kind => 'ipset',
+                            old => $param->{name},
+                            env => $class->rule_env(),
+                            action => $action eq 'keep' ? undef : $action,
+                            subject => $subject,
+                        });
 
-                    $class->save_ipset($param, $fw_conf, undef);
+                        $class->save_ipset($param, $fw_conf, undef);
+                    },
+                );
+            };
 
-                },
-            );
+            # fail on the request instead of inside the task
+            my (undef, undef, $ipset) = $class->load_config($param);
 
-            return undef;
+            die "IPSet '$param->{name}' is not empty\n"
+                if scalar($ipset->@*) && !$param->{force};
+
+            return run_ref_update('fw-ipset-delete', $param->{vmid} // $param->{name}, $code);
         },
     });
 }
@@ -555,7 +563,7 @@ package PVE::API2::Firewall::BaseIPSetList;
 
 use strict;
 use warnings;
-use PVE::Firewall::References qw(update_refs);
+use PVE::Firewall::References qw(update_refs run_ref_update);
 use PVE::JSONSchema qw(get_standard_option);
 use PVE::Exception qw(raise_param_exc);
 use PVE::Firewall;
@@ -623,6 +631,25 @@ my $get_ipset_list = sub {
     return wantarray ? ($list, $digest) : $list;
 };
 
+my $check_rename = sub {
+    my ($conf, $param, $dangling_refs) = @_;
+
+    my (undef, $digest) = &$get_ipset_list($conf);
+    PVE::Tools::assert_if_modified($digest, $param->{digest});
+
+    raise_param_exc({ name => "IPSet '$param->{rename}' does not exist" })
+        if !$conf->{ipset}->{ $param->{rename} };
+
+    # prevent overwriting existing ipset
+    if (
+        $param->{name} ne $param->{rename}
+        && $conf->{ipset}->{ $param->{name} }
+        && $dangling_refs ne 'force-rename'
+    ) {
+        raise_param_exc({ name => "IPSet '$param->{name}' already exists" });
+    }
+};
+
 sub register_index {
     my ($class) = @_;
 
@@ -707,100 +734,106 @@ sub register_create {
             additionalProperties => 0,
             properties => $properties,
         },
-        returns => { type => 'null' },
+        returns => { type => 'string', optional => 1 },
         code => sub {
             my ($param) = @_;
 
-            $class->lock_config(
-                $param,
-                sub {
-                    my ($param) = @_;
-
-                    my $dangling_refs = $param->{'dangling-references'} // 'keep';
+            my $dangling_refs = $param->{'dangling-references'} // 'keep';
 
-                    # 'force-rename' only differs in skipping the check below, the references are
-                    # renamed either way
-                    my $ref_action;
-                    if ($dangling_refs eq 'force-rename') {
-                        $ref_action = 'rename';
-                    } elsif ($dangling_refs ne 'keep') {
-                        $ref_action = $dangling_refs;
-                    }
+            # 'force-rename' only differs in skipping the check above, the references are renamed
+            # either way
+            my $ref_action;
+            if ($dangling_refs eq 'force-rename') {
+                $ref_action = 'rename';
+            } elsif ($dangling_refs ne 'keep') {
+                $ref_action = $dangling_refs;
+            }
 
-                    my ($cluster_conf, $fw_conf) = $class->load_config($param);
-
-                    if ($param->{rename}) {
-                        my (undef, $digest) = &$get_ipset_list($fw_conf);
-                        PVE::Tools::assert_if_modified($digest, $param->{digest});
-
-                        raise_param_exc({ name => "IPSet '$param->{rename}' does not exist" })
-                            if !$fw_conf->{ipset}->{ $param->{rename} };
-
-                        if ($param->{name} ne $param->{rename}) {
-                            # prevent overwriting existing ipset
-                            raise_param_exc({
-                                name => "IPSet '$param->{name}' does already exist" })
-                                if $fw_conf->{ipset}->{ $param->{name} }
-                                && $dangling_refs ne 'force-rename';
-
-                            $fw_conf->{ipset}->{ $param->{name} } =
-                                $fw_conf->{ipset}->{ $param->{rename} };
-
-                            my $saved = 0;
-                            my $save = sub {
-                                $class->save_config($param, $fw_conf);
-                                $saved = 1;
-                            };
-
-                            eval {
-                                update_refs({
-                                    conf => $fw_conf,
-                                    kind => 'ipset',
-                                    old => $param->{rename},
-                                    new => $param->{name},
-                                    env => $class->rule_env(),
-                                    action => $ref_action,
-                                    subject =>
-                                        "ipset '$param->{rename}' renamed to '$param->{name}'",
-                                    save => $save,
-                                });
-                            };
-                            if (my $err = $@) {
-                                die "rename interrupted, the IPSet exists under both names; "
-                                    . "retry with 'force-rename' to finish: $err"
-                                    if $saved;
-                                die "could not update references to IPSet "
-                                    . "'$param->{rename}': $err";
+            my $renaming = $param->{rename} && $param->{name} ne $param->{rename};
+            my $subject =
+                $renaming ? "ipset '$param->{rename}' renamed to '$param->{name}'" : undef;
+
+            my $code = sub {
+                $class->lock_config(
+                    $param,
+                    sub {
+                        my ($param) = @_;
+
+                        my ($cluster_conf, $fw_conf) = $class->load_config($param);
+
+                        if ($param->{rename}) {
+                            $check_rename->($fw_conf, $param, $dangling_refs);
+
+                            if ($param->{name} ne $param->{rename}) {
+                                $fw_conf->{ipset}->{ $param->{name} } =
+                                    $fw_conf->{ipset}->{ $param->{rename} };
+
+                                my $saved = 0;
+                                my $save = sub {
+                                    $class->save_config($param, $fw_conf);
+                                    $saved = 1;
+                                };
+
+                                eval {
+                                    update_refs({
+                                        conf => $fw_conf,
+                                        kind => 'ipset',
+                                        old => $param->{rename},
+                                        new => $param->{name},
+                                        env => $class->rule_env(),
+                                        action => $ref_action,
+                                        subject => $subject,
+                                        save => $save,
+                                    });
+                                };
+                                if (my $err = $@) {
+                                    die
+                                        "rename interrupted, the IPSet exists under both names; "
+                                        . "retry with 'force-rename' to finish: $err"
+                                        if $saved;
+                                    die "could not update references to IPSet "
+                                        . "'$param->{rename}': $err";
+                                }
+
+                                delete $fw_conf->{ipset}->{ $param->{rename} };
+
+                                if (
+                                    my $comment =
+                                    delete $fw_conf->{ipset_comments}->{ $param->{rename} }
+                                ) {
+                                    $fw_conf->{ipset_comments}->{ $param->{name} } = $comment;
+                                }
                             }
 
-                            delete $fw_conf->{ipset}->{ $param->{rename} };
-
-                            if (
-                                my $comment =
-                                delete $fw_conf->{ipset_comments}->{ $param->{rename} }
-                            ) {
-                                $fw_conf->{ipset_comments}->{ $param->{name} } = $comment;
+                            $fw_conf->{ipset_comments}->{ $param->{name} } = $param->{comment}
+                                if defined($param->{comment});
+                        } else {
+                            foreach my $name (keys %{ $fw_conf->{ipset} }) {
+                                raise_param_exc({ name => "IPSet '$name' already exists" })
+                                    if $name eq $param->{name};
                             }
-                        }
 
-                        $fw_conf->{ipset_comments}->{ $param->{name} } = $param->{comment}
-                            if defined($param->{comment});
-                    } else {
-                        foreach my $name (keys %{ $fw_conf->{ipset} }) {
-                            raise_param_exc({ name => "IPSet '$name' already exists" })
-                                if $name eq $param->{name};
+                            $fw_conf->{ipset}->{ $param->{name} } = [];
+                            $fw_conf->{ipset_comments}->{ $param->{name} } = $param->{comment}
+                                if defined($param->{comment});
                         }
 
-                        $fw_conf->{ipset}->{ $param->{name} } = [];
-                        $fw_conf->{ipset_comments}->{ $param->{name} } = $param->{comment}
-                            if defined($param->{comment});
-                    }
+                        $class->save_config($param, $fw_conf);
+                    },
+                );
+            };
 
-                    $class->save_config($param, $fw_conf);
-                },
-            );
+            if (!$renaming) {
+                $code->();
+                return undef;
+            }
 
-            return undef;
+            # fail on the request instead of inside the task
+            my (undef, $fw_conf) = $class->load_config($param);
+
+            $check_rename->($fw_conf, $param, $dangling_refs);
+
+            return run_ref_update('fw-ipset-rename', $param->{vmid} // $param->{rename}, $code);
         },
     });
 }
diff --git a/src/PVE/Firewall/References.pm b/src/PVE/Firewall/References.pm
index 37df434..f32c7db 100644
--- a/src/PVE/Firewall/References.pm
+++ b/src/PVE/Firewall/References.pm
@@ -13,6 +13,7 @@ use base 'Exporter';
 our @EXPORT_OK = qw(
     collect_refs
     update_refs
+    run_ref_update
 );
 
 sub collect_refs {
@@ -422,6 +423,25 @@ sub update_refs {
     return $count;
 }
 
+=head3 run_ref_update($type, $id, $code)
+
+Run C<$code> as a worker task of type C<$type> for C<$id>.
+
+C<$id> is the guest a guest-scoped object belongs to so the task is logged with that guest, and the
+name of the object otherwise.
+
+Return the UPID of the task.
+
+=cut
+
+sub run_ref_update {
+    my ($type, $id, $code) = @_;
+
+    my $rpcenv = PVE::RESTEnvironment::get();
+
+    return $rpcenv->fork_worker($type, $id, $rpcenv->get_user(), $code);
+}
+
 =head3 format_ref_change($change)
 
 Format one recorded config change as a single line, e.g.
-- 
2.47.3