From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from gate001.proxmox.com (gate001.proxmox.com [IPv6:2a0f:8001:1:32::40]) by lore.proxmox.com (Postfix) with ESMTPS id 903CD1FF0AF for ; Thu, 10 Sep 2026 16:24:41 +0200 (CEST) Received: from gate001.proxmox.com (localhost.localdomain [127.0.0.1]) by gate001.proxmox.com (Proxmox) with ESMTP id 6EF26215D0; Thu, 10 Sep 2026 16:24:36 +0200 (CEST) Message-ID: <13cfa96c-cf55-4d94-a05a-0326e528106b@proxmox.com> Date: Thu, 10 Sep 2026 16:24:24 +0200 MIME-Version: 1.0 User-Agent: Mozilla Thunderbird Subject: Re: [PATCH qemu-server 1/6] tests: hotplug: add initial hotplug test harness To: Dominik Csapak , pve-devel@lists.proxmox.com References: <20260910110832.2822954-1-d.csapak@proxmox.com> <20260910110832.2822954-2-d.csapak@proxmox.com> Content-Language: en-US From: Fiona Ebner In-Reply-To: <20260910110832.2822954-2-d.csapak@proxmox.com> Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 7bit X-Bm-Milter-Handled: 55990f41-d878-4baa-be0a-ee34c49e34d2 X-Bm-Transport-Timestamp: 1789050255512 X-SPAM-LEVEL: Spam detection results: 0 AWL -0.364 Adjusted score from AWL reputation of From: address DMARC_MISSING 0.1 Missing DMARC policy KAM_DMARC_STATUS 0.01 Test Rule for DKIM or SPF Failure with Strict Alignment (newer systems) KAM_MAILER 2 Automated Mailer Tag Left in Email RCVD_IN_DNSWL_MED -2.3 Sender listed at https://www.dnswl.org/, medium trust SPF_HELO_NONE 0.001 SPF: HELO does not publish an SPF Record SPF_PASS -0.001 SPF: sender matches SPF record Message-ID-Hash: MM6AFGN7HS33FUNYC6OE7BPH2UQK5CAF X-Message-ID-Hash: MM6AFGN7HS33FUNYC6OE7BPH2UQK5CAF X-MailFrom: f.ebner@proxmox.com X-Mailman-Rule-Misses: dmarc-mitigation; no-senders; approved; loop; banned-address; emergency; member-moderation; nonmember-moderation; administrivia; implicit-dest; max-recipients; max-size; news-moderation; no-subject; digests; suspicious-header X-Mailman-Version: 3.3.10 Precedence: list List-Id: Proxmox VE development discussion List-Help: List-Owner: List-Post: List-Subscribe: List-Unsubscribe: Am 10.09.26 um 1:09 PM schrieb Dominik Csapak: > diff --git a/src/test/CommandLineMocks.pm b/src/test/CommandLineMocks.pm > new file mode 100644 > index 00000000..a5883073 > --- /dev/null > +++ b/src/test/CommandLineMocks.pm > @@ -0,0 +1,556 @@ > +package CommandLineMocks; > + > +# Mocks for generating the QEMU command line of a VM config in tests, shared > +# between the test scripts for the command line itself and for hotplugging. The > +# environment (storage configuration, PCI devices, mappings, ...) is fixed, > +# while a few properties of the host can be set per test via set_test_env(). > +# Also contains helpers that are useful and needed by multiple test harnesses. > + > +use v5.36; > + Missing include for File::Temp used by diff(), but I'm suggesting moving that to its own module, see below. > +use JSON qw(decode_json); > +use Socket qw(AF_INET AF_INET6); > +use Test::MockModule; > + > +use PVE::INotify; > +use PVE::Mapping::PCI; > +use PVE::Mapping::USB; > +use PVE::ProcFSTools; > +use PVE::QemuServer::CPUConfig; > +use PVE::QemuServer::Drive; > +use PVE::QemuServer::Helpers; > +use PVE::QemuServer::Memory; > +use PVE::QemuServer::OVMF; > +use PVE::QemuServer::PCI; > +use PVE::QemuServer; > +use PVE::Storage::RBDPlugin; > +use PVE::Storage::ZFSPlugin; > +use PVE::Storage; > +use PVE::SysFSTools; > +use PVE::Tools qw(run_command); > + > +use base 'Exporter'; > + > +our @EXPORT_OK = qw( > + get_storage_config > + get_test_qemu_version > + set_test_env > + diff > +); > + > +my $real_qemu_version = PVE::QemuServer::Helpers::kvm_user_version(); # not yet mocked I know this is copied, but I think we should remove the comment. Individual tests can already mock the binary version and for the others, we do intentionally use the installed QEMU binary to see changes. > + > +# the properties of the host for the current test, see set_test_env() > +my $test_env = {}; > + > +# The mocker objects need to stay alive for the mocks to stay in effect. File-scoped lexicals of a > +# module are freed after loading it, so package variables are used for them. I'd move this comment to below where the mock objects are defined. Maybe also mention that this is about the 'our'. ---snip 8<--- > +sub diff($expected, $got) { > + return if $expected eq $got; > + > + my $tmp = File::Temp->new(); > + print $tmp $expected; > + $tmp->flush(); > + > + my $diff = ''; > + run_command( > + ['diff', '-up', '--label', 'expected', $tmp->filename(), '--label', 'got', '-'], > + input => $got, > + outfunc => sub { $diff .= "$_[0]\n"; }, > + noerr => 1, > + ); > + > + return $diff; > +} The diff helper might be even better in a dedicated module. Could also be re-used by run_parse_config_tests.pl then and avoid writing the output file there. ---snip 8<--- > diff --git a/src/test/run_hotplug_tests.pl b/src/test/run_hotplug_tests.pl > new file mode 100644 > index 00000000..0cfeb350 > --- /dev/null > +++ b/src/test/run_hotplug_tests.pl > @@ -0,0 +1,780 @@ > +#!/usr/bin/perl > + > +# Regression tests for applying pending changes to a running VM via hotplug. > +# > +# Each test is a VM config in 'hotplug/*.conf' with the changes to apply in a [PENDING] section. The > +# monitor of the VM is mocked with a minimal model of a running QEMU instance, that tracks the > +# present devices, buses, block nodes, backends and QOM objects and enforces the constraints between > +# them. Every monitor command and every host-side action (network, SDN, storage, cgroup) that is > +# issued while applying the pending changes is recorded. Afterwards, the model is compared to the > +# model of a VM freshly started with the resulting config, which is what the target of a live > +# migration is, to detect deviations like differing PCI addresses or left-over devices. The > +# recording, the resulting hotplug errors, the differences and the resulting VM config are compared > +# to the corresponding 'hotplug/*.conf.expected' file. If that file does not exist yet, it is > +# generated and needs to be manually verified. Tests for an aarch64 host are in 'hotplug/aarch64/'. > + > +use v5.36; > + > +use lib qw(.. .); > + > +# the hotplug helpers wait between retries when verifying (un)plugged devices, do not wait in tests > +BEGIN { > + *CORE::GLOBAL::sleep = sub { return 0; }; > +} Why is this necessary in the tests? We control whether adding or removing a device works in the tests, so I feel like this sweeps something under the rug that we could improve in qemu-server. Does qemu-server (sometimes) call {add,del}verify() when {add,del}() failed? > + > +use JSON; > +use Storable qw(dclone); > +use Test::More; > +use Test::MockModule; > + > +use PVE::File qw(file_get_contents file_set_contents); > +use PVE::QemuConfig; > +use PVE::QemuServer; > +use PVE::QemuServer::Blockdev; > +use PVE::QemuServer::CGroup; > +use PVE::QemuServer::CPUConfig; > +use PVE::QemuServer::Drive; > +use PVE::QemuServer::DriveDevice; > +use PVE::QemuServer::Helpers; > +use PVE::QemuServer::Machine; > +use PVE::QemuServer::Monitor; > +use PVE::QemuServer::Network; > +use PVE::Storage; Nit: does not follow the style guide: https://pve.proxmox.com/wiki/Perl_Style_Guide#Module_Dependencies > + > +# the mocks for generating the command line of a VM, shared with the cfg2cmd tests > +use CommandLineMocks qw(get_storage_config get_test_qemu_version set_test_env diff); > + > +my $vmid = 8006; > +my $fake_config_fn = "hotplug/qemu-server/$vmid.conf"; > + > +my $storecfg = get_storage_config(); > + > +my $current_test; # = { > +# testname => 'file name and description', > +# description => 'Test description', # if available > +# qemu_version => '10.1', > +# host_arch => 'x86_64', > +# fail_device_add => { deviceid => 1 }, > +# fail_device_del => { deviceid => 1 }, > +# fail_command => { command => 1 }, > +# config => { config hash }, > +# }; > + > +# The model of the running QEMU instance, set up from the command line that config_to_command() > +# generates for the config. The number of online vCPUs and the present memory DIMMs are derived > +# from the 'cpuN' and 'dimmN' devices. Buses are derived from the machine type and the present > +# bridges and controllers. > +my $vm_state; # = { > +# machine => 'pc-i440fx-10.1+pve0', # the machine type of the running VM > +# buses => { bus => 1 }, # buses provided by the machine itself > +# devices => { qdev_id => { device options referencing buses and backends } }, > +# hotplugged => { qdev_id => 1 }, # devices that were added during the test > +# netdevs => { netdev_id => 1 }, > +# chardevs => { chardev_id => 1 }, > +# drives => { drive_id => 1 }, # legacy '-drive' backends (machine version < 10.0) > +# blocknodes => { node_name => 1 }, # explicitly added block nodes (machine version >= 10.0) > +# objects => { object_id => { arguments of object-add } }, # QOM objects > +# }; > + > +my $log; # all recorded actions of the current test $recorded_actions = []; ? > + > +# use the config description to describe the test and the state of the running VM, fields are: > +# TEST: A single line describing the test, gets outputted > +# QEMU_VERSION: \d+\.\d+(\.\d+)? version of the running QEMU binary (defaults to current version) > +# HOST_ARCH: x86_64 | aarch64 (default to x86_64, to make tests stable) > +# FAIL_DEVICE_ADD: QEMU accepts 'device_add' for this device, but it never shows up > +# FAIL_DEVICE_DEL: QEMU accepts 'device_del' for this device, but it never goes away > +# FAIL_COMMAND: the QMP or HMP command with this name fails > +# all fields are optional, the last three can be specified multiple times > +sub parse_test($config_fn) { > + $current_test = { > + fail_device_add => {}, > + fail_device_del => {}, > + fail_command => {}, > + }; > + > + my $config_raw = file_get_contents($config_fn); > + my $config = PVE::QemuServer::parse_vm_config($fake_config_fn, $config_raw); > + > + $current_test->{config} = $config; > + > + my $description = $config->{description} // ''; > + > + while ($description =~ /^\h*(.*?)\h*$/gm) { > + my $line = $1; > + next if !$line || $line =~ /^#/; > + > + if ($line =~ /^TEST:\s*(.*)\s*$/) { > + $current_test->{description} = "$1"; > + } elsif ($line =~ /^QEMU_VERSION:\s*(.*)\s*$/) { > + $current_test->{qemu_version} = "$1"; > + } elsif ($line =~ /^HOST_ARCH:\s*(.*)\s*$/) { > + $current_test->{host_arch} = "$1"; > + } elsif ($line =~ /^FAIL_DEVICE_ADD:\s*(\S+)\s*$/) { > + $current_test->{fail_device_add}->{$1} = 1; > + } elsif ($line =~ /^FAIL_DEVICE_DEL:\s*(\S+)\s*$/) { > + $current_test->{fail_device_del}->{$1} = 1; > + } elsif ($line =~ /^FAIL_COMMAND:\s*(\S+)\s*$/) { > + $current_test->{fail_command}->{$1} = 1; > + } > + } > + > + # the description only describes the test and is not part of the resulting config > + delete $config->{description}; > + > + $config_fn =~ /([^\/]+)$/; > + my $testname = "$1"; > + if (my $desc = $current_test->{description}) { > + $testname = "'$testname' - $desc"; > + } > + $current_test->{testname} = $testname; > + > + set_test_env($current_test); > + > + # the 'host' CPU model is registered for the host architecture of the current test > + PVE::QemuServer::CPUConfig::initialize_cpu_models(); > +} > + > +# The buses a machine provides on its own. Everything else (PCI bridges, SCSI and USB controllers) > +# comes from devices on the command line or from the config files read via -readconfig. > +sub machine_buses($conf, $machine) { default_buses_for_machine(). Can't we somehow get this from qemu-server? I'd like to avoid the need to duplicate/hard-code this here. > + return { map { $_ => 1 } qw(pcie.0) } if $machine =~ m/^virt/; > + return { map { $_ => 1 } ('pcie.0', map { "ide.$_" } 0 .. 5) } > + if PVE::QemuServer::Machine::machine_type_is_q35($conf); > + return { map { $_ => 1 } qw(pci.0 ide.0 ide.1) }; > +} > + > +# Parse a comma separated option string like 'driver,id=x,bus=y' into a hash. A leading value > +# without key is stored under $first_key. > +sub parse_options($string, $first_key = undef) { > + my $options = {}; > + for my $part (split(/,/, $string)) { > + if ($part =~ m/^([^=]+)=(.*)$/) { > + $options->{$1} = $2; > + } elsif (defined($first_key)) { > + $options->{$first_key} = $part; > + } > + } > + return $options; > +} > + > +# Parse the devices from a QEMU config file (-readconfig), which is shipped in 'usr/' of the repo. > +sub parse_readconfig($path) { > + my ($name) = $path =~ m|([^/]+)$|; > + my $devices = {}; > + my $current; > + for my $line (split(/\n/, file_get_contents("../usr/$name"))) { > + if ($line =~ m/^\[device "([^"]+)"\]/) { > + $current = $devices->{$1} = { id => $1 }; > + } elsif ($line =~ m/^\[/) { > + $current = undef; > + } elsif ($current && $line =~ m/^\s*(\S+)\s*=\s*"([^"]*)"/) { > + $current->{$1} = $2; > + } > + } > + return $devices; > +} > + > +# QEMU resolves the unversioned aliases 'pc', 'q35' and 'virt' to the versioned default machine of > +# the running binary, which is also what query-machines reports for the running VM. The pve version > +# is kept as it was requested on the command line. > +sub resolve_machine_alias($machine) { Can't you use the windows_get_pinned_machine_version() function here? I'd like to avoid duplicate fucntions for things that already exist. We could also drop the 'windows_' prefix if we want, the function itself is not concerned with that, we just use it only for Windows. > + my ($type, $pve_version) = split(/\+/, $machine, 2); > + my $aliases = { pc => 'pc-i440fx', q35 => 'pc-q35', virt => 'virt' }; > + if (my $prefix = $aliases->{$type}) { > + my ($version) = get_test_qemu_version() =~ m/^(\d+\.\d+)/; > + $type = "$prefix-$version"; > + } > + return defined($pve_version) ? "$type+$pve_version" : $type; > +} > + > +# Returns the model of a VM freshly started with the given config, derived from the command line > +# that config_to_command() generates for it. > +sub vm_state_from_config($conf) { > + my $cmd = PVE::QemuServer::config_to_command( > + $storecfg, $vmid, dclone($conf), PVE::QemuServer::load_defaults(), {}, > + ); > + > + my $state = { > + machine => resolve_machine_alias(PVE::QemuServer::Machine::get_vm_machine($conf)), > + devices => {}, > + hotplugged => {}, > + netdevs => {}, > + chardevs => {}, > + drives => {}, > + blocknodes => {}, > + objects => {}, > + }; I don't like that we need to try to re-implement QEMU comamndline parsing, even if with reduced scope :/ Ideally, we could get the collected info from cfg2cmd before it prints it out. But yeah, we are not there yet.. > + > + for (my $i = 0; $i < scalar($cmd->@*) - 1; $i++) { > + my ($opt, $arg) = $cmd->@[$i, $i + 1]; > + if ($opt eq '-machine') { > + $state->{machine} = resolve_machine_alias(parse_options($arg)->{type}); > + } elsif ($opt eq '-device') { > + my $device = parse_options($arg, 'driver'); > + $state->{devices}->{ $device->{id} } = $device if $device->{id}; > + } elsif ($opt eq '-readconfig') { > + my $devices = parse_readconfig($arg); > + $state->{devices}->{$_} = $devices->{$_} for keys $devices->%*; > + } elsif ($opt eq '-netdev') { > + $state->{netdevs}->{ parse_options($arg)->{id} } = 1; > + } elsif ($opt eq '-chardev') { > + $state->{chardevs}->{ parse_options($arg, 'backend')->{id} } = 1; > + } elsif ($opt eq '-drive') { > + $state->{drives}->{ parse_options($arg)->{id} } = 1; > + } elsif ($opt eq '-blockdev') { > + $state->{blocknodes}->{ decode_json($arg)->{'node-name'} } = 1; > + } elsif ($opt eq '-object') { > + my $object = $arg =~ m/^\{/ ? decode_json($arg) : parse_options($arg, 'qom-type'); > + # sizes on the command line have a unit, QMP uses bytes > + if (defined($object->{size}) && $object->{size} =~ m/^(\d+)([MG])$/) { > + $object->{size} = $1 * 1024 * 1024 * ($2 eq 'G' ? 1024 : 1); > + } > + $state->{objects}->{ $object->{id} } = $object; > + } > + } > + > + $state->{buses} = machine_buses($conf, $state->{machine}); > + > + return $state; > +} > + > +sub setup_vm_state($conf) { > + $vm_state = vm_state_from_config($conf); > +} > + > +# Throttle limits set via QMP contain all properties, while the throttle group generated for the > +# command line only contains the configured ones. Drop the defaults to make them comparable. > +sub normalized_object($object) { Nit: Name is a bit confusing in the sense that it only does something for the very specific throttle-group case. We could also inject the implicit defaults when we extract the info from the commandline. But no big deal. > + $object = dclone($object); > + if (($object->{'qom-type'} // '') eq 'throttle-group' && $object->{limits}) { > + my $limits = $object->{limits}; > + my $is_default = sub { $limits->{ $_[0] } == ($_[0] =~ m/-max-length$/ ? 1 : 0) }; > + $object->{limits} = > + { map { $_ => $limits->{$_} } grep { !$is_default->($_) } keys %$limits }; > + } > + return to_json($object, { canonical => 1 }); > +} > + > +# Compare the model of the running VM with the model of a VM freshly started with the resulting > +# config, like the target of a live migration is. Returns a list of the differences. The boot index > +# is not compared, as hotplugged devices are added without one. > +sub compare_with_fresh_vm($conf) { > + my $running = $vm_state; > + my $fresh = vm_state_from_config($conf); > + my @differences = (); > + > + my $compare_ids = sub { > + my ($kind, $running_ids, $fresh_ids) = @_; > + my $only_in = sub { > + my ($ids, $others, $desc) = @_; > + push @differences, "$kind $_: only present in $desc" > + for sort grep { !$others->{$_} } keys $ids->%*; > + }; > + $only_in->($running_ids, $fresh_ids, 'running VM'); > + $only_in->($fresh_ids, $running_ids, 'freshly started VM'); Style nit: I think this is hard to read. Maybe collect the keys from both and then do a normal loop? > + }; > + > + push @differences, "machine: running '$running->{machine}' vs fresh '$fresh->{machine}'" > + if $running->{machine} ne $fresh->{machine}; > + > + $compare_ids->('device', $running->{devices}, $fresh->{devices}); > + for my $id (sort grep { $fresh->{devices}->{$_} } keys $running->{devices}->%*) { > + my $running_device = $running->{devices}->{$id}; > + my $fresh_device = $fresh->{devices}->{$id}; > + my %options = map { $_ => 1 } keys $running_device->%*, keys $fresh_device->%*; > + delete $options{bootindex}; > + for my $option (sort keys %options) { > + my $running_value = $running_device->{$option} // ''; > + my $fresh_value = $fresh_device->{$option} // ''; > + push @differences, > + "device $id option $option: running '$running_value' vs fresh '$fresh_value'" > + if "$running_value" ne "$fresh_value"; > + } > + } > + > + $compare_ids->('object', $running->{objects}, $fresh->{objects}); > + for my $id (sort grep { $fresh->{objects}->{$_} } keys $running->{objects}->%*) { > + my $running_object = normalized_object($running->{objects}->{$id}); > + my $fresh_object = normalized_object($fresh->{objects}->{$id}); > + push @differences, "object $id: running $running_object vs fresh $fresh_object" > + if $running_object ne $fresh_object; > + } > + > + for my $kind (qw(netdev chardev drive blocknode)) { > + $compare_ids->($kind, $running->{"${kind}s"}, $fresh->{"${kind}s"}); > + } > + > + return @differences; > +} > + > +# Record an action with its arguments. HMP commands are recorded as the full command line. Arguments > +# of QMP commands are recorded as they are, for other actions all scalars are stringified to be > +# independent from the internal representation. > +sub record($layer, $action, @args) { record_action() It seems the difference is that for QMP additional args are discarded. So not sure about the recorded as they are and what the comment about the distinction with stringification means? Maybe there should be a dedicated helper for QMP if the signature is de-facto different rather than overloading it. > + my $line = "$layer $action"; > + if ($layer eq 'qmp') { > + $line .= ' ' . to_json($args[0], { canonical => 1 }); > + } elsif (scalar(@args)) { > + $line .= ' ' . to_json([@args], { canonical => 1 }); > + } > + push $log->@*, $line; > +} > + > +sub sorted_devices($regex = qr/./) { > + return sort grep { $_ =~ $regex } keys $vm_state->{devices}->%*; perlcritic complains: "return" statement followed by "sort" at line 325, column 5. Behavior is undefined if called in scalar context. (Severity: 5) > +} > + > +# Returns the ID of a device referencing the given backend via the given device option. > +sub device_using($option, $value) { Nit: maybe call it device_using_backend($type, $id)? We probably also want to extract the types of backends out of add_device() and check that it's one of these. Looking at the callers, an assert_backend_is_not_in_use() might be a better fit. > + my $devices = $vm_state->{devices}; > + my @users = grep { ($devices->{$_}->{$option} // '') eq $value } sort keys $devices->%*; > + return $users[0]; > +} > + > +sub bus_exists($bus) { bus_exists_in_vm_state > + return 1 if $vm_state->{buses}->{$bus}; > + return 1 if $bus =~ m/^pci\.\d+$/ && $vm_state->{devices}->{$bus}; # PCI bridge > + return 1 if $bus =~ m/^(.+)\.0$/ && $vm_state->{devices}->{$1}; # SCSI and USB controllers > + return 0; > +} > + > +# Check the constraints for adding the device with the given options. Returns an error message if > +# the device cannot be added, otherwise adds it and returns nothing. > +sub add_device($options) { Nit: I feel the signature with returning an error as a string instead of die-ing a bit strange. And there is still a 'die' in the very first line, so it's not consistent. > + my $id = $options->{id} or die "device_add without ID\n"; > + my $driver = $options->{driver}; > + > + return "Duplicate device ID '$id'" if $vm_state->{devices}->{$id}; > + return "simulated failure adding device '$id'" if $current_test->{fail_device_add}->{$id}; > + ---snip 8<--- > +# QMP commands that do not change the modeled state of the VM > +my $stateless_commands = { $qmp_command_does_not_change_state > + map { $_ => 1 } > + qw( > + balloon > + block_set_io_throttle > + blockdev-change-medium > + blockdev-close-tray > + blockdev-open-tray > + eject > + ) > +}; Sytle nit: I'd avoid the map and just have one 'key => 1,' per line like usual for prettier indentation. > + > +# Replacement for PVE::QemuServer::Monitor::qmp_cmd, handling all monitor communication with the VM. > +sub fake_qmp_cmd { Nit: I'd prefer s/fake/mocked/, also for the other functions. > + my ($peer, $execute, %arguments) = @_; > + > + die "unexpected QMP peer '$peer->{name}' of type '$peer->{type}'\n" > + if $peer->{type} ne 'qmp' || $peer->{id} != $vmid; > + > + delete $arguments{timeout}; > + my $noerr = delete $arguments{noerr}; > + > + return fake_hmp_cmd($arguments{'command-line'}) if $execute eq 'human-monitor-command'; > + > + # queries do not change the state of the VM and are not recorded > + if (my $result = fake_qmp_query($execute, \%arguments)) { > + return $result; > + } > + > + record('qmp', $execute, \%arguments); > + > + my $fail = sub { > + my ($msg) = @_; > + return { error => $msg } if $noerr; > + die "$msg\n"; > + }; Alternatively, there could be a wrapper, so you could regularly die in the actual implementation and the wrapper translates it later. This would avoid the unusual 'return $fail->()' pattern to improve readability. > + > + return $fail->("simulated failure of QMP command '$execute'") > + if $current_test->{fail_command}->{$execute}; > + > + return {} if $stateless_commands->{$execute}; > + > + my $id = $arguments{id}; > + my $node_name = $arguments{'node-name'}; > + my $devices = $vm_state->{devices}; > + > + if ($execute eq 'device_add') { # the QMP variant is only used for memory DIMMs Right now, but this comment will just get outdated when it changes. Is there a special rationale for adding it? > + my $err = add_device(\%arguments); > + return $fail->($err) if $err; > + } elsif ($execute eq 'netdev_add') { > + return $fail->("Duplicate ID '$id' for netdev") if $vm_state->{netdevs}->{$id}; > + $vm_state->{netdevs}->{$id} = 1; > + } elsif ($execute eq 'netdev_del') { > + return $fail->("Device '$id' not found") if !$vm_state->{netdevs}->{$id}; > + if (my $device = device_using('netdev', $id)) { > + return $fail->("netdev '$id' is in use by device '$device'"); > + } > + delete $vm_state->{netdevs}->{$id}; > + } elsif ($execute eq 'set_link') { > + my $name = $arguments{name}; > + return $fail->("Device '$name' not found") > + if !$devices->{$name} && !$vm_state->{netdevs}->{$name}; > + } elsif ($execute eq 'chardev-add') { > + return $fail->("Duplicate ID '$id' for chardev") if $vm_state->{chardevs}->{$id}; > + $vm_state->{chardevs}->{$id} = 1; > + } elsif ($execute eq 'object-add') { > + return $fail->("Duplicate object ID '$id'") if $vm_state->{objects}->{$id}; > + $vm_state->{objects}->{$id} = \%arguments; > + } elsif ($execute eq 'object-del') { > + return $fail->("Object '$id' not found") if !$vm_state->{objects}->{$id}; > + for my $option (qw(iothread memdev)) { > + if (my $device = device_using($option, $id)) { > + return $fail->("Object '$id' is in use by device '$device'"); > + } > + } > + # the top block node of a drive uses the throttle group with the same name > + if (my ($node) = $id =~ m/^throttle-(drive-.+)$/) { > + return $fail->("Object '$id' is in use by node '$node'") > + if $vm_state->{blocknodes}->{$node}; > + } > + delete $vm_state->{objects}->{$id}; > + } elsif ($execute eq 'qom-set') { # only used for the limits of throttle groups Same as above. Right now it's only used for that. But this comment will just get outdated when that changes. > + my $object = $vm_state->{objects}->{ $arguments{path} } > + or return $fail->("Object '$arguments{path}' not found"); > + $object->{ $arguments{property} } = $arguments{value}; > + } elsif ($execute eq 'blockdev-add') { > + return $fail->("Duplicate nodes with node-name='$node_name'") > + if $vm_state->{blocknodes}->{$node_name}; > + $vm_state->{blocknodes}->{$node_name} = 1; > + } elsif ($execute eq 'blockdev-del') { > + return $fail->("Failed to find node with node-name='$node_name'") > + if !$vm_state->{blocknodes}->{$node_name}; > + if (my $device = device_using('drive', $node_name)) { > + return $fail->("Node '$node_name' is in use by device '$device'"); > + } > + delete $vm_state->{blocknodes}->{$node_name}; > + } elsif ($execute eq 'blockdev-remove-medium') { > + return $fail->("Device '$id' not found") if !$devices->{$id}; > + delete $devices->{$id}->{drive}; > + } elsif ($execute eq 'blockdev-insert-medium') { > + return $fail->("Device '$id' not found") if !$devices->{$id}; > + return $fail->("Node '$node_name' not found") if !$vm_state->{blocknodes}->{$node_name}; > + $devices->{$id}->{drive} = $node_name; > + } else { > + die "unexpected QMP command: '$execute'\n"; > + } > + > + return {}; > +} > + > +my $monitor_module = Test::MockModule->new('PVE::QemuServer::Monitor'); > +$monitor_module->mock(qmp_cmd => \&fake_qmp_cmd); > + > +# qmp_cmd is imported by these modules, so the imported copies need to be replaced too > +my $qemu_server_module = Test::MockModule->new('PVE::QemuServer'); > +$qemu_server_module->mock(qmp_cmd => \&fake_qmp_cmd); > + > +my $blockdev_module = Test::MockModule->new('PVE::QemuServer::Blockdev'); > +$blockdev_module->mock(qmp_cmd => \&fake_qmp_cmd); > + > +# the machine type of the running VM is derived from the QEMU version, so it has to be the mocked > +# one everywhere, not only for the imported copy in PVE::QemuServer > +my $qemu_server_helpers = Test::MockModule->new('PVE::QemuServer::Helpers'); > +$qemu_server_helpers->mock( > + kvm_user_version => \&get_test_qemu_version, > + vm_running_locally => sub { > + return 1; > + }, > +); > + > +my $drive_device_module = Test::MockModule->new('PVE::QemuServer::DriveDevice'); > +$drive_device_module->mock(kvm_user_version => \&get_test_qemu_version); > + > +my $qemu_server_config = Test::MockModule->new('PVE::QemuConfig'); > +$qemu_server_config->mock( > + write_config => sub { > + my ($class, $vmid, $conf) = @_; > + return; > + }, The test does not model reality anymore if there ever is a write followed by a load. Should we mock load_config and die there, so we notice (or if necessary remember the written config in a variable)? > +); > +