[pve-devel] [PATCH v5 qemu-server 1/3] migration: move livemigration code in a dedicated sub

[Alexandre Derumier <aderumier@odiso.com>]

Signed-off-by: Alexandre Derumier <aderumier@odiso.com>
---
 PVE/QemuMigrate.pm | 420 +++++++++++++++++++++++----------------------
 1 file changed, 214 insertions(+), 206 deletions(-)

diff --git a/PVE/QemuMigrate.pm b/PVE/QemuMigrate.pm
index 111eeb0..7dd3455 100644
--- a/PVE/QemuMigrate.pm
+++ b/PVE/QemuMigrate.pm
@@ -728,6 +728,219 @@ sub cleanup_bitmaps {
     }
 }
 
+sub live_migration {
+    my ($self, $vmid, $migrate_uri, $spice_port) = @_;
+
+    my $conf = $self->{vmconf};
+
+    $self->log('info', "starting online/live migration on $migrate_uri");
+    $self->{livemigration} = 1;
+
+    # load_defaults
+    my $defaults = PVE::QemuServer::load_defaults();
+
+    $self->log('info', "set migration capabilities");
+    eval { PVE::QemuServer::set_migration_caps($vmid) };
+    warn $@ if $@;
+
+    my $qemu_migrate_params = {};
+
+    # migrate speed can be set via bwlimit (datacenter.cfg and API) and via the
+    # migrate_speed parameter in qm.conf - take the lower of the two.
+    my $bwlimit = $self->get_bwlimit();
+
+    my $migrate_speed = $conf->{migrate_speed} // 0;
+    $migrate_speed *= 1024; # migrate_speed is in MB/s, bwlimit in KB/s
+
+    if ($bwlimit && $migrate_speed) {
+	$migrate_speed = ($bwlimit < $migrate_speed) ? $bwlimit : $migrate_speed;
+    } else {
+	$migrate_speed ||= $bwlimit;
+    }
+    $migrate_speed ||= ($defaults->{migrate_speed} || 0) * 1024;
+
+    if ($migrate_speed) {
+	$migrate_speed *= 1024; # qmp takes migrate_speed in B/s.
+	$self->log('info', "migration speed limit: ". render_bytes($migrate_speed, 1) ."/s");
+    } else {
+	# always set migrate speed as QEMU default to 128 MiBps == 1 Gbps, use 16 GiBps == 128 Gbps
+	$migrate_speed = (16 << 30);
+    }
+    $qemu_migrate_params->{'max-bandwidth'} = int($migrate_speed);
+
+    my $migrate_downtime = $defaults->{migrate_downtime};
+    $migrate_downtime = $conf->{migrate_downtime} if defined($conf->{migrate_downtime});
+    # migrate-set-parameters expects limit in ms
+    $migrate_downtime *= 1000;
+    $self->log('info', "migration downtime limit: $migrate_downtime ms");
+    $qemu_migrate_params->{'downtime-limit'} = int($migrate_downtime);
+
+    # set cachesize to 10% of the total memory
+    my $memory = get_current_memory($conf->{memory});
+    my $cachesize = int($memory * 1048576 / 10);
+    $cachesize = round_powerof2($cachesize);
+
+    $self->log('info', "migration cachesize: " . render_bytes($cachesize, 1));
+    $qemu_migrate_params->{'xbzrle-cache-size'} = int($cachesize);
+
+    $self->log('info', "set migration parameters");
+    eval {
+	mon_cmd($vmid, "migrate-set-parameters", %{$qemu_migrate_params});
+    };
+    $self->log('info', "migrate-set-parameters error: $@") if $@;
+
+    if (PVE::QemuServer::vga_conf_has_spice($conf->{vga}) && !$self->{opts}->{remote}) {
+	my $rpcenv = PVE::RPCEnvironment::get();
+	my $authuser = $rpcenv->get_user();
+
+	my (undef, $proxyticket) = PVE::AccessControl::assemble_spice_ticket($authuser, $vmid, $self->{node});
+
+	my $filename = "/etc/pve/nodes/$self->{node}/pve-ssl.pem";
+	my $subject =  PVE::AccessControl::read_x509_subject_spice($filename);
+
+	$self->log('info', "spice client_migrate_info");
+
+	eval {
+	    mon_cmd($vmid, "client_migrate_info", protocol => 'spice',
+						hostname => $proxyticket, 'port' => 0, 'tls-port' => $spice_port,
+						'cert-subject' => $subject);
+	};
+	$self->log('info', "client_migrate_info error: $@") if $@;
+
+    }
+
+    my $start = time();
+
+    $self->log('info', "start migrate command to $migrate_uri");
+    eval {
+	mon_cmd($vmid, "migrate", uri => $migrate_uri);
+    };
+    my $merr = $@;
+    $self->log('info', "migrate uri => $migrate_uri failed: $merr") if $merr;
+
+    my $last_mem_transferred = 0;
+    my $usleep = 1000000;
+    my $i = 0;
+    my $err_count = 0;
+    my $lastrem = undef;
+    my $downtimecounter = 0;
+    while (1) {
+	$i++;
+	my $avglstat = $last_mem_transferred ? $last_mem_transferred / $i : 0;
+
+	usleep($usleep);
+
+	my $stat = eval { mon_cmd($vmid, "query-migrate") };
+	if (my $err = $@) {
+	    $err_count++;
+	    warn "query migrate failed: $err\n";
+	    $self->log('info', "query migrate failed: $err");
+	    if ($err_count <= 5) {
+		usleep(1_000_000);
+		next;
+	    }
+	    die "too many query migrate failures - aborting\n";
+	}
+
+	my $status = $stat->{status};
+	if (defined($status) && $status =~ m/^(setup)$/im) {
+	    sleep(1);
+	    next;
+	}
+
+	if (!defined($status) || $status !~ m/^(active|completed|failed|cancelled)$/im) {
+	    die $merr if $merr;
+	    die "unable to parse migration status '$status' - aborting\n";
+	}
+	$merr = undef;
+	$err_count = 0;
+
+	my $memstat = $stat->{ram};
+
+	if ($status eq 'completed') {
+	    my $delay = time() - $start;
+	    if ($delay > 0) {
+		my $total = $memstat->{total} || 0;
+		my $avg_speed = render_bytes($total / $delay, 1);
+		my $downtime = $stat->{downtime} || 0;
+		$self->log('info', "average migration speed: $avg_speed/s - downtime $downtime ms");
+	    }
+	}
+
+	if ($status eq 'failed' || $status eq 'cancelled') {
+	    my $message = $stat->{'error-desc'} ? "$status - $stat->{'error-desc'}" : $status;
+	    $self->log('info', "migration status error: $message");
+	    die "aborting\n"
+	}
+
+	if ($status ne 'active') {
+	    $self->log('info', "migration status: $status");
+	    last;
+	}
+
+	if ($memstat->{transferred} ne $last_mem_transferred) {
+	    my $trans = $memstat->{transferred} || 0;
+	    my $rem = $memstat->{remaining} || 0;
+	    my $total = $memstat->{total} || 0;
+	    my $speed = ($memstat->{'pages-per-second'} // 0) * ($memstat->{'page-size'} // 0);
+	    my $dirty_rate = ($memstat->{'dirty-pages-rate'} // 0) * ($memstat->{'page-size'} // 0);
+
+	    # reduce sleep if remainig memory is lower than the average transfer speed
+	    $usleep = 100_000 if $avglstat && $rem < $avglstat;
+
+	    # also reduce loggin if we poll more frequent
+	    my $should_log = $usleep > 100_000 ? 1 : ($i % 10) == 0;
+
+	    my $total_h = render_bytes($total, 1);
+	    my $transferred_h = render_bytes($trans, 1);
+	    my $speed_h = render_bytes($speed, 1);
+
+	    my $progress = "transferred $transferred_h of $total_h VM-state, ${speed_h}/s";
+
+	    if ($dirty_rate > $speed) {
+		my $dirty_rate_h = render_bytes($dirty_rate, 1);
+		$progress .= ", VM dirties lots of memory: $dirty_rate_h/s";
+	    }
+
+	    $self->log('info', "migration $status, $progress") if $should_log;
+
+	    my $xbzrle = $stat->{"xbzrle-cache"} || {};
+	    my ($xbzrlebytes, $xbzrlepages) = $xbzrle->@{'bytes', 'pages'};
+	    if ($xbzrlebytes || $xbzrlepages) {
+		my $bytes_h = render_bytes($xbzrlebytes, 1);
+
+		my $msg = "send updates to $xbzrlepages pages in $bytes_h encoded memory";
+
+		$msg .= sprintf(", cache-miss %.2f%%", $xbzrle->{'cache-miss-rate'} * 100)
+		    if $xbzrle->{'cache-miss-rate'};
+
+		$msg .= ", overflow $xbzrle->{overflow}" if $xbzrle->{overflow};
+
+		$self->log('info', "xbzrle: $msg") if $should_log;
+	    }
+
+	    if (($lastrem && $rem > $lastrem) || ($rem == 0)) {
+		$downtimecounter++;
+	    }
+	    $lastrem = $rem;
+
+	    if ($downtimecounter > 5) {
+		$downtimecounter = 0;
+		$migrate_downtime *= 2;
+		$self->log('info', "auto-increased downtime to continue migration: $migrate_downtime ms");
+		eval {
+		    # migrate-set-parameters does not touch values not
+		    # specified, so this only changes downtime-limit
+		    mon_cmd($vmid, "migrate-set-parameters", 'downtime-limit' => int($migrate_downtime));
+		};
+		$self->log('info', "migrate-set-parameters error: $@") if $@;
+	    }
+	}
+
+	$last_mem_transferred = $memstat->{transferred};
+    }
+}
+
 sub phase1 {
     my ($self, $vmid) = @_;
 
@@ -1139,212 +1352,7 @@ sub phase2 {
 	}
     }
 
-    $self->log('info', "starting online/live migration on $migrate_uri");
-    $self->{livemigration} = 1;
-
-    # load_defaults
-    my $defaults = PVE::QemuServer::load_defaults();
-
-    $self->log('info', "set migration capabilities");
-    eval { PVE::QemuServer::set_migration_caps($vmid) };
-    warn $@ if $@;
-
-    my $qemu_migrate_params = {};
-
-    # migrate speed can be set via bwlimit (datacenter.cfg and API) and via the
-    # migrate_speed parameter in qm.conf - take the lower of the two.
-    my $bwlimit = $self->get_bwlimit();
-
-    my $migrate_speed = $conf->{migrate_speed} // 0;
-    $migrate_speed *= 1024; # migrate_speed is in MB/s, bwlimit in KB/s
-
-    if ($bwlimit && $migrate_speed) {
-	$migrate_speed = ($bwlimit < $migrate_speed) ? $bwlimit : $migrate_speed;
-    } else {
-	$migrate_speed ||= $bwlimit;
-    }
-    $migrate_speed ||= ($defaults->{migrate_speed} || 0) * 1024;
-
-    if ($migrate_speed) {
-	$migrate_speed *= 1024; # qmp takes migrate_speed in B/s.
-	$self->log('info', "migration speed limit: ". render_bytes($migrate_speed, 1) ."/s");
-    } else {
-	# always set migrate speed as QEMU default to 128 MiBps == 1 Gbps, use 16 GiBps == 128 Gbps
-	$migrate_speed = (16 << 30);
-    }
-    $qemu_migrate_params->{'max-bandwidth'} = int($migrate_speed);
-
-    my $migrate_downtime = $defaults->{migrate_downtime};
-    $migrate_downtime = $conf->{migrate_downtime} if defined($conf->{migrate_downtime});
-    # migrate-set-parameters expects limit in ms
-    $migrate_downtime *= 1000;
-    $self->log('info', "migration downtime limit: $migrate_downtime ms");
-    $qemu_migrate_params->{'downtime-limit'} = int($migrate_downtime);
-
-    # set cachesize to 10% of the total memory
-    my $memory = get_current_memory($conf->{memory});
-    my $cachesize = int($memory * 1048576 / 10);
-    $cachesize = round_powerof2($cachesize);
-
-    $self->log('info', "migration cachesize: " . render_bytes($cachesize, 1));
-    $qemu_migrate_params->{'xbzrle-cache-size'} = int($cachesize);
-
-    $self->log('info', "set migration parameters");
-    eval {
-	mon_cmd($vmid, "migrate-set-parameters", %{$qemu_migrate_params});
-    };
-    $self->log('info', "migrate-set-parameters error: $@") if $@;
-
-    if (PVE::QemuServer::vga_conf_has_spice($conf->{vga}) && !$self->{opts}->{remote}) {
-	my $rpcenv = PVE::RPCEnvironment::get();
-	my $authuser = $rpcenv->get_user();
-
-	my (undef, $proxyticket) = PVE::AccessControl::assemble_spice_ticket($authuser, $vmid, $self->{node});
-
-	my $filename = "/etc/pve/nodes/$self->{node}/pve-ssl.pem";
-	my $subject =  PVE::AccessControl::read_x509_subject_spice($filename);
-
-	$self->log('info', "spice client_migrate_info");
-
-	eval {
-	    mon_cmd($vmid, "client_migrate_info", protocol => 'spice',
-						hostname => $proxyticket, 'port' => 0, 'tls-port' => $spice_port,
-						'cert-subject' => $subject);
-	};
-	$self->log('info', "client_migrate_info error: $@") if $@;
-
-    }
-
-    my $start = time();
-
-    $self->log('info', "start migrate command to $migrate_uri");
-    eval {
-	mon_cmd($vmid, "migrate", uri => $migrate_uri);
-    };
-    my $merr = $@;
-    $self->log('info', "migrate uri => $migrate_uri failed: $merr") if $merr;
-
-    my $last_mem_transferred = 0;
-    my $usleep = 1000000;
-    my $i = 0;
-    my $err_count = 0;
-    my $lastrem = undef;
-    my $downtimecounter = 0;
-    while (1) {
-	$i++;
-	my $avglstat = $last_mem_transferred ? $last_mem_transferred / $i : 0;
-
-	usleep($usleep);
-
-	my $stat = eval { mon_cmd($vmid, "query-migrate") };
-	if (my $err = $@) {
-	    $err_count++;
-	    warn "query migrate failed: $err\n";
-	    $self->log('info', "query migrate failed: $err");
-	    if ($err_count <= 5) {
-		usleep(1_000_000);
-		next;
-	    }
-	    die "too many query migrate failures - aborting\n";
-	}
-
-	my $status = $stat->{status};
-	if (defined($status) && $status =~ m/^(setup)$/im) {
-	    sleep(1);
-	    next;
-	}
-
-	if (!defined($status) || $status !~ m/^(active|completed|failed|cancelled)$/im) {
-	    die $merr if $merr;
-	    die "unable to parse migration status '$status' - aborting\n";
-	}
-	$merr = undef;
-	$err_count = 0;
-
-	my $memstat = $stat->{ram};
-
-	if ($status eq 'completed') {
-	    my $delay = time() - $start;
-	    if ($delay > 0) {
-		my $total = $memstat->{total} || 0;
-		my $avg_speed = render_bytes($total / $delay, 1);
-		my $downtime = $stat->{downtime} || 0;
-		$self->log('info', "average migration speed: $avg_speed/s - downtime $downtime ms");
-	    }
-	}
-
-	if ($status eq 'failed' || $status eq 'cancelled') {
-	    my $message = $stat->{'error-desc'} ? "$status - $stat->{'error-desc'}" : $status;
-	    $self->log('info', "migration status error: $message");
-	    die "aborting\n"
-	}
-
-	if ($status ne 'active') {
-	    $self->log('info', "migration status: $status");
-	    last;
-	}
-
-	if ($memstat->{transferred} ne $last_mem_transferred) {
-	    my $trans = $memstat->{transferred} || 0;
-	    my $rem = $memstat->{remaining} || 0;
-	    my $total = $memstat->{total} || 0;
-	    my $speed = ($memstat->{'pages-per-second'} // 0) * ($memstat->{'page-size'} // 0);
-	    my $dirty_rate = ($memstat->{'dirty-pages-rate'} // 0) * ($memstat->{'page-size'} // 0);
-
-	    # reduce sleep if remainig memory is lower than the average transfer speed
-	    $usleep = 100_000 if $avglstat && $rem < $avglstat;
-
-	    # also reduce loggin if we poll more frequent
-	    my $should_log = $usleep > 100_000 ? 1 : ($i % 10) == 0;
-
-	    my $total_h = render_bytes($total, 1);
-	    my $transferred_h = render_bytes($trans, 1);
-	    my $speed_h = render_bytes($speed, 1);
-
-	    my $progress = "transferred $transferred_h of $total_h VM-state, ${speed_h}/s";
-
-	    if ($dirty_rate > $speed) {
-		my $dirty_rate_h = render_bytes($dirty_rate, 1);
-		$progress .= ", VM dirties lots of memory: $dirty_rate_h/s";
-	    }
-
-	    $self->log('info', "migration $status, $progress") if $should_log;
-
-	    my $xbzrle = $stat->{"xbzrle-cache"} || {};
-	    my ($xbzrlebytes, $xbzrlepages) = $xbzrle->@{'bytes', 'pages'};
-	    if ($xbzrlebytes || $xbzrlepages) {
-		my $bytes_h = render_bytes($xbzrlebytes, 1);
-
-		my $msg = "send updates to $xbzrlepages pages in $bytes_h encoded memory";
-
-		$msg .= sprintf(", cache-miss %.2f%%", $xbzrle->{'cache-miss-rate'} * 100)
-		    if $xbzrle->{'cache-miss-rate'};
-
-		$msg .= ", overflow $xbzrle->{overflow}" if $xbzrle->{overflow};
-
-		$self->log('info', "xbzrle: $msg") if $should_log;
-	    }
-
-	    if (($lastrem && $rem > $lastrem) || ($rem == 0)) {
-		$downtimecounter++;
-	    }
-	    $lastrem = $rem;
-
-	    if ($downtimecounter > 5) {
-		$downtimecounter = 0;
-		$migrate_downtime *= 2;
-		$self->log('info', "auto-increased downtime to continue migration: $migrate_downtime ms");
-		eval {
-		    # migrate-set-parameters does not touch values not
-		    # specified, so this only changes downtime-limit
-		    mon_cmd($vmid, "migrate-set-parameters", 'downtime-limit' => int($migrate_downtime));
-		};
-		$self->log('info', "migrate-set-parameters error: $@") if $@;
-	    }
-	}
-
-	$last_mem_transferred = $memstat->{transferred};
-    }
+    live_migration($self, $vmid, $migrate_uri, $spice_port);
 
     if ($self->{storage_migration}) {
 	# finish block-job with block-job-cancel, to disconnect source VM from NBD
-- 
2.39.2