[PATCH ha-manager v3 09/21] crm command: support JSON-style migrate command

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

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>
---

New in v3.

 src/PVE/HA/Manager.pm | 73 +++++++++++++++++++++++++++++++++----------
 1 file changed, 56 insertions(+), 17 deletions(-)

diff --git a/src/PVE/HA/Manager.pm b/src/PVE/HA/Manager.pm
index 555ea0d..25026d6 100644
--- a/src/PVE/HA/Manager.pm
+++ b/src/PVE/HA/Manager.pm
@@ -4,6 +4,7 @@ use strict;
 use warnings;
 
 use Digest::MD5 qw(md5_base64);
+use JSON qw();
 
 use PVE::Tools;
 
@@ -670,6 +671,36 @@ sub any_resource_motion_queued_or_running {
     return 0;
 }
 
+my sub crm_cmd_migrate_relocate {
+    my ($self, $task, $sid, $node, $options) = @_;
+
+    my $cmd = "$task $sid $node";
+
+    if (defined($options) && scalar(keys($options->%*))) {
+        $cmd .= ' ' . JSON::encode_json($options);
+    }
+
+    my ($haenv, $ms, $ns, $sc, $ss) = $self->@{qw(haenv ms ns sc ss)};
+
+    if (my $sd = $ss->{$sid}) {
+        if (!$ns->node_is_online($node)) {
+            $haenv->log('err', "crm command error - node not online: $cmd");
+        } else {
+            if ($node eq $sd->{node}) {
+                $haenv->log(
+                    'info', "ignore crm command - service already on target node: $cmd",
+                );
+            } else {
+                $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) = @_;
@@ -681,25 +712,33 @@ 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 (!$ns->node_is_online($node)) {
-                    $haenv->log('err', "crm command error - node not online: $cmd");
-                } else {
-                    if ($node eq $sd->{node}) {
-                        $haenv->log(
-                            'info',
-                            "ignore crm command - service already on target node: $cmd",
-                        );
-                    } else {
-                        $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 command as JSON: '$cmd' - $err");
+                next;
             }
 
+            my $kind = $command_info->{kind};
+            if (defined($kind) && $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;
+                }
+                crm_cmd_migrate_relocate($self, $kind, $sid, $node, $options);
+            } else {
+                $haenv->log('err', "unable to handle unknown JSON command: '$cmd'");
+            }
+
+            next;
+        }
+
+        if ($cmd =~ m/^(migrate|relocate)\s+(\S+)\s+(\S+)$/) {
+            crm_cmd_migrate_relocate($self, $1, $2, $3, {});
         } elsif ($cmd =~ m/^stop\s+(\S+)\s+(\S+)$/) {
             my ($sid, $timeout) = ($1, $2);
             if (my $sd = $ss->{$sid}) {
-- 
2.47.3