[Tools] testbot: Separate the Libvirt operations from the VM class.
Francois Gouget
fgouget at codeweavers.com
Wed Oct 4 05:37:57 CDT 2017
Libvirt operations can be slow and should be avoided in the
single-threaded Engine server. Separating them from the VM class makes
the issues more apparent.
The new architecture also resets the Libvirt connection whenever a
Libvirt error occurs.
Signed-off-by: Francois Gouget <fgouget at codeweavers.com>
---
A bit plus is that the Libvirt connection resetting part makes it
possible to put VMs back online without having to restart the TestBot
server. All that's needed is to set the VM status to dirty (safest
choice but other values like off can work too) in the VM management
dialog.
I later patches I'll introduce code to automate that part, and also to
avoid blocking calls in the TestBot server.
testbot/bin/Engine.pl | 9 +-
testbot/bin/RevertVM.pl | 5 +-
testbot/bin/WineRunBuild.pl | 4 +-
testbot/bin/WineRunReconfig.pl | 8 +-
testbot/bin/WineRunTask.pl | 9 +-
testbot/lib/WineTestBot/Jobs.pm | 8 +-
testbot/lib/WineTestBot/LibvirtDomain.pm | 336 +++++++++++++++++++++++++++++++
testbot/lib/WineTestBot/VMs.pm | 295 ++-------------------------
8 files changed, 377 insertions(+), 297 deletions(-)
create mode 100644 testbot/lib/WineTestBot/LibvirtDomain.pm
diff --git a/testbot/bin/Engine.pl b/testbot/bin/Engine.pl
index 6a052778..34d29f62 100755
--- a/testbot/bin/Engine.pl
+++ b/testbot/bin/Engine.pl
@@ -120,7 +120,7 @@ sub Cleanup(;$$)
# That task's process died somehow.
$Requeue = 1;
}
- elsif (!$Task->VM->IsPoweredOn())
+ elsif (!$Task->VM->GetDomain()->IsPoweredOn())
{
# A running task should have a powered on VM.
$Requeue = 1;
@@ -182,7 +182,8 @@ sub Cleanup(;$$)
next;
}
- if ($VM->IsPoweredOn())
+ my $Domain = $VM->GetDomain();
+ if ($Domain->IsPoweredOn())
{
if ($KillVMs)
{
@@ -201,7 +202,7 @@ sub Cleanup(;$$)
next;
}
LogMsg "Powering off $VMKey\n";
- $VM->PowerOff();
+ $Domain->PowerOff();
}
else
{
@@ -529,7 +530,7 @@ sub HandleGetScreenshot($)
# FIXME: Taking a screenshot leaks libvirt connections, takes a long time and
# blocks the Engine during the whole operation. So live screenshots are
# disabled for now.
- my ($ErrMessage, $ImageSize, $ImageBytes) = ("Screenshotting has been disabled for the time being", undef, undef); #$VM->CaptureScreenImage();
+ my ($ErrMessage, $ImageSize, $ImageBytes) = ("Screenshotting has been disabled for the time being", undef, undef); #$VM->GetDomain()->CaptureScreenImage();
if (defined($ErrMessage))
{
LogMsg "Failed to take screenshot of $VMName: $ErrMessage\n";
diff --git a/testbot/bin/RevertVM.pl b/testbot/bin/RevertVM.pl
index 00a87216..5cbb0bfc 100755
--- a/testbot/bin/RevertVM.pl
+++ b/testbot/bin/RevertVM.pl
@@ -166,7 +166,8 @@ LogMsg "Reverting $VMKey to ", $VM->IdleSnapshot, "\n";
# Some QEmu/KVM versions are buggy and cannot revert a running VM
Debug(Elapsed($Start), " Powering off the VM\n");
-my $ErrMessage = $VM->PowerOff(1);
+my $Domain = $VM->GetDomain();
+my $ErrMessage = $Domain->PowerOff(1);
if (defined $ErrMessage)
{
Error "$ErrMessage\n";
@@ -174,7 +175,7 @@ if (defined $ErrMessage)
}
Debug(Elapsed($Start), " Reverting $VMKey to ", $VM->IdleSnapshot, "\n");
-$ErrMessage = $VM->RevertToSnapshot($VM->IdleSnapshot);
+$ErrMessage = $Domain->RevertToSnapshot();
if (defined($ErrMessage))
{
FatalError "Could not revert $VMKey to " . $VM->IdleSnapshot . ": $ErrMessage\n",
diff --git a/testbot/bin/WineRunBuild.pl b/testbot/bin/WineRunBuild.pl
index 56a92f9f..326ac0cb 100755
--- a/testbot/bin/WineRunBuild.pl
+++ b/testbot/bin/WineRunBuild.pl
@@ -266,7 +266,7 @@ sub FatalTAError($$)
$ErrMessage .= ": ". $TA->GetLastError() if (defined $TA);
# A TestAgent operation failed, see if the VM is still accessible
- my $IsPoweredOn = $VM->IsPoweredOn();
+ my $IsPoweredOn = $VM->GetDomain()->IsPoweredOn();
if (!defined $IsPoweredOn)
{
# The VM host is not accessible anymore so mark the VM as offline and
@@ -302,7 +302,7 @@ if (!$Debug and $VM->Status ne "running")
{
FatalError("The VM is not ready for use (" . $VM->Status . ")\n");
}
-elsif ($Debug and !$VM->IsPoweredOn)
+elsif ($Debug and !$VM->GetDomain()->IsPoweredOn())
{
FatalError("The VM is not powered on\n");
}
diff --git a/testbot/bin/WineRunReconfig.pl b/testbot/bin/WineRunReconfig.pl
index 3cadfe98..d8e007d7 100755
--- a/testbot/bin/WineRunReconfig.pl
+++ b/testbot/bin/WineRunReconfig.pl
@@ -267,7 +267,7 @@ sub FatalTAError($$)
$ErrMessage .= ": ". $TA->GetLastError() if (defined $TA);
# A TestAgent operation failed, see if the VM is still accessible
- my $IsPoweredOn = $VM->IsPoweredOn();
+ my $IsPoweredOn = $VM->GetDomain()->IsPoweredOn();
if (!defined $IsPoweredOn)
{
# The VM host is not accessible anymore so mark the VM as offline and
@@ -303,7 +303,7 @@ if (!$Debug and $VM->Status ne "running")
{
FatalError("The VM is not ready for use (" . $VM->Status . ")\n");
}
-elsif ($Debug and !$VM->IsPoweredOn)
+elsif ($Debug and !$VM->GetDomain()->IsPoweredOn())
{
FatalError("The VM is not powered on\n");
}
@@ -446,7 +446,7 @@ FatalTAError(undef, $TAError) if (defined $TAError);
if ($NewStatus eq 'completed')
{
Debug(Elapsed($Start), " Deleting the old ", $VM->IdleSnapshot, " snapshot\n");
- $ErrMessage = $VM->RemoveSnapshot($VM->IdleSnapshot);
+ $ErrMessage = $VM->GetDomain()->RemoveSnapshot();
if (defined $ErrMessage)
{
# It's not clear if the snapshot is still usable. Rather than try to figure
@@ -455,7 +455,7 @@ if ($NewStatus eq 'completed')
}
Debug(Elapsed($Start), " Recreating the ", $VM->IdleSnapshot, " snapshot\n");
- $ErrMessage = $VM->CreateSnapshot($VM->IdleSnapshot);
+ $ErrMessage = $VM->GetDomain()->CreateSnapshot();
if (defined $ErrMessage)
{
# Without the snapshot the VM is not usable anymore but FatalError() will
diff --git a/testbot/bin/WineRunTask.pl b/testbot/bin/WineRunTask.pl
index 1663c105..618ef8fe 100755
--- a/testbot/bin/WineRunTask.pl
+++ b/testbot/bin/WineRunTask.pl
@@ -63,7 +63,8 @@ sub TakeScreenshot($$)
{
my ($VM, $FullScreenshotFileName) = @_;
- my ($ErrMessage, $ImageSize, $ImageBytes) = $VM->CaptureScreenImage();
+ my $Domain = $VM->GetDomain();
+ my ($ErrMessage, $ImageSize, $ImageBytes) = $Domain->CaptureScreenImage();
if (!defined $ErrMessage)
{
my $OldUMask = umask(002);
@@ -78,7 +79,7 @@ sub TakeScreenshot($$)
}
umask($OldUMask);
}
- elsif ($VM->IsPoweredOn())
+ elsif ($Domain->IsPoweredOn())
{
Error "Could not capture a screenshot: $ErrMessage\n";
}
@@ -305,7 +306,7 @@ sub FatalTAError($$;$)
$ErrMessage .= ": ". $TA->GetLastError() if (defined $TA);
# A TestAgent operation failed, see if the VM is still accessible
- my $IsPoweredOn = $VM->IsPoweredOn();
+ my $IsPoweredOn = $VM->GetDomain()->IsPoweredOn();
if (!defined $IsPoweredOn)
{
# The VM host is not accessible anymore so mark the VM as offline and
@@ -347,7 +348,7 @@ if (!$Debug and $VM->Status ne "running")
{
FatalError("The VM is not ready for use (" . $VM->Status . ")\n");
}
-elsif ($Debug and !$VM->IsPoweredOn)
+elsif ($Debug and !$VM->GetDomain()->IsPoweredOn())
{
FatalError("The VM is not powered on\n");
}
diff --git a/testbot/lib/WineTestBot/Jobs.pm b/testbot/lib/WineTestBot/Jobs.pm
index 39f9c185..99767940 100644
--- a/testbot/lib/WineTestBot/Jobs.pm
+++ b/testbot/lib/WineTestBot/Jobs.pm
@@ -1,6 +1,6 @@
# -*- Mode: Perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
# Copyright 2009 Ge van Geldorp
-# Copyright 2012-2014 Francois Gouget
+# Copyright 2012-2017 Francois Gouget
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
@@ -575,7 +575,8 @@ sub ScheduleOnHost($$$)
if (!exists $VMsToRevert{$VMKey})
{
my $VM = $HostVMs->GetItem($VMKey);
- my $ErrMessage = $VM->PowerOff();
+ # FIXME Domain operations can be slow and should not be run by the Engine
+ my $ErrMessage = $VM->GetDomain()->PowerOff();
return $ErrMessage if (defined $ErrMessage);
}
}
@@ -592,7 +593,8 @@ sub ScheduleOnHost($$$)
my $VM = $HostVMs->GetItem($VMKey);
next if (!$IdleVMs{$VMKey});
- my $ErrMessage = $VM->PowerOff();
+ # FIXME Domain operations can be slow and should not be run by the Engine
+ my $ErrMessage = $VM->GetDomain()->PowerOff();
return $ErrMessage if (defined $ErrMessage);
$IdleCount--;
$ActiveCount--;
diff --git a/testbot/lib/WineTestBot/LibvirtDomain.pm b/testbot/lib/WineTestBot/LibvirtDomain.pm
new file mode 100644
index 00000000..d449f9d0
--- /dev/null
+++ b/testbot/lib/WineTestBot/LibvirtDomain.pm
@@ -0,0 +1,336 @@
+# -*- Mode: Perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# Copyright 2017 Francois Gouget
+#
+# This library is free software; you can redistribute it and/or
+# modify it under the terms of the GNU Lesser General Public
+# License as published by the Free Software Foundation; either
+# version 2.1 of the License, or (at your option) any later version.
+#
+# This library is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# Lesser General Public License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public
+# License along with this library; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
+
+use strict;
+
+package LibvirtDomain;
+
+=head1 NAME
+
+WineTestBot::LibvirtDomain - A Libvirt VM instance
+
+=head1 DESCRIPTION
+
+This provides methods for starting, stopping, getting the status of the
+Libvirt virtual machine, as well as manipulating its snapshots. These methods
+are implemented through Sys::Virt to provide portability across virtualization
+technologies.
+
+=cut
+
+use Sys::Virt;
+use Image::Magick;
+
+use vars qw (@ISA @EXPORT_OK);
+
+require Exporter;
+ at ISA = qw(Exporter);
+ at EXPORT_OK = qw(new);
+
+my %_Hypervisors;
+my %_Domains;
+
+sub new($$)
+{
+ my ($class, $VM) = @_;
+
+ my $self = { VM => $VM };
+ $self = bless $self, $class;
+ return $self;
+}
+
+=pod
+=over 12
+
+=item C<_Reset()>
+
+Resets the connection to this domain's hypervisor. This is meant to be invoked
+after an error to ensure we will start from a clean connection next time,
+rather than keep using a broken or stuck connection.
+
+=back
+=cut
+
+sub _Reset($;)
+{
+ my $self = shift @_;
+
+ my $VirtURI = $self->{VM}->VirtURI;
+ delete $_Domains{$VirtURI};
+ delete $_Hypervisors{$VirtURI};
+ return $_[0] if (!wantarray() and scalar(@_) == 1);
+ return @_;
+}
+
+
+=pod
+=over 12
+
+=item C<_eval_err()>
+
+Returns the message for whichever error happened inside the eval block,
+be it a LibVirt error or a perl one.
+
+=back
+=cut
+
+sub _eval_err()
+{
+ return ref($@) ? $@->message() : $@;
+}
+
+=pod
+=over 12
+
+=item C<_GetHypervisor()>
+
+Creates, caches and returns the Libvirt connection to the hypervisor.
+
+=back
+=cut
+
+sub _GetHypervisor($)
+{
+ my ($self) = @_;
+
+ my $URI = $self->{VM}->VirtURI;
+ my $Hypervisor = $_Hypervisors{$URI};
+ if (!$Hypervisor)
+ {
+ eval { $Hypervisor = Sys::Virt->new(uri => $URI) };
+ return (_eval_err(), undef) if ($@);
+
+ $_Hypervisors{$URI} = $Hypervisor;
+ }
+ return (undef, $Hypervisor);
+}
+
+=pod
+=over 12
+
+=item C<_GetDomain()>
+
+Creates, caches and returns the Libvirt Domain object.
+
+If an error occurs this resets the hypervisor connection.
+
+=back
+=cut
+
+sub _GetDomain($)
+{
+ my ($self) = @_;
+
+ my $URI = $self->{VM}->VirtURI;
+ my $Name = $self->{VM}->VirtDomain;
+ my $Domain = $_Domains{$URI}->{$Name};
+ if (!$Domain)
+ {
+ my ($ErrMessage, $Hypervisor) = $self->_GetHypervisor();
+ return ($ErrMessage, undef) if (defined $ErrMessage);
+
+ eval { $Domain = $Hypervisor->get_domain_by_name($Name) };
+ return $self->_Reset(_eval_err(), undef) if ($@);
+
+ $_Domains{$URI}->{$Name} = $Domain;
+ }
+ return (undef, $Domain);
+}
+
+sub _UpdateStatus($$)
+{
+ my ($self, $Domain) = @_;
+
+ return undef if ($self->{VM}->Status eq "offline");
+
+ my ($State, $Reason);
+ eval { ($State, $Reason) = $Domain->get_state() };
+ return $self->_Reset(_eval_err()) if ($@);
+
+ if ($State == Sys::Virt::Domain::STATE_SHUTDOWN or
+ $State == Sys::Virt::Domain::STATE_SHUTOFF or
+ $State == Sys::Virt::Domain::STATE_CRASHED)
+ {
+ $self->{VM}->Status("off");
+ $self->{VM}->Save();
+ }
+ elsif ($self->{VM}->Status eq "off")
+ {
+ $self->{VM}->Status("dirty");
+ $self->{VM}->Save();
+ }
+
+ return undef;
+}
+
+sub _GetSnapshot($$)
+{
+ my ($self, $SnapshotName) = @_;
+
+ my ($ErrMessage, $Domain) = $self->_GetDomain();
+ return $ErrMessage if (defined $ErrMessage);
+
+ my $Snapshot;
+ eval
+ {
+ # Work around the lack of get_snapshot_by_name() in older libvirt versions.
+ foreach my $Snap ($Domain->list_snapshots())
+ {
+ if ($Snap->get_name() eq $SnapshotName)
+ {
+ $Snapshot = $Snap;
+ last;
+ }
+ }
+ };
+ return (undef, $Domain, $Snapshot) if ($Snapshot);
+
+ return (_eval_err() || "Snapshot '$SnapshotName' not found", undef, undef);
+}
+
+sub RevertToSnapshot($)
+{
+ my ($self) = @_;
+
+ my $SnapshotName = $self->{VM}->IdleSnapshot;
+ my ($ErrMessage, $Domain, $Snapshot) = $self->_GetSnapshot($SnapshotName);
+ return $ErrMessage if (defined $ErrMessage);
+
+ eval { $Snapshot->revert_to(Sys::Virt::DomainSnapshot::REVERT_RUNNING) };
+ return $@ ? $self->_Reset(_eval_err()) : $self->_UpdateStatus($Domain);
+}
+
+sub CreateSnapshot($)
+{
+ my ($self) = @_;
+
+ my ($ErrMessage, $Domain) = $self->_GetDomain();
+ return $ErrMessage if (defined $ErrMessage);
+
+ my $SnapshotName = $self->{VM}->IdleSnapshot;
+ # FIXME: XML escaping
+ my $Xml = "<domainsnapshot><name>$SnapshotName</name></domainsnapshot>";
+ eval { $Domain->create_snapshot($Xml, 0) };
+ return $@ ? $self->_Reset(_eval_err()) : undef;
+}
+
+sub RemoveSnapshot($)
+{
+ my ($self) = @_;
+
+ my $SnapshotName = $self->{VM}->IdleSnapshot;
+ my ($ErrMessage, $_Domain, $Snapshot) = $self->_GetSnapshot($SnapshotName);
+ return $ErrMessage if (defined $ErrMessage);
+
+ eval { $Snapshot->delete(0) };
+ return $@ ? $self->_Reset(_eval_err()) : undef;
+}
+
+sub IsPoweredOn($)
+{
+ my ($self) = @_;
+
+ my ($ErrMessage, $Domain) = $self->_GetDomain();
+ if (defined $ErrMessage)
+ {
+ $@ = $ErrMessage;
+ return undef;
+ }
+
+ my $IsActive;
+ eval { $IsActive = $Domain->is_active() };
+ return $@ ? $self->_Reset(undef) : $IsActive;
+}
+
+sub PowerOff($$)
+{
+ my ($self, $NoStatus) = @_;
+
+ my ($ErrMessage, $Domain) = $self->_GetDomain();
+ return $ErrMessage if (defined $ErrMessage);
+
+ if ($self->IsPoweredOn())
+ {
+ eval { $Domain->destroy() };
+ if ($@)
+ {
+ $ErrMessage = _eval_err();
+ }
+ elsif ($self->IsPoweredOn())
+ {
+ $ErrMessage = "The VM is still active";
+ }
+ }
+ $ErrMessage ||= $self->_UpdateStatus($Domain) if (!$NoStatus);
+ return undef if (!defined $ErrMessage);
+
+ return $self->_Reset("Could not power off ". $self->{VM}->Name .": $ErrMessage");
+}
+
+my %_StreamData;
+
+sub _Stream2Image($$$)
+{
+ my ($Stream, $Data, $Size) = @_;
+ my $Image = $_StreamData{$Stream};
+ $Image->{Size} += $Size;
+ $Image->{Bytes} .= $Data;
+ return $Size;
+}
+
+sub CaptureScreenImage($)
+{
+ my ($self) = @_;
+
+ my ($ErrMessage, $Domain) = $self->_GetDomain();
+ return ($ErrMessage, undef, undef) if (defined $ErrMessage);
+
+ my $Hypervisor;
+ ($ErrMessage, $Hypervisor) = $self->_GetHypervisor();
+ return ($ErrMessage, undef, undef) if (defined $ErrMessage);
+
+ my $Stream;
+ my $Image = {Size => 0, Bytes => ""};
+ eval
+ {
+ $Stream = $Hypervisor->new_stream(0);
+ if ($Stream)
+ {
+ $_StreamData{$Stream} = $Image;
+ $Domain->screenshot($Stream, 0, 0);
+ $Stream->recv_all(\&LibvirtDomain::_Stream2Image);
+ $Stream->finish();
+ }
+ };
+ delete $_StreamData{$Stream} if ($Stream);
+ return $self->_Reset(_eval_err(), undef, undef) if ($@);
+
+ # The screenshot format depends on the hypervisor (e.g. PPM for QEmu)
+ # but callers expect PNG images.
+ my $image=Image::Magick->new();
+ my ($width, $height, $size, $format) = $image->Ping(blob => $Image->{Bytes});
+ if ($format ne "PNG")
+ {
+ my @blobs = ($Image->{Bytes});
+ $image->BlobToImage(@blobs);
+ $Image->{Bytes} = ($image->ImageToBlob(magick => 'png'))[0];
+ $Image->{Size} = length($Image->{Bytes});
+ }
+ return (undef, $Image->{Size}, $Image->{Bytes});
+}
+
+1;
diff --git a/testbot/lib/WineTestBot/VMs.pm b/testbot/lib/WineTestBot/VMs.pm
index d6bb537a..7e861e3b 100644
--- a/testbot/lib/WineTestBot/VMs.pm
+++ b/testbot/lib/WineTestBot/VMs.pm
@@ -1,6 +1,6 @@
# -*- Mode: Perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
# Copyright 2009 Ge van Geldorp
-# Copyright 2012-2014 Francois Gouget
+# Copyright 2012-2017 Francois Gouget
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
@@ -18,76 +18,6 @@
use strict;
-package WineTestBot::VM::Hypervisors;
-
-=head1 NAME
-
-WineTestBot::VM::Hypervisors - A cache of hypervisor objects
-
-=head1 DESCRIPTION
-
-A hypervisor is the software running on the host that handles the hardware
-virtualisation in support of the VMs. Thus each host has its own hypervisor,
-but some may have more than one, typically if more than one virtualisation
-software is used such as QEmu and VirtualBox.
-
-WineTestBot typically needs to deal with many VMs spread across a few hosts to
-spread the load and thus a few hypervisors. WineTestBot identifies the
-hypervisors via their VirtURI from which we get a Sys::Virt hypervisor.
-This class caches these objects so only one is created per URI.
-
-=cut
-
-use URI;
-
-use WineTestBot::Config;
-
-use vars qw (@ISA @EXPORT_OK);
-
-require Exporter;
- at ISA = qw(Exporter);
-
- at EXPORT_OK = qw(new);
-
-my $Singleton;
-sub new($)
-{
- my ($class) = @_;
-
- if (!defined $Singleton)
- {
- $Singleton = {};
- $Singleton = bless $Singleton, $class;
- }
- return $Singleton;
-}
-
-=pod
-=over 12
-
-=head1 C<GetHypervisor()>
-
-Returns the Sys::Virt hypervisor object corresponding to the specified URI.
-This object is cached so only one hypervisor object is created per URI.
-
-=back
-=cut
-
-sub GetHypervisor($$)
-{
- my ($self, $URI) = @_;
-
- my $Key = $URI || "";
- if (!defined $self->{$Key})
- {
- eval { $self->{$Key} = Sys::Virt->new(uri => $URI); };
- return ($@->message(), undef) if ($@);
- }
-
- return (undef, $self->{$Key});
-}
-
-
package WineTestBot::VM;
=head1 NAME
@@ -96,14 +26,20 @@ WineTestBot::VM - A VM instance
=head1 DESCRIPTION
-This provides methods for starting, stopping, getting the status of the VM,
-as well as manipulating its snapshots. These methods are implemented through
-Sys::Virt to provide portability across virtualization technologies.
+A VM defines the environment a test will be run on, that is, typically, a
+specific virtual machine snapshot.
+
+This class provides access to the properties identifying this environment, its
+intended use and current state.
-This class also provides methods to copy files to or from the VM and running
-commands in it. This part is used to start the tasks in the VM but is
-implemented independently from the VM's hypervisor since most do not provide
-this functionality.
+The GetDomain() method returns an object that can be used to start, stop, or
+get the status of the VM, as well as manipulate its snapshots.
+
+And the GetAgent() method returns a TestAgent instance configured for that VM.
+This object can be used to copy files to or from the VM and to run commands in
+it. This part is used to start the tasks in the VM but is implemented
+independently from the VM's hypervisor since most do not provide this
+functionality.
The VM type defines what it can do:
@@ -206,12 +142,10 @@ are undergoing maintenance.
=cut
-use Sys::Virt;
-use Image::Magick;
-
use ObjectModel::BackEnd;
use WineTestBot::Config;
use WineTestBot::Engine::Notify;
+use WineTestBot::LibvirtDomain;
use WineTestBot::TestAgent;
use WineTestBot::WineTestBotObjects;
@@ -226,9 +160,6 @@ sub _initialize($$)
$self->SUPER::_initialize($VMs);
- $self->{Hypervisors} = $VMs->{Hypervisors};
- $self->{Hypervisor} = undef;
- $self->{Domain} = undef;
$self->{OldStatus} = undef;
}
@@ -251,151 +182,11 @@ sub GetHost($)
return "localhost";
}
-sub _GetDomain($)
-{
- my ($self) = @_;
-
- if (!defined $self->{Domain})
- {
- my ($ErrMessage, $Hypervisor) = $self->{Hypervisors}->GetHypervisor($self->VirtURI);
- return ($ErrMessage, undef) if (defined $ErrMessage);
-
- $self->{Hypervisor} = $Hypervisor;
- eval { $self->{Domain} = $self->{Hypervisor}->get_domain_by_name($self->VirtDomain) };
- return ($@->message(), undef) if ($@);
- }
- return (undef, $self->{Domain});
-}
-
-sub UpdateStatus($$)
-{
- my ($self, $Domain) = @_;
-
- if ($self->Status eq "offline")
- {
- return undef;
- }
-
- my ($State, $Reason) = $Domain->get_state();
- return $@->message() if ($@);
- if ($State == Sys::Virt::Domain::STATE_SHUTDOWN or
- $State == Sys::Virt::Domain::STATE_SHUTOFF)
- {
- $self->Status("off");
- $self->Save();
- }
-
- return undef;
-}
-
-sub _GetSnapshot($$)
-{
- my ($self, $SnapshotName) = @_;
-
- my ($ErrMessage, $Domain) = $self->_GetDomain();
- return $ErrMessage if (defined $ErrMessage);
-
- my $Snapshot;
- eval {
- # Work around the lack of get_snapshot_by_name() in older libvirt versions.
- foreach my $Snap ($Domain->list_snapshots())
- {
- if ($Snap->get_name() eq $SnapshotName)
- {
- $Snapshot = $Snap;
- last;
- }
- }
- };
- return ("Snapshot '$SnapshotName' not found", undef, undef) if (!defined $Snapshot);
- return (undef, $Domain, $Snapshot);
-}
-
-sub RevertToSnapshot($$)
-{
- my ($self, $SnapshotName) = @_;
-
- my ($ErrMessage, $Domain, $Snapshot) = $self->_GetSnapshot($SnapshotName);
- return $ErrMessage if (defined $ErrMessage);
- eval { $Snapshot->revert_to(Sys::Virt::DomainSnapshot::REVERT_RUNNING) };
- return $@->message() if ($@);
-
- return $self->UpdateStatus($Domain);
-}
-
-sub CreateSnapshot($$)
-{
- my ($self, $SnapshotName) = @_;
-
- my ($ErrMessage, $Domain) = $self->_GetDomain();
- return $ErrMessage if (defined $ErrMessage);
-
- # FIXME: XML escaping
- my $Xml = "<domainsnapshot><name>$SnapshotName</name></domainsnapshot>";
- eval { $Domain->create_snapshot($Xml, 0) };
- return $@->message() if ($@);
- return undef;
-}
-
-sub RemoveSnapshot($$)
-{
- my ($self, $SnapshotName) = @_;
-
- my ($ErrMessage, $Domain, $Snapshot) = $self->_GetSnapshot($SnapshotName);
- return $ErrMessage if (defined $ErrMessage);
-
- eval { $Snapshot->delete(0) };
- return $@->message() if ($@);
- return undef;
-}
-
-sub IsPoweredOn($)
+sub GetDomain($)
{
my ($self) = @_;
- my ($ErrMessage, $Domain) = $self->_GetDomain();
- return undef if (defined $ErrMessage);
- my $IsActive;
- eval { $IsActive = $Domain->is_active() };
- return undef if ($@);
- return $IsActive;
-}
-
-sub PowerOn($)
-{
- my ($self) = @_;
-
- my ($ErrMessage, $Domain) = $self->_GetDomain();
- return $ErrMessage if (defined $ErrMessage);
-
- eval { $Domain->create(0) };
- return $@->message() if ($@);
-
- return $self->UpdateStatus($Domain);
-}
-
-sub PowerOff($$)
-{
- my ($self, $NoStatus) = @_;
-
- my ($ErrMessage, $Domain) = $self->_GetDomain();
- return $ErrMessage if (defined $ErrMessage);
-
- if ($self->IsPoweredOn())
- {
- eval { $Domain->destroy() };
- if ($@)
- {
- $ErrMessage = $@->message();
- }
- elsif ($self->IsPoweredOn())
- {
- $ErrMessage = "The VM is still active";
- }
- }
- $ErrMessage ||= $self->UpdateStatus($Domain) if (!$NoStatus);
- return undef if (!defined $ErrMessage);
- return join("", "Could not power off ", $self->Name, ": ", $ErrMessage);
+ return LibvirtDomain->new($self);
}
sub GetAgent($)
@@ -418,52 +209,6 @@ sub GetAgent($)
return TestAgent->new($self->Hostname, $AgentPort, $TunnelInfo);
}
-my %StreamData;
-
-sub _Stream2Image($$$)
-{
- my ($Stream, $Data, $Size) = @_;
- my $Image = $StreamData{$Stream};
- $Image->{Size} += $Size;
- $Image->{Bytes} .= $Data;
- return $Size;
-}
-
-sub CaptureScreenImage($)
-{
- my ($self) = @_;
-
- my ($ErrMessage, $Domain) = $self->_GetDomain();
- return ($ErrMessage, undef, undef) if (defined $ErrMessage);
-
- my $Stream;
- eval { $Stream = $self->{Hypervisor}->new_stream(0) };
- return ($@->message(), undef, undef) if ($@);
-
- my $Image={Size => 0, Bytes => ""};
- $StreamData{$Stream}=$Image;
- eval {
- $Domain->screenshot($Stream, 0, 0);
- $Stream->recv_all(\&WineTestBot::VM::_Stream2Image);
- $Stream->finish();
- };
- delete $StreamData{$Stream};
- return ($@->message(), undef, undef) if ($@);
-
- # The screenshot format depends on the hypervisor (e.g. PPM for QEmu)
- # but callers expect PNG images.
- my $image=Image::Magick->new();
- my ($width, $height, $size, $format) = $image->Ping(blob => $Image->{Bytes});
- if ($format ne "PNG")
- {
- my @blobs=($Image->{Bytes});
- $image->BlobToImage(@blobs);
- $Image->{Bytes}=($image->ImageToBlob(magick => 'png'))[0];
- $Image->{Size}=length($Image->{Bytes});
- }
- return (undef, $Image->{Size}, $Image->{Bytes});
-}
-
sub Status($;$)
{
my ($self, $NewStatus) = @_;
@@ -571,12 +316,6 @@ require Exporter;
@ISA = qw(WineTestBot::WineTestBotCollection Exporter);
@EXPORT = qw(&CreateVMs);
-sub _initialize($)
-{
- my ($self) = @_;
- $self->{Hypervisors} = WineTestBot::VM::Hypervisors->new();
- $self->SUPER::_initialize();
-}
BEGIN
{
--
2.14.1
More information about the wine-patches
mailing list