qmigrate

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