[PATCH qemu-server 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>
---
 src/PVE/API2/Qemu.pm           |  7 ++++--
 src/PVE/CLI/qm.pm              | 30 +++++++++++++++++++++++--
 src/PVE/QemuServer.pm          |  9 ++++++++
 src/PVE/QemuServer/BlockJob.pm | 40 ++++++++++++++++++++++++++++++++++
 4 files changed, 82 insertions(+), 4 deletions(-)

diff --git a/src/PVE/API2/Qemu.pm b/src/PVE/API2/Qemu.pm
index 28cbb9b0..7262c221 100644
--- a/src/PVE/API2/Qemu.pm
+++ b/src/PVE/API2/Qemu.pm
@@ -43,7 +43,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;
@@ -6957,7 +6956,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 9a53a4f2..af6b3170 100755
--- a/src/PVE/CLI/qm.pm
+++ b/src/PVE/CLI/qm.pm
@@ -428,8 +428,34 @@ __PACKAGE__->register_method({
 
         my $vmid = $param->{vmid};
 
-        eval { PVE::QemuServer::QMPHelpers::nbd_stop($vmid) };
-        warn $@ if $@;
+        my $obtained_lock;
+
+        eval {
+            PVE::QemuConfig->lock_config(
+                $vmid,
+                sub {
+                    $obtained_lock = 1;
+                    my $storecfg = PVE::Storage::config();
+                    my $conf = PVE::QemuConfig->load_config($vmid);
+                    eval {
+                        PVE::QemuServer::BlockJob::nbd_stop_after_mirror(
+                            $storecfg, $vmid, $conf,
+                        );
+                    };
+                    warn $@ if $@;
+                },
+            );
+        };
+        if (my $err = $@) {
+            if (!$obtained_lock) {
+                # Fall back to just stopping the NBD server without checking disks.
+                warn "nbdstop: failed to obtain lock, skipping disk check - $@\n";
+                eval { PVE::QemuServer::QMPHelpers::nbd_stop($vmid) };
+                warn $@ if $@;
+            } else {
+                die $err;
+            }
+        }
 
         return;
     },
diff --git a/src/PVE/QemuServer.pm b/src/PVE/QemuServer.pm
index 6b03e170..7470a4a1 100644
--- a/src/PVE/QemuServer.pm
+++ b/src/PVE/QemuServer.pm
@@ -5929,6 +5929,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'};
@@ -5940,6 +5944,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 bce350da..1cf9149e 100644
--- a/src/PVE/QemuServer/BlockJob.pm
+++ b/src/PVE/QemuServer/BlockJob.pm
@@ -619,4 +619,44 @@ sub mirror {
     }
 }
 
+sub nbd_stop_after_mirror {
+    my ($storecfg, $vmid, $conf) = @_;
+
+    my $exports = [];
+
+    my $machine_type = PVE::QemuServer::Machine::get_current_qemu_machine($vmid);
+    if (PVE::QemuServer::Machine::is_machine_version_at_least($machine_type, 10, 0)) {
+        eval { $exports = mon_cmd($vmid, 'query-block-exports'); };
+        log_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}'");
+        } elsif (!PVE::QemuServer::Drive::is_valid_drivename($opt)) {
+            warn("stop nbd: got unexpected export ID '$export->{id}' - not a drive key");
+        } else {
+            my $drive = PVE::QemuServer::Drive::parse_drive($opt, $conf->{$opt});
+            if (!$drive) {
+                warn("stop nbd: $opt: unable to parse drive '$conf->{$opt}'");
+                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 anways, 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