create test environment for migration

and the associated parts for 'qm start'.

Each test will first populate the MigrationTest/run directory
with the relevant configuration files and files keeping track of the
state of everything necessary. Second, the mock-script for migration
is executed, which in turn will execute the 'qm start' mock-script
(if it's an online test that gets far enough). The scripts will simulate
a migration and update the relevant files in the MigrationTest/run directory.
Finally, the main test script will evaluate the state.

The main checks are the volume IDs on the source and target and the VM
configuration itself. Additional checks are the vm_status and expected_calls,
keeping track if certain calls have been made.

The rationale behind creating two mock-scripts is two-fold:
1. It removes the need to hard code responses for the tunnel
   and to recycle logic for determining and allocating migration volumes.
   Some of that logic already happens in the API part, so it was necessary
   to mock the whole CLI-Handler.
2. It allows testing the code relevant for migration in 'qm start' as well,
   and it should even be possible to test different versions of the
   mock-scripts against each other. With a bit of extra work and things
   like 'git worktree', it might even be possible to automate this.

The helper get_patched config is useful to change pre-defined configuration
files on the fly, avoiding the new to explicitly define whole configurations to
test for something in many cases.

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

test/Makefile

@@ -1,6 +1,6 @@
 all: test
 
-test: test_snapshot test_ovf test_cfg_to_cmd test_pci_addr_conflicts test_qemu_img_convert
+test: test_snapshot test_ovf test_cfg_to_cmd test_pci_addr_conflicts test_qemu_img_convert test_migration
 
 test_snapshot: run_snapshot_tests.pl
 	./run_snapshot_tests.pl
@@ -17,3 +17,6 @@ test_qemu_img_convert: run_qemu_img_convert_tests.pl
 
 test_pci_addr_conflicts: run_pci_addr_checks.pl
 	./run_pci_addr_checks.pl
+
+test_migration: run_qemu_migrate_tests.pl MigrationTest/*.pm
+	./run_qemu_migrate_tests.pl

test/MigrationTest/QemuMigrateMock.pm

@@ -0,0 +1,319 @@
+package MigrationTest::QemuMigrateMock;
+
+use strict;
+use warnings;
+
+use JSON;
+use Test::MockModule;
+
+use MigrationTest::Shared;
+
+use PVE::API2::Qemu;
+use PVE::Storage;
+use PVE::Tools qw(file_set_contents file_get_contents);
+
+use PVE::CLIHandler;
+use base qw(PVE::CLIHandler);
+
+my $RUN_DIR_PATH = $ENV{RUN_DIR_PATH} or die "no RUN_DIR_PATH set\n";
+my $QM_LIB_PATH = $ENV{QM_LIB_PATH} or die "no QM_LIB_PATH set\n";
+
+my $source_volids = decode_json(file_get_contents("${RUN_DIR_PATH}/source_volids"));
+my $source_vdisks = decode_json(file_get_contents("${RUN_DIR_PATH}/source_vdisks"));
+my $vm_status = decode_json(file_get_contents("${RUN_DIR_PATH}/vm_status"));
+my $expected_calls = decode_json(file_get_contents("${RUN_DIR_PATH}/expected_calls"));
+my $fail_config = decode_json(file_get_contents("${RUN_DIR_PATH}/fail_config"));
+my $storage_migrate_map = decode_json(file_get_contents("${RUN_DIR_PATH}/storage_migrate_map"));
+my $migrate_params = decode_json(file_get_contents("${RUN_DIR_PATH}/migrate_params"));
+
+my $test_vmid = $migrate_params->{vmid};
+my $test_target = $migrate_params->{target};
+my $test_opts = $migrate_params->{opts};
+my $current_log = '';
+
+my $vm_stop_executed = 0;
+
+# mocked modules
+
+my $inotify_module = Test::MockModule->new("PVE::INotify");
+$inotify_module->mock(
+    nodename => sub {
+       return 'pve0';
+    },
+);
+
+$MigrationTest::Shared::qemu_config_module->mock(
+    move_config_to_node => sub {
+	my ($self, $vmid, $target) = @_;
+	die "moving wrong config: '$vmid'\n" if $vmid ne $test_vmid;
+	die "moving config to wrong node: '$target'\n" if $target ne $test_target;
+	delete $expected_calls->{move_config_to_node};
+    },
+);
+
+my $qemu_migrate_module = Test::MockModule->new("PVE::QemuMigrate");
+$qemu_migrate_module->mock(
+    finish_tunnel => sub {
+	delete $expected_calls->{'finish_tunnel'};
+	return;
+    },
+    fork_tunnel => sub {
+	die "fork_tunnel (mocked) - implement me\n"; # currently no call should lead here
+    },
+    read_tunnel => sub {
+	die "read_tunnel (mocked) - implement me\n"; # currently no call should lead here
+    },
+    start_remote_tunnel => sub {
+	my ($self, $raddr, $rport, $ruri, $unix_socket_info) = @_;
+	$expected_calls->{'finish_tunnel'} = 1;
+	$self->{tunnel} =  {
+	    writer => "mocked",
+	    reader => "mocked",
+	    pid => 123456,
+	    version => 1,
+	};
+    },
+    write_tunnel => sub {
+	my ($self, $tunnel, $timeout, $command) = @_;
+
+	if ($command =~ m/^resume (\d+)$/) {
+	    my $vmid = $1;
+	    die "resuming wrong VM '$vmid'\n" if $vmid ne $test_vmid;
+	    return;
+	}
+	die "write_tunnel (mocked) - implement me: $command\n";
+    },
+    log => sub {
+	my ($self, $level, $message) = @_;
+	$current_log .= "$level: $message\n";
+    },
+    mon_cmd => sub {
+	my ($vmid, $command, %params) = @_;
+
+	if ($command eq 'nbd-server-start') {
+	    return;
+	} elsif ($command eq 'block-dirty-bitmap-add') {
+	    my $drive = $params{node};
+	    delete $expected_calls->{"block-dirty-bitmap-add-${drive}"};
+	    return;
+	} elsif ($command eq 'block-dirty-bitmap-remove') {
+	    return;
+	} elsif ($command eq 'query-migrate') {
+	    return { status => 'failed' } if $fail_config->{'query-migrate'};
+	    return { status => 'completed' };
+	} elsif ($command eq 'migrate') {
+	    return;
+	} elsif ($command eq 'migrate-set-parameters') {
+	    return;
+	} elsif ($command eq 'migrate_cancel') {
+	    return;
+	}
+	die "mon_cmd (mocked) - implement me: $command";
+    },
+    transfer_replication_state => sub {
+	delete $expected_calls->{transfer_replication_state};
+    },
+    switch_replication_job_target => sub {
+	delete $expected_calls->{switch_replication_job_target};
+    },
+);
+
+$MigrationTest::Shared::qemu_server_module->mock(
+    kvm_user_version => sub {
+	return "5.0.0";
+    },
+    qemu_blockjobs_cancel => sub {
+	return;
+    },
+    qemu_drive_mirror => sub {
+	my ($vmid, $drive, $dst_volid, $vmiddst, $is_zero_initialized, $jobs, $completion, $qga, $bwlimit, $src_bitmap) = @_;
+
+	die "drive_mirror with wrong vmid: '$vmid'\n" if $vmid ne $test_vmid;
+	die "qemu_drive_mirror '$drive' error\n" if $fail_config->{qemu_drive_mirror}
+						 && $fail_config->{qemu_drive_mirror} eq $drive;
+
+	my $nbd_info = decode_json(file_get_contents("${RUN_DIR_PATH}/nbd_info"));
+	die "target does not expect drive mirror for '$drive'\n"
+	    if !defined($nbd_info->{$drive});
+	delete $nbd_info->{$drive};
+	file_set_contents("${RUN_DIR_PATH}/nbd_info", to_json($nbd_info));
+    },
+    qemu_drive_mirror_monitor => sub {
+	return;
+    },
+    set_migration_caps => sub {
+	return;
+    },
+    vm_stop => sub {
+	$vm_stop_executed = 1;
+	delete $expected_calls->{'vm_stop'};
+    },
+);
+
+my $qemu_server_cpuconfig_module = Test::MockModule->new("PVE::QemuServer::CPUConfig");
+$qemu_server_cpuconfig_module->mock(
+    get_cpu_from_running_vm => sub {
+	die "invalid test: if you specify a custom CPU model you need to " .
+	    "specify runningcpu as well\n" if !defined($vm_status->{runningcpu});
+	return $vm_status->{runningcpu};
+    }
+);
+
+my $qemu_server_helpers_module = Test::MockModule->new("PVE::QemuServer::Helpers");
+$qemu_server_helpers_module->mock(
+    vm_running_locally => sub {
+	return $vm_status->{running} && !$vm_stop_executed;
+    },
+);
+
+my $qemu_server_machine_module = Test::MockModule->new("PVE::QemuServer::Machine");
+$qemu_server_machine_module->mock(
+    qemu_machine_pxe => sub {
+	die "invalid test: no runningmachine specified\n"
+	    if !defined($vm_status->{runningmachine});
+	return $vm_status->{runningmachine};
+    },
+);
+
+my $ssh_info_module = Test::MockModule->new("PVE::SSHInfo");
+$ssh_info_module->mock(
+    get_ssh_info => sub {
+	my ($node, $network_cidr) = @_;
+	return {
+	    ip => '1.2.3.4',
+	    name => $node,
+	    network => $network_cidr,
+	};
+    },
+);
+
+$MigrationTest::Shared::storage_module->mock(
+    storage_migrate => sub {
+	my ($cfg, $volid, $target_sshinfo, $target_storeid, $opts, $logfunc) = @_;
+
+	die "storage_migrate '$volid' error\n" if $fail_config->{storage_migrate}
+					       && $fail_config->{storage_migrate} eq $volid;
+
+	my ($storeid, $volname) = PVE::Storage::parse_volume_id($volid);
+
+	die "invalid test: need to add entry for '$volid' to storage_migrate_map\n"
+	    if $storeid ne $target_storeid && !defined($storage_migrate_map->{$volid});
+
+	my $target_volname = $storage_migrate_map->{$volid} // $opts->{target_volname} // $volname;
+	my $target_volid = "${target_storeid}:${target_volname}";
+	MigrationTest::Shared::add_target_volid($target_volid);
+
+	return $target_volid;
+    },
+    vdisk_list => sub { # expects vmid to be set
+	my ($cfg, $storeid, $vmid, $vollist) = @_;
+
+	my @storeids = defined($storeid) ? ($storeid) : keys %{$source_vdisks};
+
+	my $res = {};
+	foreach my $storeid (@storeids) {
+	    my $list_for_storeid = $source_vdisks->{$storeid};
+	    my @list_for_vm = grep { $_->{vmid} eq $vmid } @{$list_for_storeid};
+	    $res->{$storeid} = \@list_for_vm;
+	}
+	return $res;
+    },
+    vdisk_free => sub {
+	my ($scfg, $volid) = @_;
+
+	die "vdisk_free '$volid' error\n" if defined($fail_config->{vdisk_free})
+					  && $fail_config->{vdisk_free} eq $volid;
+
+	delete $source_volids->{$volid};
+    },
+);
+
+$MigrationTest::Shared::tools_module->mock(
+    get_host_address_family => sub {
+	die "get_host_address_family (mocked) - implement me\n"; # currently no call should lead here
+    },
+    next_migrate_port => sub {
+	die "next_migrate_port (mocked) - implement me\n"; # currently no call should lead here
+    },
+    run_command => sub {
+	my ($cmd_tail, %param) = @_;
+
+	my $cmd_msg = to_json($cmd_tail);
+
+	my $cmd = shift @{$cmd_tail};
+
+	if ($cmd eq '/usr/bin/ssh') {
+	    while (scalar(@{$cmd_tail})) {
+		$cmd = shift @{$cmd_tail};
+		if ($cmd eq '/bin/true') {
+		    return 0;
+		} elsif ($cmd eq 'qm') {
+		    $cmd = shift @{$cmd_tail};
+		    if ($cmd eq 'start') {
+			delete $expected_calls->{ssh_qm_start};
+
+			delete $vm_status->{runningmachine};
+			delete $vm_status->{runningcpu};
+
+			my @options = ( @{$cmd_tail} );
+			while (scalar(@options)) {
+			    my $opt = shift @options;
+			    if ($opt eq '--machine') {
+				$vm_status->{runningmachine} = shift @options;
+			    } elsif ($opt eq '--force-cpu') {
+				$vm_status->{runningcpu} = shift @options;
+			    }
+			}
+
+			return $MigrationTest::Shared::tools_module->original('run_command')->([
+			    '/usr/bin/perl',
+			    "-I${QM_LIB_PATH}",
+			    "-I${QM_LIB_PATH}/test",
+			    "${QM_LIB_PATH}/test/MigrationTest/QmMock.pm",
+			    'start',
+			    @{$cmd_tail},
+			    ], %param);
+
+		    } elsif ($cmd eq 'nbdstop') {
+			delete $expected_calls->{ssh_nbdstop};
+			return 0;
+		    } elsif ($cmd eq 'resume') {
+			return 0;
+		    } elsif ($cmd eq 'unlock') {
+			my $vmid = shift @{$cmd_tail};;
+			die "unlocking wrong vmid: $vmid\n" if $vmid ne $test_vmid;
+			PVE::QemuConfig->remove_lock($vmid);
+			return 0;
+		    } elsif ($cmd eq 'stop') {
+			return 0;
+		    }
+		    die "run_command (mocked) ssh qm command - implement me: ${cmd_msg}";
+		} elsif ($cmd eq 'pvesm') {
+		    $cmd = shift @{$cmd_tail};
+		    if ($cmd eq 'free') {
+			my $volid = shift @{$cmd_tail};
+			return 1 if $fail_config->{ssh_pvesm_free}
+				 && $fail_config->{ssh_pvesm_free} eq $volid;
+			MigrationTest::Shared::remove_target_volid($volid);
+			return 0;
+		    }
+		    die "run_command (mocked) ssh pvesm command - implement me: ${cmd_msg}";
+		}
+	    }
+	    die "run_command (mocked) ssh command - implement me: ${cmd_msg}";
+	}
+	die "run_command (mocked) - implement me: ${cmd_msg}";
+    },
+);
+
+eval { PVE::QemuMigrate->migrate($test_target, undef, $test_vmid, $test_opts) };
+my $error = $@;
+
+file_set_contents("${RUN_DIR_PATH}/source_volids", to_json($source_volids));
+file_set_contents("${RUN_DIR_PATH}/vm_status", to_json($vm_status));
+file_set_contents("${RUN_DIR_PATH}/expected_calls", to_json($expected_calls));
+file_set_contents("${RUN_DIR_PATH}/log", $current_log);
+
+die $error if $error;
+
+1;

test/MigrationTest/QmMock.pm

@@ -0,0 +1,142 @@
+package MigrationTest::QmMock;
+
+use strict;
+use warnings;
+
+use JSON;
+use Test::MockModule;
+
+use MigrationTest::Shared;
+
+use PVE::API2::Qemu;
+use PVE::Storage;
+use PVE::Tools qw(file_set_contents file_get_contents);
+
+use PVE::CLIHandler;
+use base qw(PVE::CLIHandler);
+
+my $RUN_DIR_PATH = $ENV{RUN_DIR_PATH} or die "no RUN_DIR_PATH set\n";
+
+my $target_volids = decode_json(file_get_contents("${RUN_DIR_PATH}/target_volids"));
+my $fail_config = decode_json(file_get_contents("${RUN_DIR_PATH}/fail_config"));
+my $migrate_params = decode_json(file_get_contents("${RUN_DIR_PATH}/migrate_params"));
+my $nodename = $migrate_params->{target};
+
+my $kvm_exectued = 0;
+
+sub setup_environment {
+    my $rpcenv = PVE::RPCEnvironment::init('MigrationTest::QmMock', 'cli');
+}
+
+# mock RPCEnvironment directly
+
+sub get_user {
+    return 'root@pam';
+}
+
+sub fork_worker {
+    my ($self, $dtype, $id, $user, $function, $background) = @_;
+    $function->(123456);
+    return '123456';
+}
+
+# mocked modules
+
+my $inotify_module = Test::MockModule->new("PVE::INotify");
+$inotify_module->mock(
+    nodename => sub {
+       return $nodename;
+    },
+);
+
+$MigrationTest::Shared::qemu_server_module->mock(
+    nodename => sub {
+	return $nodename;
+    },
+    config_to_command => sub {
+	return [ 'mocked_kvm_command' ];
+    },
+);
+
+my $qemu_server_helpers_module = Test::MockModule->new("PVE::QemuServer::Helpers");
+$qemu_server_helpers_module->mock(
+    vm_running_locally => sub {
+	return $kvm_exectued;
+    },
+);
+
+# to make sure we get valid and predictable names
+my $disk_counter = 10;
+
+$MigrationTest::Shared::storage_module->mock(
+    vdisk_alloc => sub {
+	my ($cfg, $storeid, $vmid, $fmt, $name, $size) = @_;
+
+	die "vdisk_alloc (mocked) - name is not expected to be set - implement me\n"
+	    if defined($name);
+
+	my $name_without_extension = "vm-${vmid}-disk-${disk_counter}";
+	$disk_counter++;
+
+	my $volid;
+	my $scfg = PVE::Storage::storage_config($cfg, $storeid);
+	if ($scfg->{path}) {
+	    $volid = "${storeid}:${vmid}/${name_without_extension}.${fmt}";
+	} else {
+	    $volid = "${storeid}:${name_without_extension}";
+	}
+
+	die "vdisk_alloc '$volid' error\n" if $fail_config->{vdisk_alloc}
+					   && $fail_config->{vdisk_alloc} eq $volid;
+
+	MigrationTest::Shared::add_target_volid($volid);
+
+	return $volid;
+    },
+);
+
+$MigrationTest::Shared::qemu_server_module->mock(
+    mon_cmd => sub {
+	my ($vmid, $command, %params) = @_;
+
+	if ($command eq 'nbd-server-start') {
+	    return;
+	} elsif ($command eq 'nbd-server-add') {
+	    return;
+	} elsif ($command eq 'qom-set') {
+	    return;
+	}
+	die "mon_cmd (mocked) - implement me: $command";
+    },
+    run_command => sub {
+	my ($cmd_full, %param) = @_;
+
+	my $cmd_msg = to_json($cmd_full);
+
+	my $cmd = shift @{$cmd_full};
+
+	if ($cmd eq '/bin/systemctl') {
+	    return;
+	} elsif ($cmd eq 'mocked_kvm_command') {
+	    $kvm_exectued = 1;
+	    return 0;
+	}
+	die "run_command (mocked) - implement me: ${cmd_msg}";
+    },
+    set_migration_caps => sub {
+	return;
+    },
+    vm_migrate_alloc_nbd_disks => sub{
+	my $nbd = $MigrationTest::Shared::qemu_server_module->original('vm_migrate_alloc_nbd_disks')->(@_);
+	file_set_contents("${RUN_DIR_PATH}/nbd_info", to_json($nbd));
+	return $nbd;
+    },
+);
+
+our $cmddef = {
+    start => [ "PVE::API2::Qemu", 'vm_start', ['vmid'], { node => $nodename } ],
+};
+
+MigrationTest::QmMock->run_cli_handler();
+
+1;

test/MigrationTest/Shared.pm

@@ -0,0 +1,170 @@
+package MigrationTest::Shared;
+
+use strict;
+use warnings;
+
+use JSON;
+use Test::MockModule;
+use Socket qw(AF_INET);
+
+use PVE::QemuConfig;
+use PVE::Tools qw(file_set_contents file_get_contents lock_file_full);
+
+my $RUN_DIR_PATH = $ENV{RUN_DIR_PATH} or die "no RUN_DIR_PATH set\n";
+
+my $storage_config = decode_json(file_get_contents("${RUN_DIR_PATH}/storage_config"));
+my $replication_config = decode_json(file_get_contents("${RUN_DIR_PATH}/replication_config"));
+my $fail_config = decode_json(file_get_contents("${RUN_DIR_PATH}/fail_config"));
+my $migrate_params = decode_json(file_get_contents("${RUN_DIR_PATH}/migrate_params"));
+my $test_vmid = $migrate_params->{vmid};
+
+# helpers
+
+sub add_target_volid {
+    my ($volid) = @_;
+
+    lock_file_full("${RUN_DIR_PATH}/target_volids.lock", undef, 0, sub {
+	my $target_volids = decode_json(file_get_contents("${RUN_DIR_PATH}/target_volids"));
+	die "target volid already present " if defined($target_volids->{$volid});
+	$target_volids->{$volid} = 1;
+	file_set_contents("${RUN_DIR_PATH}/target_volids", to_json($target_volids));
+    });
+    die $@ if $@;
+}
+
+sub remove_target_volid {
+    my ($volid) = @_;
+
+    lock_file_full("${RUN_DIR_PATH}/target_volids.lock", undef, 0, sub {
+	my $target_volids = decode_json(file_get_contents("${RUN_DIR_PATH}/target_volids"));
+	die "target volid does not exist " if !defined($target_volids->{$volid});
+	delete $target_volids->{$volid};
+	file_set_contents("${RUN_DIR_PATH}/target_volids", to_json($target_volids));
+    });
+    die $@ if $@;
+}
+
+my $mocked_cfs_read_file = sub {
+    my ($file) = @_;
+
+    if ($file eq 'datacenter.cfg') {
+	return {};
+    } elsif ($file eq 'replication.cfg') {
+	return $replication_config;
+    }
+    die "cfs_read_file (mocked) - implement me: $file\n";
+};
+
+# mocked modules
+
+our $cluster_module = Test::MockModule->new("PVE::Cluster");
+$cluster_module->mock(
+    cfs_read_file => $mocked_cfs_read_file,
+    check_cfs_quorum => sub {
+	return 1;
+    },
+);
+
+our $ha_config_module = Test::MockModule->new("PVE::HA::Config");
+$ha_config_module->mock(
+    vm_is_ha_managed => sub {
+	return 0;
+    },
+);
+
+our $qemu_config_module = Test::MockModule->new("PVE::QemuConfig");
+$qemu_config_module->mock(
+    assert_config_exists_on_node => sub {
+	return;
+    },
+    load_config => sub {
+	my ($class, $vmid, $node) = @_;
+	die "trying to load wrong config: '$vmid'\n" if $vmid ne $test_vmid;
+	return decode_json(file_get_contents("${RUN_DIR_PATH}/vm_config"));
+    },
+    lock_config => sub { # no use locking here because lock is local to node
+	my ($self, $vmid, $code, @param) = @_;
+	return $code->(@param);
+    },
+    write_config => sub {
+	my ($class, $vmid, $conf) = @_;
+	die "trying to write wrong config: '$vmid'\n" if $vmid ne $test_vmid;
+	file_set_contents("${RUN_DIR_PATH}/vm_config", to_json($conf));
+    },
+);
+
+our $qemu_server_cloudinit_module = Test::MockModule->new("PVE::QemuServer::Cloudinit");
+$qemu_server_cloudinit_module->mock(
+    generate_cloudinitconfig => sub {
+	return;
+    },
+);
+
+our $qemu_server_module = Test::MockModule->new("PVE::QemuServer");
+$qemu_server_module->mock(
+    clear_reboot_request => sub {
+	return 1;
+    },
+    get_efivars_size => sub {
+	 return 128 * 1024;
+    },
+);
+
+our $replication_module = Test::MockModule->new("PVE::Replication");
+$replication_module->mock(
+    run_replication => sub {
+	die "run_replication error" if $fail_config->{run_replication};
+
+	my $vm_config = PVE::QemuConfig->load_config($test_vmid);
+	return PVE::QemuConfig->get_replicatable_volumes(
+	    $storage_config,
+	    $test_vmid,
+	    $vm_config,
+	);
+    },
+);
+
+our $replication_config_module = Test::MockModule->new("PVE::ReplicationConfig");
+$replication_config_module->mock(
+    cfs_read_file => $mocked_cfs_read_file,
+);
+
+our $storage_module = Test::MockModule->new("PVE::Storage");
+$storage_module->mock(
+    activate_volumes => sub {
+	return 1;
+    },
+    deactivate_volumes => sub {
+	return 1;
+    },
+    config => sub {
+	return $storage_config;
+    },
+    get_bandwitdth_limit => sub {
+	return 123456;
+    },
+);
+
+our $systemd_module = Test::MockModule->new("PVE::Systemd");
+$systemd_module->mock(
+    wait_for_unit_removed => sub {
+	return;
+    },
+    enter_systemd_scope => sub {
+	return;
+    },
+);
+
+my $migrate_port_counter = 60000;
+
+our $tools_module = Test::MockModule->new("PVE::Tools");
+$tools_module->mock(
+    get_host_address_family => sub {
+	return AF_INET;
+    },
+    next_migrate_port => sub {
+	return $migrate_port_counter++;
+    },
+);
+
+1;