[PATCH qemu-server v2 9/9] partially fix #7836: allow migration for drive with read-only flag when using blockdev

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

A read-only block node cannot serve as a writeable block export for
the NBD mirror target. With -blockdev, the issue can be resolved by
re-opening the node below throttle as writeable, exporting it, and
then re-opening it as read-only after finishing the migration.

Signed-off-by: Fiona Ebner <f.ebner@proxmox.com>
---

Changes in v2:
* Improve error handling.
* Fix typo in comment.
* Terminate warning messages with newlines.

 src/PVE/API2/Qemu.pm           |  7 ++++--
 src/PVE/CLI/qm.pm              | 26 +++++++++++++++++++--
 src/PVE/QemuServer.pm          |  9 ++++++++
 src/PVE/QemuServer/BlockJob.pm | 42 ++++++++++++++++++++++++++++++++++
 4 files changed, 80 insertions(+), 4 deletions(-)

diff --git a/src/PVE/API2/Qemu.pm b/src/PVE/API2/Qemu.pm
index 7830d09b..15391ff0 100644
--- a/src/PVE/API2/Qemu.pm
+++ b/src/PVE/API2/Qemu.pm
@@ -48,7 +48,6 @@ use PVE::QemuServer::MetaInfo;
 use PVE::QemuServer::Network;
 use PVE::QemuServer::OVMF;
 use PVE::QemuServer::PCI;
-use PVE::QemuServer::QMPHelpers;
 use PVE::QemuServer::RNG;
 use PVE::QemuServer::RunState;
 use PVE::QemuServer::USB;
@@ -7145,7 +7144,11 @@ __PACKAGE__->register_method({
                     return;
                 },
                 'nbdstop' => sub {
-                    PVE::QemuServer::QMPHelpers::nbd_stop($state->{vmid});
+                    PVE::QemuServer::BlockJob::nbd_stop_after_mirror(
+                        $state->{storecfg},
+                        $state->{vmid},
+                        $state->{conf},
+                    );
                     return;
                 },
                 'resume' => sub {
diff --git a/src/PVE/CLI/qm.pm b/src/PVE/CLI/qm.pm
index c4f9c64b..f3f02ef8 100755
--- a/src/PVE/CLI/qm.pm
+++ b/src/PVE/CLI/qm.pm
@@ -428,8 +428,30 @@ __PACKAGE__->register_method({
 
         my $vmid = $param->{vmid};
 
-        eval { PVE::QemuServer::QMPHelpers::nbd_stop($vmid) };
-        warn $@ if $@;
+        my $need_nbd_stop = 1;
+
+        eval {
+            PVE::QemuConfig->lock_config(
+                $vmid,
+                sub {
+                    my $storecfg = PVE::Storage::config();
+                    my $conf = PVE::QemuConfig->load_config($vmid);
+                    $need_nbd_stop = 0; # nbd_stop_after_mirror() handles it.
+                    PVE::QemuServer::BlockJob::nbd_stop_after_mirror(
+                        $storecfg, $vmid, $conf,
+                    );
+                },
+            );
+        };
+        if (my $err = $@) {
+            warn $err;
+            if ($need_nbd_stop) {
+                # Fall back to just stopping the NBD server without checking disks.
+                warn "nbdstop: skipping disk check\n";
+                eval { PVE::QemuServer::QMPHelpers::nbd_stop($vmid) };
+                warn $@ if $@;
+            }
+        }
 
         return;
     },
diff --git a/src/PVE/QemuServer.pm b/src/PVE/QemuServer.pm
index 1f7cc79e..17bf88b3 100644
--- a/src/PVE/QemuServer.pm
+++ b/src/PVE/QemuServer.pm
@@ -5819,6 +5819,10 @@ sub vm_start_nolock {
             my $drivestr = $nbd->{$opt}->{drivestr};
             my $volid = $nbd->{$opt}->{volid};
 
+            my $drive = parse_drive($opt, $drivestr);
+            die "$opt: internal error - unable to parse drive '$drivestr'\n" if !$drive;
+            my $drive_is_readonly = $drive->{ro};
+
             my $top = $block_info->{$opt}->{inserted};
             die "no block node found for drive '$opt'\n" if !$top;
             my $block_node = $top->{'node-name'};
@@ -5830,6 +5834,11 @@ sub vm_start_nolock {
                 my $children = { map { $_->{child} => $_ } $top->{children}->@* };
                 $block_node = $children->{file}->{'node-name'}
                     or die "drive '$opt': throttle node without file child node name\n";
+
+                if ($drive_is_readonly) { # re-open the node below throttle as writeable
+                    my $reopen_opts = { 'no-throttle' => 1, 'read-only' => 0 };
+                    PVE::QemuServer::Blockdev::reopen($storecfg, $vmid, $drive, $reopen_opts);
+                }
             }
 
             mon_cmd(
diff --git a/src/PVE/QemuServer/BlockJob.pm b/src/PVE/QemuServer/BlockJob.pm
index bedcdc9d..fe87d976 100644
--- a/src/PVE/QemuServer/BlockJob.pm
+++ b/src/PVE/QemuServer/BlockJob.pm
@@ -614,4 +614,46 @@ sub mirror {
     }
 }
 
+sub nbd_stop_after_mirror {
+    my ($storecfg, $vmid, $conf) = @_;
+
+    my $exports = [];
+
+    eval {
+        my $machine_type = PVE::QemuServer::Machine::get_current_qemu_machine($vmid);
+        if (PVE::QemuServer::Machine::is_machine_version_at_least($machine_type, 10, 0)) {
+            $exports = mon_cmd($vmid, 'query-block-exports');
+        }
+    };
+    warn "stop nbd: unable to query block exports - $@" if $@;
+
+    PVE::QemuServer::QMPHelpers::nbd_stop($vmid);
+
+    for my $export ($exports->@*) {
+        my ($opt) = $export->{id} =~ m/^drive-(.*)$/;
+        if (!defined($opt)) {
+            warn "stop nbd: got unexpected export ID '$export->{id}'\n";
+        } elsif (!PVE::QemuServer::Drive::is_valid_drivename($opt)) {
+            warn "stop nbd: got unexpected export ID '$export->{id}' - not a drive key\n";
+        } else {
+            my $drive = PVE::QemuServer::Drive::parse_drive($opt, $conf->{$opt});
+            if (!$drive) {
+                warn "stop nbd: $opt: unable to parse drive '$conf->{$opt}'\n";
+                next;
+            }
+            if ($drive->{ro}) {
+                # The node below throttle was opened as writeable to be able to serve as a target
+                # NBD export for mirror. Re-open as read-only now. Failure is not too important,
+                # because the guest sees the drive as read-only anyways, because the top throttle
+                # node is.
+                my $reopen_opts = { 'no-throttle' => 1 };
+                eval { PVE::QemuServer::Blockdev::reopen($storecfg, $vmid, $drive, $reopen_opts); };
+                print "drive-$opt failed to re-apply read-only flag below throttle - $@\n" if $@;
+            }
+        }
+    }
+
+    return;
+}
+
 1;
-- 
2.47.3