blockdev: introduce and use get_block_info() helper

When querying the block info, with -blockdev, it is necessary to look
at the 'qdev' property of the QMP result, because the 'device'
property is not initialized. See also commit 9af3ef69 ("vm devices
list: prepare querying block device names for -blockdev").

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

src/PVE/QemuServer.pm

@@ -5732,14 +5732,13 @@ sub vm_start_nolock {
             $migrate_storage_uri = "nbd:${localip}:${storage_migrate_port}";
         }
 
-        my $block_info = mon_cmd($vmid, "query-block");
-        $block_info = { map { $_->{device} => $_ } $block_info->@* };
+        my $block_info = PVE::QemuServer::Blockdev::get_block_info($vmid);
 
         foreach my $opt (sort keys %$nbd) {
             my $drivestr = $nbd->{$opt}->{drivestr};
             my $volid = $nbd->{$opt}->{volid};
 
-            my $block_node = $block_info->{"drive-$opt"}->{inserted}->{'node-name'};
+            my $block_node = $block_info->{$opt}->{inserted}->{'node-name'};
 
             mon_cmd(
                 $vmid,

src/PVE/QemuServer/Blockdev.pm

@@ -58,6 +58,43 @@ sub qdev_id_to_drive_id {
     return $qdev_id; # for SCSI/SATA/IDE it's the same
 }
 
+=pod
+
+=head3 get_block_info
+
+    my $block_info = get_block_info($vmid);
+    my $inserted = $block_info->{$drive_key}->{inserted};
+    my $node_name = $inserted->{'node-name'};
+    my $block_node_size = $inserted->{image}->{'virtual-size'};
+
+Returns a hash reference with the information from the C<query-block> QMP command indexed by
+configuration drive keys like C<scsi2>. See the QMP documentation for details.
+
+Parameters:
+
+=over
+
+=item C<$vmid>: The ID of the virtual machine to query.
+
+=back
+
+=cut
+
+sub get_block_info {
+    my ($vmid) = @_;
+
+    my $block_info = {};
+
+    my $qmp_block_info = mon_cmd($vmid, "query-block");
+    for my $info ($qmp_block_info->@*) {
+        my $qdev_id = $info->{qdev} or next;
+        my $drive_id = qdev_id_to_drive_id($qdev_id);
+        $block_info->{$drive_id} = $info;
+    }
+
+    return $block_info;
+}
+
 my sub get_node_name {
     my ($type, $drive_id, $volid, $options) = @_;
 

src/PVE/VZDump/QemuServer.pm

@@ -1122,14 +1122,13 @@ sub qga_fs_thaw {
 sub query_block_node_sizes {
     my ($self, $vmid, $disks) = @_;
 
-    my $block_info = mon_cmd($vmid, "query-block");
-    $block_info = { map { $_->{device} => $_ } $block_info->@* };
+    my $block_info = PVE::QemuServer::Blockdev::get_block_info($vmid);
 
     for my $diskinfo ($disks->@*) {
         my $drive_key = $diskinfo->{virtdev};
         $drive_key .= "-backup" if $drive_key eq 'tpmstate0';
         my $block_node_size =
-            eval { $block_info->{"drive-$drive_key"}->{inserted}->{image}->{'virtual-size'}; };
+            eval { $block_info->{$drive_key}->{inserted}->{image}->{'virtual-size'}; };
         if (!$block_node_size) {
             $self->loginfo(
                 "could not determine block node size of drive '$drive_key' - using fallback");

src/test/MigrationTest/QmMock.pm

@@ -43,6 +43,21 @@ sub fork_worker {
 
 # mocked modules
 
+my sub mocked_mon_cmd {
+    my ($vmid, $command, %params) = @_;
+
+    if ($command eq 'nbd-server-start') {
+        return;
+    } elsif ($command eq 'block-export-add') {
+        return;
+    } elsif ($command eq 'query-block') {
+        return [];
+    } elsif ($command eq 'qom-set') {
+        return;
+    }
+    die "mon_cmd (mocked) - implement me: $command";
+}
+
 my $inotify_module = Test::MockModule->new("PVE::INotify");
 $inotify_module->mock(
     nodename => sub {
@@ -50,6 +65,11 @@ $inotify_module->mock(
     },
 );
 
+my $qemu_server_blockdev_module = Test::MockModule->new("PVE::QemuServer::Blockdev");
+$qemu_server_blockdev_module->mock(
+    mon_cmd => \&mocked_mon_cmd,
+);
+
 my $qemu_server_helpers_module = Test::MockModule->new("PVE::QemuServer::Helpers");
 $qemu_server_helpers_module->mock(
     vm_running_locally => sub {
@@ -101,20 +121,7 @@ $MigrationTest::Shared::qemu_server_module->mock(
     config_to_command => sub {
         return ['mocked_kvm_command'];
     },
-    mon_cmd => sub {
-        my ($vmid, $command, %params) = @_;
-
-        if ($command eq 'nbd-server-start') {
-            return;
-        } elsif ($command eq 'block-export-add') {
-            return;
-        } elsif ($command eq 'query-block') {
-            return [];
-        } elsif ($command eq 'qom-set') {
-            return;
-        }
-        die "mon_cmd (mocked) - implement me: $command";
-    },
+    mon_cmd => \&mocked_mon_cmd,
     nodename => sub {
         return $nodename;
     },