Re: [PATCH qemu-server 1/6] tests: hotplug: add initial hotplug test harness

[Dominik Csapak <d.csapak@proxmox.com>]

On 9/10/26 4:24 PM, Fiona Ebner wrote:
> Am 10.09.26 um 1:09 PM schrieb Dominik Csapak:
[snip]>> +
>> +# 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?


The issue here is the hmp device_add call does not fail directly,
but returns the text (which can contain an error) so we always
call verify after (and when testing the hotplug issues etc. this is what
fails, not the device_add)

IMO in the long-term we should not use the hmp calls at all which would
clean this up a bit, but in the meantime not overriding the sleep here
just makes the tests longer for the variants where the adding fails..

Not sure what exactly can come back from a hmp call, so treating all
non-empty returned strings as an error has a bit of regression potential.


[snip]>> +
>> +# 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.
> 

aside from starting a vm and querying with qmp (which i think
is overkill) i'm not aware of any way how to get that info out
of qemu.

>> +    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) };
>> +}
>> +
[snip]
>> +
>> +# 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.
> 

it's hard because we get here the +pveX prefix sometimes, but
windows_get_pinned_machine_verions does not work with that, and possibly
adds one itself, so we'd have to check for that afterwards too

not sure this is worth it just to save on one extra aliias list?

i also don't see an obvious way to restructure the machine code
to achieve what we want here

basically we sometimes get here 'pc+pve0' but actually want
'pc-i440fx-X.Y+pve0'

I'll try though

[snip]
>> +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.

yep sounds better, we already modify the commandline things a bit in
that case.

> 
>> +    $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?

Sounds right

> 
>> +    };
>> +
>> +    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} // '<undef>';
>> +            my $fresh_value = $fresh_device->{$option} // '<undef>';
>> +            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.
> 

the comment was outdated, and for qmp only the first argument is filled
with the json we give to the backend.

will do a sepearte helper then


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

mhm not sure how to do that, because in case the caller uses 'noerr' we
just want to return the error instead of die'ing?

or do you mean just renaming and changing the signature?

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

This is only to simulate what the hmp calls do which also don't die but
return the error string

the die is there to prevent missuse of the arguments..

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

yes, this makes it a bit more readable as well and solves the problem
with the assert
> 
>> +
>> +    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)?

yep i just add a mock for it and 'die' there so we'll notice and
can decide how to proceed then.


> 
>> +);
>> +