PVE/QemuMigrate.pm

   1 package PVE::QemuMigrate;
   2
   3 use strict;
   4 use warnings;
   5 use POSIX qw(strftime);
   6 use IO::File;
   7 use IPC::Open2;
   8 use PVE::Tools qw(run_command);
   9 use PVE::INotify;
  10 use PVE::Cluster;
  11 use PVE::Storage;
  12 use PVE::QemuServer;
  13
  14 my $delayed_interrupt = 0;
  15
  16 # blowfish is a fast block cipher, much faster then 3des
  17 my @ssh_opts = ('-c', 'blowfish', '-o', 'BatchMode=yes');
  18 my @ssh_cmd = ('/usr/bin/ssh', @ssh_opts);
  19 my @scp_cmd = ('/usr/bin/scp', @ssh_opts);
  20 my $qm_cmd = '/usr/sbin/qm';
  21
  22 sub logmsg {
  23     my ($level, $msg) = @_;
  24
  25     chomp $msg;
  26
  27     return if !$msg;
  28
  29     my $tstr = strftime("%b %d %H:%M:%S", localtime);
  30
  31     foreach my $line (split (/\n/, $msg)) {
  32         if ($level eq 'err') {
  33             print STDOUT "$tstr ERROR: $line\n";
  34         } else {
  35             print STDOUT "$tstr $line\n";
  36         }
  37     }
  38     \*STDOUT->flush();
  39 }
  40
  41 sub eval_int {
  42     my ($func) = @_;
  43
  44     eval {
  45         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
  46             $delayed_interrupt = 0;
  47             die "interrupted by signal\n";
  48         };
  49         local $SIG{PIPE} = sub {
  50             $delayed_interrupt = 0;
  51             die "interrupted by signal\n";
  52         };
  53
  54         my $di = $delayed_interrupt;
  55         $delayed_interrupt = 0;
  56
  57         die "interrupted by signal\n" if $di;
  58
  59         &$func();
  60     };
  61 }
  62
  63 sub fork_command_pipe {
  64     my ($cmd) = @_;
  65
  66     my $reader = IO::File->new();
  67     my $writer = IO::File->new();
  68
  69     my $orig_pid = $$;
  70
  71     my $cpid;
  72
  73     eval { $cpid = open2($reader, $writer, @$cmd); };
  74
  75     my $err = $@;
  76
  77     # catch exec errors
  78     if ($orig_pid != $$) {
  79         logmsg('err', "can't fork command pipe\n");
  80         POSIX::_exit(1);
  81         kill('KILL', $$);
  82     }
  83
  84     die $err if $err;
  85
  86     return { writer => $writer, reader => $reader, pid => $cpid };
  87 }
  88
  89 sub finish_command_pipe {
  90     my $cmdpipe = shift;
  91
  92     my $writer = $cmdpipe->{writer};
  93     my $reader = $cmdpipe->{reader};
  94
  95     $writer->close();
  96     $reader->close();
  97
  98     my $cpid = $cmdpipe->{pid};
  99
 100     kill(15, $cpid) if kill(0, $cpid);
 101
 102     waitpid($cpid, 0);
 103 }
 104
 105 sub run_with_timeout {
 106     my ($timeout, $code, @param) = @_;
 107
 108     die "got timeout\n" if $timeout <= 0;
 109
 110     my $prev_alarm;
 111
 112     my $sigcount = 0;
 113
 114     my $res;
 115
 116     eval {
 117         local $SIG{ALRM} = sub { $sigcount++; die "got timeout\n"; };
 118         local $SIG{PIPE} = sub { $sigcount++; die "broken pipe\n" };
 119         local $SIG{__DIE__};   # see SA bug 4631
 120
 121         $prev_alarm = alarm($timeout);
 122
 123         $res = &$code(@param);
 124
 125         alarm(0); # avoid race conditions
 126     };
 127
 128     my $err = $@;
 129
 130     alarm($prev_alarm) if defined($prev_alarm);
 131
 132     die "unknown error" if $sigcount && !$err; # seems to happen sometimes
 133
 134     die $err if $err;
 135
 136     return $res;
 137 }
 138
 139 sub fork_tunnel {
 140     my ($nodeip, $lport, $rport) = @_;
 141
 142     my $cmd = [@ssh_cmd, '-o', 'BatchMode=yes',
 143                '-L', "$lport:localhost:$rport", $nodeip,
 144                'qm', 'mtunnel' ];
 145
 146     my $tunnel = fork_command_pipe($cmd);
 147
 148     my $reader = $tunnel->{reader};
 149
 150     my $helo;
 151     eval {
 152         run_with_timeout(60, sub { $helo = <$reader>; });
 153         die "no reply\n" if !$helo;
 154         die "no quorum on target node\n" if $helo =~ m/^no quorum$/;
 155         die "got strange reply from mtunnel ('$helo')\n"
 156             if $helo !~ m/^tunnel online$/;
 157     };
 158     my $err = $@;
 159
 160     if ($err) {
 161         finish_command_pipe($tunnel);
 162         die "can't open migration tunnel - $err";
 163     }
 164     return $tunnel;
 165 }
 166
 167 sub finish_tunnel {
 168     my $tunnel = shift;
 169
 170     my $writer = $tunnel->{writer};
 171
 172     eval {
 173         run_with_timeout(30, sub {
 174             print $writer "quit\n";
 175             $writer->flush();
 176         });
 177     };
 178     my $err = $@;
 179
 180     finish_command_pipe($tunnel);
 181
 182     die $err if $err;
 183 }
 184
 185 sub migrate {
 186     my ($node, $nodeip, $vmid, $online, $force) = @_;
 187
 188     my $starttime = time();
 189
 190     my $rem_ssh = [@ssh_cmd, "root\@$nodeip"];
 191
 192     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
 193         logmsg('err', "received interrupt - delayed");
 194         $delayed_interrupt = 1;
 195     };
 196
 197     local $ENV{RSYNC_RSH} = join(' ', @ssh_cmd);
 198
 199     my $session = {
 200         vmid => $vmid,
 201         node => $node,
 202         nodeip => $nodeip,
 203         force => $force,
 204         storecfg => PVE::Storage::config(),
 205         rem_ssh => $rem_ssh,
 206     };
 207
 208     my $errors;
 209
 210     # lock config during migration
 211     eval { PVE::QemuServer::lock_config($vmid, sub {
 212
 213         my $conf;
 214         eval_int(sub { $conf = prepare($session); });
 215         die $@ if $@;
 216
 217         my $running = 0;
 218         if (my $pid = PVE::QemuServer::check_running($vmid)) {
 219             die "cant migrate running VM without --online\n" if !$online;
 220             $running = $pid;
 221         }
 222
 223         my $rhash = {};
 224         eval_int (sub { phase1($session, $conf, $rhash, $running); });
 225         my $err = $@;
 226
 227         if ($err) {
 228             if ($rhash->{clearlock}) {
 229                 my $unset = { lock => 1 };
 230                 eval { PVE::QemuServer::change_config_nolock($session->{vmid}, {}, $unset, 1) };
 231                 if (my $tmperr = $@) {
 232                     logmsg('err', $tmperr);
 233                 }
 234             }
 235             if ($rhash->{volumes}) {
 236                 foreach my $volid (@{$rhash->{volumes}}) {
 237                     logmsg('err', "found stale volume copy '$volid' on node '$session->{node}'");
 238                 }
 239             }
 240             die $err;
 241         }
 242
 243         # vm is now owned by other node
 244         # Note: there is no VM config file on the local node anymore, so
 245         # we need to pass $nocheck = 1 for vm commands
 246
 247         my $volids = $rhash->{volumes};
 248
 249         if ($running) {
 250
 251             $rhash = {};
 252             eval_int(sub { phase2($session, $conf, $rhash); });
 253             my $err = $@;
 254
 255             # always kill tunnel
 256             if ($rhash->{tunnel}) {
 257                 eval_int(sub { finish_tunnel($rhash->{tunnel}) });
 258                 if (my $tmperr = $@) {
 259                     logmsg('err', "stopping tunnel failed - $tmperr");
 260                     $errors = 1;
 261                 }
 262             }
 263
 264             # always stop local VM - no interrupts possible
 265             eval { PVE::QemuServer::vm_stop($session->{storecfg}, $session->{vmid}, 1, 1); };
 266             if (my $tmperr = $@) {
 267                 logmsg('err', "stopping vm failed - $tmperr");
 268                 $errors = 1;
 269             }
 270
 271             if ($err) {
 272                 $errors = 1;
 273                 logmsg('err', "online migrate failure - $err");
 274             }
 275         }
 276
 277         # finalize -- clear migrate lock
 278         eval_int(sub {
 279             my $cmd = [ @{$session->{rem_ssh}}, $qm_cmd, 'unlock', $session->{vmid} ];
 280             run_command($cmd);
 281         });
 282         if (my $tmperr = $@) {
 283             logmsg('err', "failed to clear migrate lock - $tmperr");
 284             $errors = 1;
 285         }
 286
 287         # destroy local copies
 288         foreach my $volid (@$volids) {
 289             eval_int(sub { PVE::Storage::vdisk_free($session->{storecfg}, $volid); });
 290             my $err = $@;
 291
 292             if ($err) {
 293                 logmsg('err', "removing local copy of '$volid' failed - $err");
 294                 $errors = 1;
 295
 296                 last if $err =~ /^interrupted by signal$/;
 297             }
 298         }
 299
 300         # always deactivate volumes - avoid lvm LVs to be active on
 301         # several nodes
 302         eval {
 303             my $vollist = PVE::QemuServer::get_vm_volumes($conf);
 304             PVE::Storage::deactivate_volumes($session->{storecfg}, $vollist);
 305         };
 306         if (my $tmperr = $@) {
 307             logmsg('err', $tmperr);
 308             $errors = 1;
 309         }
 310
 311     })};
 312
 313     my $err = $@;
 314
 315     my $delay = time() - $starttime;
 316     my $mins = int($delay/60);
 317     my $secs = $delay - $mins*60;
 318     my $hours =  int($mins/60);
 319     $mins = $mins - $hours*60;
 320
 321     my $duration = sprintf "%02d:%02d:%02d", $hours, $mins, $secs;
 322
 323     if ($err) {
 324         logmsg('err', "migration aborted (duration $duration): $err");
 325         die "migration aborted";
 326     }
 327
 328     if ($errors) {
 329         logmsg('err', "migration finished with problems (duration $duration)");
 330         die "migration problems"
 331     }
 332
 333     logmsg('info', "migration finished successfuly (duration $duration)");
 334 }
 335
 336 sub prepare {
 337     my ($session) = @_;
 338
 339     # test is VM exist
 340     my $conf = PVE::QemuServer::load_config($session->{vmid});
 341
 342     PVE::QemuServer::check_lock($conf);
 343
 344     # activate volumes
 345     my $vollist = PVE::QemuServer::get_vm_volumes($conf);
 346     PVE::Storage::activate_volumes($session->{storecfg}, $vollist);
 347
 348     # test ssh connection
 349     my $cmd = [ @{$session->{rem_ssh}}, '/bin/true' ];
 350     eval { run_command($cmd); };
 351     die "Can't connect to destination address using public key\n" if $@;
 352
 353     return $conf;
 354 }
 355
 356 sub sync_disks {
 357     my ($session, $conf, $rhash, $running) = @_;
 358
 359     logmsg('info', "copying disk images");
 360
 361     my $res = [];
 362
 363     eval {
 364
 365         my $volhash = {};
 366         my $cdromhash = {};
 367
 368         # get list from PVE::Storage (for unused volumes)
 369         my $dl = PVE::Storage::vdisk_list($session->{storecfg}, undef, $session->{vmid});
 370         PVE::Storage::foreach_volid($dl, sub {
 371             my ($volid, $sid, $volname) = @_;
 372
 373             my $scfg =  PVE::Storage::storage_config($session->{storecfg}, $sid);
 374
 375             return if $scfg->{shared};
 376
 377             $volhash->{$volid} = 1;
 378         });
 379
 380         # and add used,owned/non-shared disks (just to be sure we have all)
 381
 382         my $sharedvm = 1;
 383         PVE::QemuServer::foreach_drive($conf, sub {
 384             my ($ds, $drive) = @_;
 385
 386             my $volid = $drive->{file};
 387             return if !$volid;
 388
 389             die "cant migrate local file/device '$volid'\n" if $volid =~ m|^/|;
 390
 391             if (PVE::QemuServer::drive_is_cdrom($drive)) {
 392                 die "cant migrate local cdrom drive\n" if $volid eq 'cdrom';
 393                 return if $volid eq 'none';
 394                 $cdromhash->{$volid} = 1;
 395             }
 396
 397             my ($sid, $volname) = PVE::Storage::parse_volume_id($volid);
 398
 399             my $scfg =  PVE::Storage::storage_config($session->{storecfg}, $sid);
 400
 401             return if $scfg->{shared};
 402
 403             die "can't migrate local cdrom '$volid'\n" if $cdromhash->{$volid};
 404
 405             $sharedvm = 0;
 406
 407             my ($path, $owner) = PVE::Storage::path($session->{storecfg}, $volid);
 408
 409             die "can't migrate volume '$volid' - owned by other VM (owner = VM $owner)\n"
 410                 if !$owner || ($owner != $session->{vmid});
 411
 412             $volhash->{$volid} = 1;
 413         });
 414
 415         if ($running && !$sharedvm) {
 416             die "can't do online migration - VM uses local disks\n";
 417         }
 418
 419         # do some checks first
 420         foreach my $volid (keys %$volhash) {
 421             my ($sid, $volname) = PVE::Storage::parse_volume_id($volid);
 422             my $scfg =  PVE::Storage::storage_config($session->{storecfg}, $sid);
 423
 424             die "can't migrate '$volid' - storagy type '$scfg->{type}' not supported\n"
 425                 if $scfg->{type} ne 'dir';
 426         }
 427
 428         foreach my $volid (keys %$volhash) {
 429             my ($sid, $volname) = PVE::Storage::parse_volume_id($volid);
 430             push @{$rhash->{volumes}}, $volid;
 431             PVE::Storage::storage_migrate($session->{storecfg}, $volid, $session->{nodeip}, $sid);
 432         }
 433     };
 434     die "Failed to sync data - $@" if $@;
 435 }
 436
 437 sub phase1 {
 438     my ($session, $conf, $rhash, $running) = @_;
 439
 440     logmsg('info', "starting migration of VM $session->{vmid} to node '$session->{node}' ($session->{nodeip})");
 441
 442     if (my $loc_res = PVE::QemuServer::check_local_resources($conf, 1)) {
 443         if ($running || !$session->{force}) {
 444             die "can't migrate VM which uses local devices\n";
 445         } else {
 446             logmsg('info', "migrating VM which uses local devices");
 447         }
 448     }
 449
 450     # set migrate lock in config file
 451     $rhash->{clearlock} = 1;
 452
 453     PVE::QemuServer::change_config_nolock($session->{vmid}, { lock => 'migrate' }, {}, 1);
 454
 455     sync_disks($session, $conf, $rhash, $running);
 456
 457     # move config to remote node
 458     my $conffile = PVE::QemuServer::config_file($session->{vmid});
 459     my $newconffile = PVE::QemuServer::config_file($session->{vmid}, $session->{node});
 460
 461     die "Failed to move config to node '$session->{node}' - rename failed: $!\n"
 462         if !rename($conffile, $newconffile);
 463 };
 464
 465 sub phase2 {
 466     my ($session, $conf, $rhash) = @_;
 467
 468     logmsg('info', "starting VM on remote node '$session->{node}'");
 469
 470     my $rport;
 471
 472     ## start on remote node
 473     my $cmd = [@{$session->{rem_ssh}}, $qm_cmd, 'start',
 474                $session->{vmid}, '--stateuri', 'tcp', '--skiplock'];
 475
 476     run_command($cmd, outfunc => sub {
 477         my $line = shift;
 478
 479         if ($line =~ m/^migration listens on port (\d+)$/) {
 480             $rport = $1;
 481         }
 482     });
 483
 484     die "unable to detect remote migration port\n" if !$rport;
 485
 486     logmsg('info', "starting migration tunnel");
 487
 488     ## create tunnel to remote port
 489     my $lport = PVE::QemuServer::next_migrate_port();
 490     $rhash->{tunnel} = fork_tunnel($session->{nodeip}, $lport, $rport);
 491
 492     logmsg('info', "starting online/live migration");
 493     # start migration
 494
 495     my $start = time();
 496
 497     PVE::QemuServer::vm_monitor_command($session->{vmid}, "migrate -d \"tcp:localhost:$lport\"", 1);
 498
 499     my $lstat = '';
 500     while (1) {
 501         sleep (2);
 502         my $stat = PVE::QemuServer::vm_monitor_command($session->{vmid}, "info migrate", 1);
 503         if ($stat =~ m/^Migration status: (active|completed|failed|cancelled)$/im) {
 504             my $ms = $1;
 505
 506             if ($stat ne $lstat) {
 507                 if ($ms eq 'active') {
 508                     my ($trans, $rem, $total) = (0, 0, 0);
 509                     $trans = $1 if $stat =~ m/^transferred ram: (\d+) kbytes$/im;
 510                     $rem = $1 if $stat =~ m/^remaining ram: (\d+) kbytes$/im;
 511                     $total = $1 if $stat =~ m/^total ram: (\d+) kbytes$/im;
 512
 513                     logmsg('info', "migration status: $ms (transferred ${trans}KB, " .
 514                             "remaining ${rem}KB), total ${total}KB)");
 515                 } else {
 516                     logmsg('info', "migration status: $ms");
 517                 }
 518             }
 519
 520             if ($ms eq 'completed') {
 521                 my $delay = time() - $start;
 522                 if ($delay > 0) {
 523                     my $mbps = sprintf "%.2f", $conf->{memory}/$delay;
 524                     logmsg('info', "migration speed: $mbps MB/s");
 525                 }
 526             }
 527
 528             if ($ms eq 'failed' || $ms eq 'cancelled') {
 529                 die "aborting\n"
 530             }
 531
 532             last if $ms ne 'active';
 533         } else {
 534             die "unable to parse migration status '$stat' - aborting\n";
 535         }
 536         $lstat = $stat;
 537     };
 538 }