Migration des machines virtuelles avec snapshots

Libvirt ne supporte malheureusement pas Out of the box la migration des machines virtuelles avec des snapshots, mais fournit tous les outils pour le faire (il faut voir libvirt comme un outil de bas niveau qui fournit uniquement les API nécessaires, le reste doit être géré par un outil de plus haut niveau). Mais il peut être utile quand on déploie pas d'usine à gaz de gestion de cluster de pouvoir le faire. Voilà un petit script perl qui peut migrer toutes les VM d'un hyperviseur vers un autre, en prenant en compte les snapshots

migrate_all.pl

#!/usr/bin/perl -w
 
use strict;
use Sys::Virt;
 
my ($local,$remote) = undef;
 
eval { $local = Sys::Virt->new( uri => 'qemu:///system' ); };
if ($@){
  # No connection to the local libvirt
  # We can't do anything
  die 'Error connecting to libvirt on URI: qemu:///system: '. $@;
}
 
eval { $remote = Sys::Virt->new( uri => 'qemu+ssh://fws@peer/system' ); };
if ($@){
  # No connection to the remote server
  # Let's try to managed save all running domain
#  foreach my $dom ($local->list_all_domains()){
#    next unless $dom->is_active;
#    $dom->managed_save();
#  }
  die "Cannot connect on remote host\n";
}
else{
  # We have a connection to both the local and
  # the remote libvirt. Lets try to migrate
  # all our running domain to our friend
  foreach my $locdom ($local->list_all_domains()){
    # Is the remote domain already defined ?
    my $remdom = eval { $remote->get_domain_by_name($locdom->get_name()); };
    if ($@){
      # Remote domain not defined yet
      $remdom = $remote->define_domain($locdom->get_xml_description());
    }
    # Now lets migrate all the snapshots
    foreach my $snap ($locdom->list_snapshots){
      # Handle the active snapshot
      if ($snap->is_current){
        $remdom->create_snapshot($snap->get_xml_description, Sys::Virt::DomainSnapshot::CREATE_REDEFINE | Sys::Virt::DomainSnapshot::CREATE_CURRENT);
      }
      else{
        $remdom->create_snapshot($snap->get_xml_description, Sys::Virt::DomainSnapshot::CREATE_REDEFINE);
      }
      # Once snapshot has been moved, lets remove it's metadata handling on the local hypervisor
      $snap->delete(Sys::Virt::DomainSnapshot::DELETE_METADATA_ONLY);
    }
    # Now migrate the domain itself. We can either do a live migration if the domain is active
    if ($locdom->is_active){
      $locdom->migrate($remote, Sys::Virt::Domain::MIGRATE_LIVE | Sys::Virt::Domain::MIGRATE_PERSIST_DEST);
    }
    # Or an offline migration
    else{
      $locdom->migrate($remote, Sys::Virt::Domain::MIGRATE_OFFLINE | Sys::Virt::Domain::MIGRATE_PERSIST_DEST);
    }
  }
}