Re: [PATCH manager 15/19] vzdump: limit concurrent guest backups cluster-wide

[Fiona Ebner <f.ebner@proxmox.com>]

Am 02.11.26 um 12:02 AM schrieb Thomas Lamprecht:
> diff --git a/PVE/Service/pvescheduler.pm b/PVE/Service/pvescheduler.pm
> index f7271fc00..e54f94183 100755
> --- a/PVE/Service/pvescheduler.pm
> +++ b/PVE/Service/pvescheduler.pm
> @@ -7,6 +7,7 @@ use POSIX qw(WNOHANG);
>  
>  use PVE::Jobs;
>  use PVE::SafeSyslog;
> +use PVE::VZDump;
>  
>  use PVE::API2::Replication;
>  
> @@ -114,6 +115,9 @@ sub run {
>          $fork->(
>              'jobs',
>              sub {
> +                eval { PVE::VZDump::cleanup_cluster_slots() };
> +                syslog('err', "backup slots: $@") if $@;
> +
>                  PVE::Jobs::run_jobs($first_run);
>              },
>          );
> diff --git a/PVE/VZDump.pm b/PVE/VZDump.pm
> index f597f7ed7..525a593c6 100644
> --- a/PVE/VZDump.pm
> +++ b/PVE/VZDump.pm
> @@ -25,6 +25,7 @@ use PVE::Notify;
>  use PVE::RPCEnvironment;
>  use PVE::Storage;
>  use PVE::VZDump::Common;
> +use PVE::VZDump::ClusterSlots;
>  use PVE::VZDump::Plugin;
>  use PVE::Tools qw(extract_param split_list);
>  use PVE::API2Tools;
> @@ -1683,6 +1684,18 @@ my sub try_guest_lock {
>      return $fh;
>  }
>  
> +my sub guest_backup_running {
> +    my ($vmid, $upid) = @_;
> +
> +    open(my $fh, '<', "$lockdir/guest-$vmid.lock") or return 0;

Should we distinguish ENOENT and different errors?

> +    return 0 if flock($fh, LOCK_SH | LOCK_NB);
> +
> +    my $holder = <$fh> // '';
> +    chomp($holder);
> +
> +    return $holder eq $upid;
> +}
> +
>  # Slots above a lowered limit stay in use until their backups end, no new one starts before.
>  my sub try_slot {
>      my ($prefix, $limit) = @_;
> @@ -1771,23 +1784,138 @@ my sub skip_after_error {
>      skip_task($_, "not started due to error - $reason") for splice($queue->@*);
>  }
>  
> +my sub cluster_slot_resources {
> +    my ($self) = @_;
> +
> +    my $limits = PVE::VZDump::ClusterSlots::limits();
> +    return undef if !scalar(keys $limits->%*);
> +
> +    if (!PVE::VZDump::ClusterSlots::supported_by_all_nodes()) {
> +        debugmsg(
> +            'warn',
> +            "cluster-wide backup limits are not enforced - not all online nodes support them",
> +        ) if !$self->{'cluster-slots-unsupported'}++;

Style nit: multiline post-if

> +        return undef;
> +    }
> +
> +    return ['cluster'];
> +}
> +
> +my sub release_cluster_slots {
> +    my ($key) = @_;
> +
> +    return if !defined($key);
> +
> +    eval { PVE::VZDump::ClusterSlots::release($key) };
> +    if (my $err = $@) {
> +        die $err if $err =~ m/interrupted by signal$/; # also if wrapped by the cluster lock
> +        debugmsg('warn', "unable to release cluster-wide backup slot - $err");
> +    }
> +}
> +
> +sub cleanup_cluster_slots {
> +    PVE::VZDump::ClusterSlots::cleanup_local_entries(\&guest_backup_running);
> +}
> +
> +# A claimed guest that needs cluster-wide slots waits for them as pending guest, only one at a time.
> +my sub next_guest_to_start {
> +    my ($self, $queue, $schedule) = @_;
> +
> +    my $pending = $schedule->{pending};
> +    if (!$pending) {
> +        my ($task, $locks) = claim_next_guest($self, $queue, $schedule->{deferred}) or return;
> +        my $resources = eval { cluster_slot_resources($self) };
> +        if (my $err = $@) {
> +            unshift $queue->@*, $task;
> +            die $err;
> +        }
> +        return ($task, $locks) if !$resources;
> +
> +        $pending = $schedule->{pending} = {
> +            task => $task,
> +            locks => $locks,
> +            resources => $resources,
> +            since => time(),
> +            refreshed => time(),
> +        };
> +    }
> +
> +    my $task = $pending->{task};
> +    my $granted = eval {
> +        $pending->{key} //=
> +            PVE::VZDump::ClusterSlots::request($self->{upid}, $task->{vmid}, $pending->{resources});
> +        if (time() - $pending->{refreshed} >= 30) {
> +            PVE::VZDump::ClusterSlots::refresh();
> +            $pending->{refreshed} = time();
> +        }
> +        PVE::VZDump::ClusterSlots::granted($pending->{key});
> +    };
> +    if (my $err = $@) {
> +        die $err if $err =~ m/interrupted by signal$/;
> +        chomp($err);
> +        debugmsg('warn', "unable to request cluster-wide backup slot - $err")
> +            if !defined($pending->{'request-error'});

Should we check if it's the same error as last time and log it if not?

> +        $pending->{'request-error'} = $err;
> +    } elsif (!defined($granted)) {
> +        $pending->{key} = undef; # vanished, for example if released by an admin
> +    } elsif ($granted) {
> +        delete $schedule->{pending};
> +        $schedule->{'cluster-wait'} += time() - $pending->{since};
> +        if (my $node = guest_moved_to($task->{vmid})) {
> +            release_cluster_slots($pending->{key});
> +            skip_task($task, "guest moved to node '$node'");
> +            return;
> +        }
> +        return ($task, $pending->{locks}, $pending->{key});
> +    } else {
> +        delete $pending->{'request-error'};
> +    }
> +
> +    my $waited = $schedule->{'cluster-wait'} + time() - $pending->{since};
> +    my $maxwait = ($self->{opts}->{lockwait} || 0) * 60;

Same as in patch 12/19:

The default according to the schema would be 3 hours. But getlock()
already relies on the value being initialized by new(), so we could do
the same here.

> +    if ($waited >= $maxwait) {
> +        release_cluster_slots($pending->{key});
> +        delete $schedule->{pending};
> +        $schedule->{'cluster-wait'} = $waited;
> +        my $reason = 'timeout waiting for cluster-wide backup slot';
> +        $reason .= " - $pending->{'request-error'}" if defined($pending->{'request-error'});
> +        skip_task($task, $reason);
> +    } elsif (!$pending->{logged}++) {
> +        debugmsg('info', "VM $task->{vmid} waits for a cluster-wide backup slot");
> +    }
> +
> +    return;
> +}
> +

---snip 8<---

> diff --git a/PVE/VZDump/ClusterSlots.pm b/PVE/VZDump/ClusterSlots.pm
> new file mode 100644
> index 000000000..6537bdce5
> --- /dev/null
> +++ b/PVE/VZDump/ClusterSlots.pm
> @@ -0,0 +1,245 @@
> +package PVE::VZDump::ClusterSlots;
> +
> +# Cluster-wide limits for guest backups running at the same time.
> +#
> +# Each guest backup that counts against such a limit has an entry in a shared table on pmxcfs. It
> +# starts out as waiter and becomes holder once all limits it counts against have room. Entries of
> +# offline nodes stay, as their guest backups might still be running.
> +
> +use strict;
> +use warnings;

Nit: please use v5.36 and subroutine signatures for new modules

> +
> +use JSON;
> +
> +use PVE::Cluster qw(cfs_read_file);
> +use PVE::INotify;
> +use PVE::QemuServer::Helpers;
> +use PVE::Tools;
> +
> +my $state_file = '/etc/pve/priv/backup-slots.json';

It does not hold any secrets, so is there a special reason why inside priv/?

> +
> +# first release of pve-manager that takes part in cluster-wide limits
> +my $min_version = [9, 2, 26];
> +
> +sub limits {
> +    my $limits = {};
> +
> +    my $dc_conf = cfs_read_file('datacenter.cfg');
> +    if (defined(my $cluster = $dc_conf->{'backup-concurrency'}->{cluster})) {
> +        $limits->{cluster} = $cluster;
> +    }
> +
> +    return $limits;
> +}
> +
> +my sub get_members {
> +    my $members = PVE::Cluster::get_members();
> +    return $members if $members && scalar(keys $members->%*);
> +
> +    # entries of other nodes would get dropped as if these left the cluster
> +    die "unable to get cluster members\n" if -e '/etc/pve/corosync.conf';
> +
> +    return { PVE::INotify::nodename() => { online => 1 } };
> +}
> +
> +# Offline nodes cannot start guest backups, and their entries stay anyway.
> +sub supported_by_all_nodes {
> +    my $members = get_members();
> +    my $nodename = PVE::INotify::nodename();
> +
> +    for my $node (keys $members->%*) {
> +        next if $node eq $nodename || !$members->{$node}->{online};
> +        my $version = PVE::QemuServer::Helpers::get_node_pvecfg_version($node);
> +        return 0 if !PVE::QemuServer::Helpers::pvecfg_min_version($version, $min_version->@*);

Nit: could use the pvecfg_min_version() from PVE::Tools

Note: conflicts with my patch, which moves the get_node_pvecfg_version()
to PVE::Cluster, so you might want to apply the relevant patch there
first and switch to using the helper from PVE::Cluster:
https://lore.proxmox.com/pve-devel/20261103124831.139399-3-f.ebner@proxmox.com/

> +    }
> +    return 1;
> +}
> +
> +# Checks a copy, so that numbers do not get written back as strings.
> +my sub is_count {
> +    my ($value) = @_;
> +    return defined($value) && !ref($value) && $value =~ m/^\d+$/;
> +}
> +
> +my sub valid_entry {
> +    my ($entry) = @_;
> +
> +    return
> +        ref($entry) eq 'HASH'
> +        && (grep { !ref($entry->{$_}) && length($entry->{$_} // '') } qw(node upid)) == 2
> +        && is_count($entry->{vmid})
> +        && is_count($entry->{seq})
> +        && ref($entry->{resources}) eq 'ARRAY'
> +        && !grep { ref($_) || !length($_ // '') } $entry->{resources}->@*;
> +}
> +
> +sub parse_state {
> +    my ($raw) = @_;
> +
> +    my $state = eval { decode_json($raw) };
> +    die "invalid JSON - $@" if $@;
> +    die "not a backup slot table\n"

Maybe log the $raw in the error messages, so it can be checked what the
concrete failure was?

> +        if ref($state) ne 'HASH'
> +        || (grep { ref($state->{$_}) ne 'HASH' } qw(holders waiters))
> +        || !is_count($state->{seq})
> +        || grep { !valid_entry($_) } map { values $state->{$_}->%* } qw(holders waiters);

Style nit: multiline post-if

> +
> +    return $state;
> +}
> +
> +# Fails on anything but a missing file, as writing back a table that lacks holders would let more
> +# guest backups start than the limits allow.
> +sub read_state {
> +    open(my $fh, '<', $state_file) or do {
> +        die "unable to open '$state_file' - $!\n" if !$!{ENOENT};
> +        return { holders => {}, waiters => {}, seq => 0 };
> +    };
> +    my $raw = PVE::Tools::safe_read_from($fh, 0, 0, $state_file);

Nit: could use PVE::File

> +    my $state = eval { parse_state($raw) };
> +    die "unable to parse '$state_file' - $@" if $@;
> +
> +    return $state;
> +}
> +
> +my sub used_slots {
> +    my ($state) = @_;
> +
> +    my $used = {};
> +    for my $holder (values $state->{holders}->%*) {
> +        $used->{$_}++ for $holder->{resources}->@*;
> +    }
> +    return $used;
> +}
> +
> +my sub remove_entries {
> +    my ($state, $match) = @_;
> +
> +    my $count = 0;
> +    for my $entries ($state->@{qw(holders waiters)}) {
> +        for my $key (keys $entries->%*) {
> +            next if !$match->($entries->{$key});
> +            delete $entries->{$key};
> +            $count++;
> +        }
> +    }
> +    return $count;
> +}
> +
> +# Moves waiters that fit into all limits they count against to the holders, oldest first. Only
> +# resources with a limit matter, the others are tracked for information. Waiters of offline nodes
> +# neither get granted nor hold up others.
> +sub grant_waiters {
> +    my ($state, $limits, $members) = @_;
> +
> +    remove_entries($state, sub { !$members->{ $_[0]->{node} } });
> +
> +    my $used = used_slots($state);
> +
> +    my $waiters = $state->{waiters};
> +    for my $key (sort { $waiters->{$a}->{seq} <=> $waiters->{$b}->{seq} } keys $waiters->%*) {
> +        my $waiter = $waiters->{$key};
> +        next if !$members->{ $waiter->{node} }->{online};
> +
> +        my $limited = [grep { defined($limits->{$_}) } $waiter->{resources}->@*];
> +        next if grep { ($used->{$_} // 0) >= $limits->{$_} } $limited->@*;
> +
> +        $used->{$_}++ for $waiter->{resources}->@*;
> +        $state->{holders}->{$key} = delete $waiters->{$key};
> +        $state->{holders}->{$key}->{granted} = time();
> +    }
> +}
> +
> +my sub update_state {
> +    my ($code) = @_;
> +
> +    my $res = PVE::Cluster::cfs_lock_domain(
> +        'backup-slots',
> +        10,
> +        sub {
> +            my $json = JSON->new->canonical();
> +
> +            my $state = read_state();
> +            my $previous = $json->encode($state);
> +
> +            my $res = $code->($state);
> +            grant_waiters($state, limits(), get_members());
> +
> +            my $raw = $json->encode($state);
> +            PVE::Tools::file_set_contents($state_file, $raw) if $raw ne $previous;

Nit: could use PVE::File

> +
> +            return $res;
> +        },
> +    );
> +    die $@ if $@;
> +
> +    return $res;
> +}
> +
> +sub request {
> +    my ($upid, $vmid, $resources) = @_;
> +
> +    my $node = PVE::INotify::nodename();
> +    my $key = "$node/$vmid/$upid";
> +
> +    update_state(sub {
> +        my ($state) = @_;
> +        return if $state->{holders}->{$key} || $state->{waiters}->{$key};
> +
> +        $state->{waiters}->{$key} = {
> +            node => $node,
> +            upid => $upid,
> +            vmid => $vmid,
> +            resources => $resources,
> +            seq => ++$state->{seq},
> +            queued => time(),
> +        };
> +    });
> +
> +    return $key;
> +}
> +
> +# Returns 1 if granted, 0 if still waiting and undef if the request vanished.
> +sub granted {
> +    my ($key) = @_;
> +
> +    my $state = read_state();
> +    return 1 if $state->{holders}->{$key};
> +    return 0 if $state->{waiters}->{$key};
> +    return undef;
> +}
> +
> +# Grants waiters that fit by now, for example after limits got raised.
> +sub refresh {
> +    update_state(sub { });
> +}
> +
> +sub release {
> +    my ($key) = @_;
> +
> +    update_state(sub {
> +        my ($state) = @_;
> +        delete $state->{$_}->{$key} for qw(holders waiters);
> +    });
> +}
> +
> +# Removes the entries of this node whose guest backup is gone, as told by $running->($vmid, $upid).
> +sub cleanup_local_entries {
> +    my ($running) = @_;
> +
> +    my $node = PVE::INotify::nodename();
> +
> +    my $stale = sub {
> +        my ($entry) = @_;
> +        return $entry->{node} eq $node && !$running->($entry->{vmid}, $entry->{upid});
> +    };
> +
> +    # avoid the cluster lock if there is nothing to remove
> +    return if !remove_entries(read_state(), $stale);
> +
> +    update_state(sub {
> +        my ($state) = @_;
> +        remove_entries($state, $stale);
> +    });
> +}
> +
> +1;
> diff --git a/PVE/VZDump/Makefile b/PVE/VZDump/Makefile
> new file mode 100644
> index 000000000..6500eb4d4
> --- /dev/null
> +++ b/PVE/VZDump/Makefile
> @@ -0,0 +1,15 @@
> +include ../../defines.mk
> +
> +PERLSOURCE =   \
> +	ClusterSlots.pm \
> +
> +all:
> +
> +.PHONY: clean
> +clean:
> +	rm -rf *~
> +
> +.PHONY: install
> +install: $(PERLSOURCE)
> +	install -d $(PERLLIBDIR)/PVE/VZDump
> +	install -m 0644 $(PERLSOURCE) $(PERLLIBDIR)/PVE/VZDump
> diff --git a/test/Makefile b/test/Makefile
> index 1eb94f4e0..d51095978 100644
> --- a/test/Makefile
> +++ b/test/Makefile
> @@ -18,7 +18,7 @@ replication%.t: replication_test%.pl
>  	./$<
>  
>  .PHONY: test-vzdump
> -test-vzdump: test-vzdump-guest-included test-vzdump-new test-vzdump-concurrency
> +test-vzdump: test-vzdump-guest-included test-vzdump-new test-vzdump-concurrency test-vzdump-cluster-slots
>  
>  .PHONY: test-vzdump-guest-included
>  test-vzdump-guest-included:
> @@ -32,6 +32,10 @@ test-vzdump-new:
>  test-vzdump-concurrency:
>  	./vzdump_concurrency_test.pl
>  
> +.PHONY: test-vzdump-cluster-slots
> +test-vzdump-cluster-slots:
> +	./vzdump_cluster_slots_test.pl
> +
>  .PHONY: test-osd
>  test-osd:
>  	./OSD_test.pl
> diff --git a/test/vzdump_cluster_slots_test.pl b/test/vzdump_cluster_slots_test.pl
> new file mode 100755
> index 000000000..85608b5be
> --- /dev/null
> +++ b/test/vzdump_cluster_slots_test.pl
> @@ -0,0 +1,194 @@
> +#!/usr/bin/perl
> +
> +use strict;
> +use warnings;

Nit: could use v5.36


I didn't get around to finish the review of the series, but consider the
patches, where I left no reply or only nits as Reviewed-by me