Re: [PATCH ha-manager v4 13/27] crm command: support JSON-style migrate command

["Daniel Kral" <d.kral@proxmox.com>]

On Thu Oct 15, 2026 at 2:50 PM CEST, Fiona Ebner wrote:
> To pass along opaque migration options from the resource-specific
> migration API endpoint to the resource plugin implementation, the
> options will be encoded as JSON. Instead of just adding an extra
> positional argument with those, support having the full CRM command be
> recorded as JSON in the queued commands file.
>
> Signed-off-by: Fiona Ebner <f.ebner@proxmox.com>
> ---
>
> Changes in v4:
> * Encode JSON with canonical => 1.
> * Improve error messages.
>
>  src/PVE/HA/Manager.pm | 57 +++++++++++++++++++++++++++++++++++++------
>  1 file changed, 49 insertions(+), 8 deletions(-)
>
> diff --git a/src/PVE/HA/Manager.pm b/src/PVE/HA/Manager.pm
> index c28d7fa..4e7fab5 100644
> --- a/src/PVE/HA/Manager.pm
> +++ b/src/PVE/HA/Manager.pm
> @@ -711,6 +711,28 @@ my sub check_resource_motion_valid {
>      return 1;
>  }
>  
> +my sub handle_crm_motion_command {
> +    my ($self, $task, $sid, $node, $options) = @_;
> +
> +    my $cmd = "$task $sid $node";
> +
> +    if (defined($options) && scalar(keys($options->%*))) {
> +        $cmd .= ' ' . JSON::to_json($options, { canonical => 1 });
> +    }
> +
> +    my ($haenv, $ms, $ns, $sc, $ss) = $self->@{qw(haenv ms ns sc ss)};

nit: $ms, $ns, and $sc are unused here

> +
> +    if (my $sd = $ss->{$sid}) {
> +        if (check_resource_motion_valid($self, $node, $sd, "ignore crm command '$cmd'")) {
> +            $self->queue_resource_motion($cmd, $task, $sid, $node, $options);
> +        }
> +    } else {
> +        $haenv->log('err', "crm command error - no such service: $cmd");
> +    }
> +
> +    return;
> +}
> +
>  # read new crm commands and save them into crm master status
>  sub update_crm_commands {
>      my ($self) = @_;
> @@ -722,16 +744,35 @@ sub update_crm_commands {
>      foreach my $cmd (split(/\n/, $cmdlist)) {
>          chomp $cmd;
>  
> -        if ($cmd =~ m/^(migrate|relocate)\s+(\S+)\s+(\S+)$/) {
> -            my ($task, $sid, $node) = ($1, $2, $3);
> -            if (my $sd = $ss->{$sid}) {
> -                if (check_resource_motion_valid($self, $node, $sd, "ignore crm command '$cmd'")) {
> -                    $self->queue_resource_motion($cmd, $task, $sid, $node, {});
> -                }
> -            } else {
> -                $haenv->log('err', "crm command error - no such service: $cmd");
> +        if ($cmd =~ m/^{/) {
> +            # New-style JSON-encoded command. Currently only 'migrate' is supported, allowing for
> +            # additional options.
> +
> +            my $command_info = eval { JSON::decode_json($cmd) };
> +            if (my $err = $@) {
> +                $haenv->log('err', "unable to decode JSON command: '$cmd' - $err");
> +                next;
>              }
>  
> +            my $kind = $command_info->{kind};
> +            if (!defined($kind)) {
> +                $haenv->log('err', "unable to handle JSON command without 'kind': '$cmd'");
> +            } elsif ($kind eq 'migrate') {
> +                my ($sid, $node, $options) = $command_info->@{qw(sid node options)};
> +                if (!defined($sid) || !defined($node)) {
> +                    $haenv->log('err', "'migrate' JSON command without sid or node");
> +                    next;
> +                }
> +                handle_crm_motion_command($self, $kind, $sid, $node, $options);

nit: only noticed now, but 'kind' should probably also be 'task' here as
     we call it like that everywhere else... Even though with variants
     'kind' is more common, so no hard feelings here.

> +            } else {
> +                $haenv->log('err', "unable to handle unknown JSON command: '$cmd'");
> +            }
> +
> +            next;
> +        }
> +
> +        if ($cmd =~ m/^(migrate|relocate)\s+(\S+)\s+(\S+)$/) {

nit: should probably be an elsif here?

> +            handle_crm_motion_command($self, $1, $2, $3, {});
>          } elsif ($cmd =~ m/^stop\s+(\S+)\s+(\S+)$/) {
>              my ($sid, $timeout) = ($1, $2);
>              if (my $sd = $ss->{$sid}) {