KVM.pm

package Ravada::Domain::KVM;

use warnings;
use strict;

=head2 NAME

Ravada::Domain::KVM - KVM Virtual Machines library for Ravada

=cut

use Carp qw(cluck confess croak);
use Data::Dumper;
use File::Copy;
use File::Path qw(make_path);
use Hash::Util qw(lock_keys lock_hash);
use IPC::Run3 qw(run3);
use MIME::Base64;
use Moose;
use Sys::Virt::Stream;
use Sys::Virt::Domain;
use Sys::Virt;
use XML::LibXML;

no warnings "experimental::signatures";
use feature qw(signatures);

extends 'Ravada::Front::Domain::KVM';
with 'Ravada::Domain';

has 'domain' => (
      is => 'rw'
    ,isa => 'Sys::Virt::Domain'
    ,required => 0
);

has '_vm' => (
    is => 'rw'
    ,isa => 'Ravada::VM::KVM'
    ,required => 0
);

has readonly => (
    isa => 'Int'
    ,is => 'rw'
    ,default => 0
);

##################################################
#
our $TIMEOUT_SHUTDOWN = 60;
our $TIMEOUT_REBOOT = 60;
our $OUT;

our %SET_DRIVER_SUB = (
    network => \&_set_driver_network
     ,sound => \&_set_driver_sound
     ,video => \&_set_driver_video
     ,image => \&_set_driver_image
     ,jpeg => \&_set_driver_jpeg
     ,zlib => \&_set_driver_zlib
     ,playback => \&_set_driver_playback
     ,streaming => \&_set_driver_streaming
     ,disk => \&_set_driver_disk
);

our %GET_CONTROLLER_SUB = (
    usb => \&_get_controller_usb
    ,disk => \&_get_controller_disk
    ,network => \&_get_controller_network
    );
our %SET_CONTROLLER_SUB = (
    usb => \&_set_controller_usb
    ,disk => \&_set_controller_disk
    ,network => \&_set_controller_network
    );
our %REMOVE_CONTROLLER_SUB = (
    usb => \&_remove_controller_usb
    ,disk => \&_remove_controller_disk
    ,network => \&_remove_controller_network
    );

our %CHANGE_HARDWARE_SUB = (
    disk => \&_change_hardware_disk
    ,vcpus => \&_change_hardware_vcpus
    ,memory => \&_change_hardware_memory
    ,network => \&_change_hardware_network
);
##################################################

sub BUILD {
    my ($self, $arg) = @_;
    $self->readonly( $arg->{readonly} or 0);
}


=head2 name

Returns the name of the domain

=cut

sub name {
    my $self = shift;

    return $self->domain->get_name if $self->domain;

    confess "ERROR: Unknown domain name";
}

=head2 list_disks

Returns a list of the disks used by the virtual machine. CDRoms are not included

  my@ disks = $domain->list_disks();

=cut

sub list_disks {
    my $self = shift;
    my @disks = ();

    my $doc = XML::LibXML->load_xml(string => $self->xml_description);

    for my $disk ($doc->findnodes('/domain/devices/disk')) {
        next if $disk->getAttribute('device') ne 'disk';

        for my $child ($disk->childNodes) {
            if ($child->nodeName eq 'source') {
                my $file = $child->getAttribute('file');
                next if $file =~ /\.iso$/;
                push @disks,($file);
            }
        }
    }
    return @disks;
}

sub xml_description($self, $inactive=0) {
    return $self->_data_extra('xml')
        if ($self->is_removed || !$self->domain )
            && $self->is_known;

    confess "ERROR: KVM domain not available ".$self->is_known   if !$self->domain;
    my $xml;
    eval {
        my @flags;
        @flags = ( Sys::Virt::Domain::XML_INACTIVE ) if $inactive;

        $xml = $self->domain->get_xml_description(@flags);
        $self->_data_extra('xml', $xml) if $self->is_known
                                        && ( $inactive
                                                || !$self->_data_extra('xml')
                                                || !$self->is_active
                                        );
    };
    confess $@ if $@ && $@ !~ /libvirt error code: 42/;
    if ( $@ ) {
        return $self->_data_extra('xml');
    }
    return $xml;
}

sub xml_description_inactive($self) {
    return $self->xml_description(1);
}

=head2 remove_disks

Remove the volume files of the domain

=cut

sub remove_disks {
    my $self = shift;

    my $removed = 0;

    my $id;
    eval { $id = $self->id };
    return if $@ && $@ =~ /No DB info/i;
    confess $@ if $@;

    $self->_vm->connect();
    for my $file ($self->list_disks( device => 'disk')) {
        if (! $self->_vm->file_exists($file) ) {
            next;
        }
        eval {
        $self->_vol_remove($file);
        $self->_vol_remove($file);
        };
        warn "Error: removing $file $@" if $@;
#        if ( -e $file ) {
#            unlink $file or die "$! $file";
#        }
        $removed++;

    }
    return if $self->is_removed;
    warn "WARNING: No disk files removed for ".$self->domain->get_name."\n"
            .Dumper([$self->list_disks])
        if !$removed && $0 !~ /\.t$/;

}

=head2 pre_remove_domain

Cleanup operations executed before removing this domain

    $self->pre_remove_domain

=cut

sub pre_remove_domain {
    my $self = shift;
    return if $self->is_removed;
    $self->xml_description();
    $self->domain->managed_save_remove()    if $self->domain->has_managed_save_image;
}

sub _vol_remove {
    my $self = shift;
    my $file = shift;
    my $warning = shift;

    confess "Error: I won't remove an iso file " if $file =~ /\.iso$/i;

    my $name;
    ($name) = $file =~ m{.*/(.*)}   if $file =~ m{/};

    my $removed = 0;
    for my $pool ( $self->_vm->vm->list_storage_pools ) {
        _pool_refresh($pool);
        my $vol;
        eval { $vol = $pool->get_volume_by_name($name) };
        if (! $vol ) {
            warn "VOLUME $name not found in $pool \n".($@ or '')
                if $@ !~ /libvirt error code: 50,/i;
            next;
        }
        for ( ;; ) {
            eval { $vol->delete() };
            last if !$@;
            sleep 1;
        }
        eval { $pool->refresh };
        warn $@ if $@;
    }
    return 1;
}

sub remove_volume {
    return _vol_remove(@_);
}

=head2 remove

Removes this domain. It removes also the disk drives and base images.

=cut

sub remove {
    my $self = shift;
    my $user = shift;

    my @volumes;
    if (!$self->is_removed ) {
       my @vols_info;
       for ( 1 .. 10 ) {
           eval { @vols_info = $self->list_volumes_info };
           last if !$@;
           warn "WARNING: remove, volumes info: $@";
           sleep 1;
       }
       for my $vol ( @vols_info ) {
            push @volumes,($vol->{file})
                if exists $vol->{file}
                   && exists $vol->{device}
                   && $vol->{device} eq 'file';
        }
    }

    if (!$self->is_removed && $self->domain && $self->domain->is_active) {
        eval { $self->_do_force_shutdown() };
        warn $@ if $@;
    }

    eval { $self->domain->undefine()    if $self->domain && !$self->is_removed };
    confess $@ if $@ && $@ !~ /libvirt error code: 42/;

    eval { $self->remove_disks() if $self->is_known };
    confess $@ if $@ && $@ !~ /libvirt error code: 42/;

    for my $file ( @volumes ) {
        eval { $self->remove_volume($file) };
        warn $@ if $@;
    }

    eval { $self->_remove_file_image() };
        warn $@ if $@;
    confess $@ if $@ && $@ !~ /libvirt error code: 42/;
#    warn "WARNING: Problem removing file image for ".$self->name." : $@" if $@ && $0 !~ /\.t$/;

#    warn "WARNING: Problem removing ".$self->file_base_img." for ".$self->name
#            ." , I will try again later : $@" if $@;

    # do a post remove but pass the remove flag = 1 ( it is 0 by default )
    $self->_post_remove_base_domain(1) if $self->is_base();

}


sub _remove_file_image {
    my $self = shift;
    for my $file ( $self->list_files_base ) {
        next if $file && $file =~ /\.iso$/i;

        next if !$file || ! -e $file;

        chmod 0770, $file or die "$! chmodding $file";
        chown $<,$(,$file    or die "$! chowning $file";
        eval { $self->_vol_remove($file,1) };
        warn $@ if $@;

        if ( -e $file ) {
            eval {
                unlink $file or die "$! $file" ;
                #TODO: do a refresh of all the storage pools in the VM if anything removed
                $self->_vm->storage_pool->refresh();
            };
            warn $@ if $@;
        }
        next if ! -e $file;
        warn $@ if $@;
    }
}

sub _disk_device($self, $with_info=undef, $attribute=undef, $value=undef) {

    my $doc = XML::LibXML->load_xml(string
            => $self->xml_description(Sys::Virt::Domain::XML_INACTIVE))
        or die "ERROR: $!\n";

    my @img;

    my $n_order = 0;
    for my $disk ($doc->findnodes('/domain/devices/disk')) {
        my ($source_node) = $disk->findnodes('source');
        my $file;
        $file = $source_node->getAttribute('file')  if $source_node;

        my ($target_node) = $disk->findnodes('target');
        my ($driver_node) = $disk->findnodes('driver');
        my ($backing_node) = $disk->findnodes('backingStore');
        my $device = $disk->getAttribute('device');
        my $target = $target_node->getAttribute('dev');
        my $bus = $target_node->getAttribute('bus');

        my ($boot_node) = $disk->findnodes('boot');
        my $info = {};
        eval { $info = $self->_volume_info($file) if $file && $device eq 'disk' };
        die $@ if $@ && $@ !~ /not found/i;
        $info->{device} = $device;
        if (!$info->{name} ) {
            if ($file) {
                ($info->{name}) = $file =~ m{.*/(.*)};
            } else {
                $info->{name} = $target."-".$info->{device};
            }
        }
        $info->{target} = $target;
        # we use driver to make it compatible with other hardware but it is more accurate
        # to say bus
        $info->{driver} = $bus;
        $info->{bus} = $bus;
        $info->{n_order} = $n_order++;
        $info->{boot} = $boot_node->getAttribute('order') if $boot_node;
        $info->{file} = $file if defined $file;
        if ($driver_node) {
            for my $attr  ($driver_node->attributes()) {
                $info->{"driver_".$attr->name} = $attr->getValue();
            }
        }
        $info->{backing} = $backing_node->toString()
        if $backing_node && $backing_node->attributes();

        next if defined $attribute
           && (!exists $info->{$attribute}
                || $info->{$attribute} ne $value);

        if (!$with_info) {
            push @img,($file) if $file;
            next;
        }
        push @img,Ravada::Volume->new(file => $file, info => $info, domain => $self);
    }
    return @img;

}

sub _pool_refresh($pool) {
    for ( ;; ) {
        eval { $pool->refresh };
        return if !$@;
        warn "WARNING: on vol remove , pool refresh $@" if $@;
        sleep 1;
    }
}

sub _volume_info($self, $file, $refresh=0) {
    confess "Error: No vm connected" if !$self->_vm->vm;

    my ($name) = $file =~ m{.*/(.*)};

    my $vol;
    for my $pool ( $self->_vm->vm->list_storage_pools ) {
        _pool_refresh($pool) if $refresh;
        eval { $vol = $pool->get_volume_by_name($name) };
        warn $@ if $@ && $@ !~ /^libvirt error code: 50,/;
        last if $vol;
    }
    if (!$vol && !$refresh) {
        return $self->_volume_info($file, ++$refresh);
    }

    if (!$vol) {
        confess "Error: Volume $file not found ".$self->name;
        return;
    }

    my $info;
    eval { $info = $vol->get_info };
    warn "WARNING: $@" if $@ && $@ !~ /^libvirt error code: 50,/;
    $info->{file} = $file;
    $info->{name} = $name;
    $info->{driver} = delete $info->{bus} if exists $info->{bus};

    return $info;
}

sub _disk_devices_xml {
    my $self = shift;

    my $doc = XML::LibXML->load_xml(string => $self->xml_description)
        or die "ERROR: $!\n";

    my @devices;

    for my $disk ($doc->findnodes('/domain/devices/disk')) {
        my $is_disk = 0;
        for my $child ($disk->childNodes) {
            $is_disk++ if $child->nodeName eq 'source';
        }
        push @devices,($disk) if $is_disk;
    }
    return @devices;

}

=head2 disk_device

Returns the file name of the disk of the domain.

  my $file_name = $domain->disk_device();

=cut

sub disk_device {
    my $self = shift;
    return $self->_disk_device(@_);
}


=head2 pre_prepare_base

Run this before preparing the base. It is necessary to correctly
detect disks drivers for newer libvirts.

This is executed automatically so it shouldn't been called.

=cut

sub pre_prepare_base($self) {
    $self->_detect_disks_driver();
}

=head2 post_prepare_base

Task to run after preparing a base virtual machine

=cut


sub post_prepare_base {
    my $self = shift;

    $self->_set_volumes_backing_store();
    $self->_store_xml();
}

sub _set_volumes_backing_store($self) {
    my $doc = XML::LibXML->load_xml(string
            => $self->xml_description(Sys::Virt::Domain::XML_INACTIVE))
        or die "ERROR: $!\n";

    my @volumes_info = grep { defined($_) && $_->file } $self->list_volumes_info;
    my %vol = map { $_->file => $_ } @volumes_info;
    for my $disk ($doc->findnodes('/domain/devices/disk')) {
        next if $disk->getAttribute('device') ne 'disk';
        for my $source( $disk->findnodes('source')) {
            my $file = $source->getAttribute('file');
            my $backing_file = $vol{$file}->backing_file();


            my ($backing_store) = $disk->findnodes('backingStore');
            if ($backing_file) {
                my $vol_backing_file = Ravada::Volume->new(
                    file => $backing_file
                    ,vm => $self->_vm
                );
                my $backing_file_format = (
                    $vol_backing_file->_qemu_info('file format')
                        or 'qcow2'
                );

                $backing_store = $disk->addNewChild(undef,'backingStore') if !$backing_store;
                $backing_store->setAttribute('type' => 'file');

                my ($format) = $backing_store->findnodes('format');
                $format = $backing_store->addNewChild(undef,'format') if !$format;
                $format->setAttribute('type' => $backing_file_format);

                my ($source_bf) = $backing_store->findnodes('source');
                $source_bf = $backing_store->addNewChild(undef,'source') if !$source_bf;
                $source_bf->setAttribute('file' => $backing_file);
            } else {
                $disk->removeChild($backing_store) if $backing_store;
                $backing_store = $disk->addNewChild(undef,'backingStore') if !$backing_store;
            }

        }
    }
    $self->_post_change_hardware($doc);
}


sub _store_xml($self) {
    my $xml = $self->domain->get_xml_description(Sys::Virt::Domain::XML_INACTIVE);
    my $sth = $self->_dbh->prepare(
        "INSERT INTO base_xml (id_domain, xml) "
        ." VALUES ( ?,? ) "
    );
    $sth->execute($self->id , $xml);
    $sth->finish;
}

=head2 get_xml_base

Returns the XML definition for the base, only if prepare_base has been run befor

=cut

sub get_xml_base{

    my $self = shift;
    my $sth = $self->_dbh->prepare(
        "SELECT xml FROM base_xml WHERE id_domain=?"
    );
    $sth->execute($self->id);
    my $xml = $sth->fetchrow;
    return ($xml or $self->domain->get_xml_description);
}

sub _post_remove_base_domain($self, $remove=0) {
    my $sth = $self->_dbh->prepare(
        "DELETE FROM base_xml WHERE id_domain=?"
    );
    $sth->execute($self->id);

    if (!$remove) {
        $self->_set_volumes_backing_store();
        $self->_detect_disks_driver();
    }
}

sub _detect_disks_driver($self) {
    my $doc = XML::LibXML->load_xml(string
        => $self->xml_description(Sys::Virt::Domain::XML_INACTIVE))
        or die "ERROR: $!\n";

    my @img;

    my @vols = $self->list_volumes_info();

    my $n_order = 0;
    for my $disk ($doc->findnodes('/domain/devices/disk')) {
        next if $disk->getAttribute('device') ne 'disk';
        my ( $driver ) = $disk->findnodes('driver');
        my ( $source ) = $disk->findnodes('source');

        my $file = $source->getAttribute('file');
        next if $file =~ /iso$/;

        my ($vol) = grep { defined $_->file && $_->file eq $file } @vols;
        my $format = $vol->_qemu_info('file format');
        confess "Error: wrong format ".Dumper($format)." for file $file"
        unless $format =~ /^\w+$/;

        confess "Error: no file format for $file" if !$format;
        $driver->setAttribute(type => $format);
    }

    $self->_post_change_hardware($doc);
}

sub post_resume_aux($self, %args) {
    my $set_time = delete $args{set_time};
    $set_time = 1 if !defined $set_time;
    eval {
        $self->set_time() if $set_time;
    };
    # 55: domain is not running
    # 74: not configured
    # 86: no agent
    die "$@\n" if $@ && $@ !~ /libvirt error code: (55|74|86),/;
}

sub set_time($self) {
    my $time = time();
    $self->domain->set_time($time, 0, 0);
}

=head2 display_info

Returns the display information as a hashref. The display URI is in the display entry

=cut

sub display_info($self, $user) {

    my $xml = XML::LibXML->load_xml(string => $self->xml_description);
    my ($graph) = $xml->findnodes('/domain/devices/graphics')
        or die "ERROR: I can't find graphic";

    my ($type) = $graph->getAttribute('type');
    my ($port) = $graph->getAttribute('port');
    my ($tls_port) = $graph->getAttribute('tlsPort');
    my ($address) = $graph->getAttribute('listen');

    warn "ERROR: Machine ".$self->name." is not active in node ".$self->_vm->name."\n"
        if !$port && !$self->is_active;


    my %display = (
                type => $type
               ,port => $port
                 ,ip => $address
          ,tls_port => $tls_port
    );
    $port = '' if !defined $port;
    my $display = $type."://$address:$port";
    $display{display} = $display;
    lock_hash(%display);
    return \%display;
}

=head2 is_active

Returns whether the domain is running or not

=cut

sub is_active {
    my $self = shift;
    return 0 if $self->is_removed;
    my $is_active = 0;
    eval { $is_active = $self->domain->is_active };
    return 0 if $@ && (    $@->code == 1    # client socket is closed
                        || $@->code == 38   # broken pipe
                    );
    die $@ if $@ && $@ !~ /code: 42,/;
    return $is_active;
}

=head2 is_persistent

Returns wether the domain has a persistent configuration file

=cut

sub is_persistent($self) {
    return $self->domain->is_persistent;
}

=head2 start

Starts the domain

=cut

sub start {
    my $self = shift;
    my %arg;

    if (!(scalar(@_) % 2))  {
        %arg = @_;
    }

    my $remote_ip = delete $arg{remote_ip};
    my $request = delete $arg{request};
    my $listen_ip = ( delete $arg{listen_ip} or $self->_listen_ip);
    my $set_password = delete $arg{set_password};

    $self->_set_spice_ip($set_password, $listen_ip);

    my $is_active = $self->is_active();
    if (!$is_active) {
        $self->_check_qcow_format($request);
        $self->_set_volumes_backing_store();
        $self->_detect_disks_driver();
    }

    $self->status('starting');

    my $error;
    for ( ;; ) {
        eval { $self->domain->create() };
        $error = $@;
        next if $error && $error =~ /libvirt error code: 1, .* pool .* asynchronous/;
        last;
    }
    return if !$error || $error =~ /already running/i;
    if ($error =~ /libvirt error code: 38,/) {
        die "Error starting ".$self->name." on ".$self->_vm->name
            ."\n$error";
    } elsif ( $error =~ /libvirt error code: 9, .*already defined with uuid/) {
        die "TODO";
    } elsif ( $error =~ /libvirt error code: 1,.*smbios/) {
        $self->_remove_smbios();
        $self->domain->create();
    } elsif ( $self->domain->has_managed_save_image ) {
        $request->status("removing saved image") if $request;
        $self->domain->managed_save_remove();
        $self->domain->create();
    } else {
        die $error;
    }
}

sub _check_qcow_format($self, $request) {
    return if $self->is_active;
    for my $vol ( $self->list_volumes_info ) {
        next if !$vol->file || $vol->file =~ /iso$/;
        next if !$vol->backing_file;

        next if $vol->_qemu_info('backing file format') eq 'qcow2';

        $request->status("rebasing","rebasing to release 0.8 "
            .$vol->file."\n".$vol->backing_file) if $request;
        $vol->rebase($vol->backing_file);
    }
}

sub _remove_smbios($self) {
    my $doc = XML::LibXML->load_xml(string => $self->domain->get_xml_description(Sys::Virt::Domain::XML_INACTIVE));

    my ($os) = $doc->findnodes('/domain/os');
    my ($smbios) = $os->findnodes('smbios');
    $os->removeChild($smbios) if $smbios;

    my $new_domain = $self->_vm->vm->define_domain($doc->toString);
    $self->domain($new_domain);
}

sub _pre_shutdown_domain {
    my $self = shift;

    my ($state, $reason) = $self->domain->get_state();

    if ($state == Sys::Virt::Domain::STATE_PMSUSPENDED_UNKNOWN
         || $state == Sys::Virt::Domain::STATE_PMSUSPENDED_DISK_UNKNOWN
         || $state == Sys::Virt::Domain::STATE_PMSUSPENDED) {
        $self->domain->pm_wakeup();
        for ( 1 .. 10 ) {
            last if $self->is_active;
            sleep 1;
        }
    }

    $self->domain->managed_save_remove()
        if $self->domain->has_managed_save_image();

}

=head2 shutdown

Stops the domain

=cut

sub shutdown {
    my $self = shift;

    my %args = @_;
    my $req = $args{req};

    if (!$self->is_active && !$args{force}) {
        $req->status("done")                if $req;
        $req->error("Domain already down")  if $req;
        return;
    }

    return $self->_do_force_shutdown() if $args{force};
    return $self->_do_shutdown();

}

sub _do_shutdown {
    my $self = shift;
    return if !$self->domain->is_active;
    eval { $self->domain->shutdown() };
    die $@ if $@ && $@ !~ /libvirt error code: 55,/;

}

=head2 shutdown_now

Shuts down uncleanly the domain

=cut

sub shutdown_now {
    my $self = shift;
    return $self->_do_force_shutdown()  if $self->is_active;
}

=head2 force_shutdown

Shuts down uncleanly the domain

=cut

sub force_shutdown{
    my $self = shift;
    return $self->_do_force_shutdown() if $self->is_active;
}

sub _do_force_shutdown {
    my $self = shift;
    return if !$self->domain->is_active;

    eval { $self->domain->destroy   };
    warn $@ if $@;
}

=head2 reboot

Stops the domain

=cut

sub reboot {
    my $self = shift;
    my %args = @_;
    my $req = $args{req};

    if (!$self->is_active) {
        $req->status("done")           if $req;
        $req->error("Domain is down")  if $req;
        return;
    }

    return $self->_do_force_shutdown() if $args{force};
    return $self->_do_reboot();

}

sub force_reboot {
    my $self = shift;
    return $self->_do_force_reboot()  if $self->is_active;
}

sub _do_force_reboot {
    my $self = shift;
    return if !$self->domain->is_active;
    eval { $self->domain->reset() };
    warn $@ if $@;
}

sub _do_reboot {
    my $self = shift;
    return if !$self->domain->is_active;
    eval { $self->domain->reboot() };
    die $@ if $@;
}

=head2 reboot_now

Reboots uncleanly the domain

=cut

sub reboot_now {
    my $self = shift;
    return $self->_do_reboot()  if $self->is_active;
}

=head2 pause

Pauses the domain

=cut

sub pause {
    my $self = shift;
    return $self->domain->suspend();
}

=head2 resume

Resumes a paused the domain

=cut

sub resume {
    my $self = shift;
    eval { $self->domain->resume() };
    confess $@ if $@ && $@ !~ /libvirt error code: 55/;
}


=head2 is_hibernated

Returns if the domain has a managed saved state.

=cut

sub is_hibernated {
    my $self = shift;
    return $self->domain->has_managed_save_image;
}

=head2 is_paused

Returns if the domain is paused

=cut

sub is_paused {
    my $self = shift;
    my ($state, $reason) = $self->domain->get_state();



    return 0 if $state == 1;
    #TODO, find out which one of those id "1" and remove it from this list
    #
    return $state &&
        ($state == Sys::Virt::Domain::STATE_PAUSED_UNKNOWN
        || $state == Sys::Virt::Domain::STATE_PAUSED_USER
        || $state == Sys::Virt::Domain::STATE_PAUSED_DUMP
        || $state == Sys::Virt::Domain::STATE_PAUSED_FROM_SNAPSHOT
        || $state == Sys::Virt::Domain::STATE_PAUSED_IOERROR
        || $state == Sys::Virt::Domain::STATE_PAUSED_MIGRATION
        || $state == Sys::Virt::Domain::STATE_PAUSED_SAVE
        || $state == Sys::Virt::Domain::STATE_PAUSED_SHUTTING_DOWN
    );
    return 0;
}

=head2 can_hybernate

Returns true (1) for KVM domains

=cut

sub can_hybernate { 1 };

=head2 can_hybernate

Returns true (1) for KVM domains

=cut

sub can_hibernate { 1 };

=head2 hybernate

Take a snapshot of the domain's state and save the information to a
managed save location. The domain will be automatically restored with
this state when it is next started.

    $domain->hybernate();

=cut

sub hybernate {
    my $self = shift;
    $self->hibernate(@_);