# HG changeset patch
# User cin
# Date 1479162789 -10800
# Node ID cd5df456ee8403848ad903e6c500722d2f600c3d

Initial working version of minions.pl ans sysyemd units

diff -r 000000000000 -r cd5df456ee84 .includepath
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/.includepath	Tue Nov 15 01:33:09 2016 +0300
@@ -0,0 +1,5 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<includepath>
+  <includepathentry path="${resource_loc:/Minions/lib}" />
+</includepath>
+
diff -r 000000000000 -r cd5df456ee84 .project
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/.project	Tue Nov 15 01:33:09 2016 +0300
@@ -0,0 +1,17 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<projectDescription>
+	<name>Minions</name>
+	<comment></comment>
+	<projects>
+	</projects>
+	<buildSpec>
+		<buildCommand>
+			<name>org.epic.perleditor.perlbuilder</name>
+			<arguments>
+			</arguments>
+		</buildCommand>
+	</buildSpec>
+	<natures>
+		<nature>org.epic.perleditor.perlnature</nature>
+	</natures>
+</projectDescription>
diff -r 000000000000 -r cd5df456ee84 Changes
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Changes	Tue Nov 15 01:33:09 2016 +0300
@@ -0,0 +1,5 @@
+Revision history for Minions
+
+0.01    Date/time
+        First version, released on an unsuspecting world.
+
diff -r 000000000000 -r cd5df456ee84 README
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/README	Tue Nov 15 01:33:09 2016 +0300
@@ -0,0 +1,52 @@
+Minions
+
+The set of tools to manipulate libvirt domains
+
+
+INSTALLATION
+    TODO
+
+USING
+    TODO
+
+
+LICENSE AND COPYRIGHT
+
+Copyright (C) 2016 "sergey"
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of the the Artistic License (2.0). You may obtain a
+copy of the full license at:
+
+L<http://www.perlfoundation.org/artistic_license_2_0>
+
+Any use, modification, and distribution of the Standard or Modified
+Versions is governed by this Artistic License. By using, modifying or
+distributing the Package, you accept this license. Do not use, modify,
+or distribute the Package, if you do not accept this license.
+
+If your Modified Version has been derived from a Modified Version made
+by someone other than you, you are nevertheless required to ensure that
+your Modified Version complies with the requirements of this license.
+
+This license does not grant you the right to use any trademark, service
+mark, tradename, or logo of the Copyright Holder.
+
+This license includes the non-exclusive, worldwide, free-of-charge
+patent license to make, have made, use, offer to sell, sell, import and
+otherwise transfer the Package with respect to any patent claims
+licensable by the Copyright Holder that are necessarily infringed by the
+Package. If you institute patent litigation (including a cross-claim or
+counterclaim) against any party alleging that the Package constitutes
+direct or contributory patent infringement, then this Artistic License
+to you shall terminate on the date that such litigation is filed.
+
+Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
+AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
+THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
+PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
+YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
+CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
+CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
+EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
diff -r 000000000000 -r cd5df456ee84 bin/minions.pl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/minions.pl	Tue Nov 15 01:33:09 2016 +0300
@@ -0,0 +1,379 @@
+#!/usr/bin/perl -T
+use strict;
+use warnings;
+
+package Hive;
+
+package main;
+use Pod::Usage;
+use Getopt::Long qw(:config auto_help);
+use Sys::Virt;
+use Sys::Virt::Domain;
+
+our $VERSION        = 0.1;
+our $CONFIG_FILE    = '/etc/minions/hive.yaml';
+our $STATE_FILE     = '/var/lib/minions/session.yaml';
+our $TIMEOUT        = 300;
+our $PARALLEL       = 0;
+our $RETRY_INTERVAL = 60;
+
+my $tasks = 2;
+my @pending;
+
+my @uri = qw(qemu:///system lxc:///);
+
+my %commands = (
+	stop  => \&doStop,
+	start => \&doStart,
+	help  => \&doHelp
+);
+
+my $cmd = shift @ARGV;
+
+&{ $commands{ lc( $cmd || '' ) } || \&doHelp }(@ARGV);
+
+exit 0;
+
+sub doHelp {
+	print <<END_HELP;
+Minions v.$VERSION manages libvirt domains...
+    stop    [domain[ stop-method]]
+            Stops the specified libvirt domain with the specified method. If the
+            domain isn't specified then stops all domains on all configured
+            connections and saves the list of stopped domains to
+            /var/lib/minions/session.yaml file. 
+            
+    start   [domain]
+            Starts the specified domain, if the domain is ommited restores the
+            previous session from /var/lib/minions/session.yaml and deletes this
+            file.
+    help
+            Prints this help
+            
+    domain must be written in format {connection}.{domain} where {connection} is
+    the one of configured connections from /etc/minions/hive.yaml and {domain}
+    is the name of the libvirt domain.
+END_HELP
+}
+
+sub doStart {
+	my $hive = Hive->new($CONFIG_FILE);
+
+	if ( @_ > 0 ) {
+		if ( my ( $cn, $dn ) = ( $_[0] =~ m/(\w+)\.(\w+)/ ) ) {
+			$hive->startDomain( $cn, $dn );
+		}
+		else {
+			die "Invalid parameter: {connection}.{domain} format is required";
+		}
+	}
+	else {
+		$hive->start();
+	}
+	$hive->waitPending();
+}
+
+sub doStop {
+	my $hive = Hive->new($CONFIG_FILE);
+
+	if ( @_ > 0 ) {
+		if ( my ( $cn, $dn ) = ( $_[0] =~ m/(\w+)\.(\w+)/ ) ) {
+			$hive->stopDomain( $cn, $dn );
+		}
+		else {
+			die "Invalid parameter: {connection}.{domain} format is required";
+		}
+	}
+	else {
+		$hive->stop();
+	}
+
+	$hive->waitPending();
+}
+
+package Hive;
+use fields qw(config vmms _pending);
+use YAML::XS qw(DumpFile LoadFile Dump);
+use Sys::Virt;
+use Sys::Virt::Domain;
+use File::Spec;
+
+BEGIN {
+	no strict 'refs';
+	*{ __PACKAGE__ . "::$_" } = \*{"Sys::Virt::Domain::$_"}
+	  for qw(STATE_SHUTOFF LIST_PERSISTENT LIST_ACTIVE);
+}
+
+sub new {
+	my Hive $this = fields::new(shift);
+	$this->init(@_);
+	return $this;
+}
+
+sub init {
+	my Hive $this = shift;
+	my $file = shift;
+
+	my $config = $this->{config} = LoadFile($file);
+
+	while ( my ( $name, $info ) = each %{ $config->{vmms} || {} } ) {
+		eval {
+			die "Invalid connection info $name"
+			  unless ref($info) and $info->{uri};
+
+			$this->trace_info("Connection '$name': $info->{uri}");
+			$this->{vmms}{$name}{stop} = lc( $info->{stop} || 'shutdown' );
+
+			die "Unsupported stop method: $info->{stop}"
+			  unless grep $_ eq $this->{vmms}{$name}{stop},
+			  qw(suspend shutdown);
+
+			$this->{vmms}{$name}{instance} =
+			  Sys::Virt->new( uri => $info->{uri} );
+		};
+		$this->trace_error("Failed to connect '$name': $@") if $@;
+	}
+}
+
+sub stop {
+	my Hive $this = shift;
+
+	my @pending;
+
+	my %stopped;
+
+	while ( my ( $name, $vmm ) = each %{ $this->{vmms} || {} } ) {
+		next unless $vmm->{instance};
+
+		$this->trace_info("Do $vmm->{stop} for all domains on $name");
+
+		my @domains =
+		  $vmm->{instance}->list_all_domains( LIST_PERSISTENT | LIST_ACTIVE );
+		$stopped{$name} = [ map $_->get_name(), @domains ];
+
+		$this->trace_info( "\t-" . $_->get_name() )
+		  and $this->_safeStop( $_, $vmm->{stop} )
+		  for @domains;
+	}
+
+	my $state = $this->{config}{sate_file} || $STATE_FILE;
+
+	my $dir = ( File::Spec->splitpath($state) )[1];
+	mkdir $dir unless -e $dir;
+
+	DumpFile( $state, \%stopped );
+}
+
+sub start {
+	my Hive $this = shift;
+
+	my $state = $this->{config}{sate_file} || $STATE_FILE;
+	my $session = -f $state ? LoadFile($state) : {};
+
+	while ( my ( $name, $machines ) = each %{$session} ) {
+		my $vmm = $this->{vmms}{$name}
+		  or $this->trace_error(
+			"Failed to resotre session for '$name': no such connection")
+		  and next;
+
+		$this->trace_info("Restoring domains on '$name'");
+		for my $m ( @{ $machines || [] } ) {
+			my $d = $vmm->{instance}->get_domain_by_name($m)
+			  or $this->trace_error("\t-$m not found")
+			  and next;
+
+			eval {
+				$this->trace_info("\t-$m");
+				$this->_safeStart($d);
+			};
+			$this->trace_error("$@") if $@;
+		}
+	}
+
+	unlink $state if -f $state;
+}
+
+sub startDomain {
+	my Hive $this = shift;
+	my ( $cn, $dn ) = @_;
+
+	$this->trace_info("Start $cn.$dn");
+	my $con = $this->{vmms}{$cn}
+	  or die "Connection '$cn' doesn't exists";
+
+	my $dom = $con->{instance}->get_domain_by_name($dn)
+	  or die "Domain $dn isn't found in '$cn'";
+
+	return $this->_safeStart($dom);
+}
+
+sub _resolveDomain {
+	my Hive $this = shift;
+	my ( $cn, $dn ) = @_;
+	
+	my $con = $this->{vmms}{$cn}
+	  or die "Connection '$cn' doesn't exists";
+
+	my $dom = $con->{instance}->get_domain_by_name($dn)
+	  or die "Domain $dn isn't found in '$cn'";
+	return $dom;
+}
+
+sub _safeStart {
+	my Hive $this = shift;
+	my $dom = shift;
+
+	eval {
+		unless ( $dom->is_active() ) {
+			$dom->create();
+		}
+		else {
+			$this->trace_info(
+				"The domain " . $dom->get_name() . " already active" );
+		}
+	};
+	if ($@) {
+		die "$@" unless $dom->is_active();
+		$this->trace_info("$@");
+	}
+}
+
+sub stopDomain {
+	my Hive $this = shift;
+	my ( $cn, $dn, $method ) = @_;
+
+    $this->trace_info("Stop $cn.$dn");
+	my $dom = $this->_resolveDomain( $cn, $dn );
+
+	# if stop method is not specified use the default one
+	$method = $this->{vmms}{$cn}{stop} || 'shutdown'
+	  unless $method;
+
+	return $this->_safeStop( $dom, $method );
+}
+
+sub _safeStop {
+	my Hive $this = shift;
+	my ( $dom, $method ) = @_;
+
+	eval {
+		if ( $method eq 'shutdown' ) {
+			push @{ $this->{_pending} }, Shutdown->new($dom);
+		}
+		elsif ( $method eq 'suspend' ) {
+			$dom->managed_save();
+		}
+	};
+	$this->trace_error( "failed to $method " . $dom->get_name() . ": $@" )
+	  if $@;
+}
+
+sub waitPending {
+	my Hive $this = shift;
+
+	my $timeout  = $this->{config}{timeout}       || $TIMEOUT;
+	my $parallel = $this->{config}{parallel}      || $PARALLEL;
+	my $retry    = $this->{config}{retryInterval} || $RETRY_INTERVAL;
+
+	my @pending = @{ $this->{_pending} || [] };
+	$this->{_pending} = [];
+
+	my $spins = 0;
+
+	$this->trace_info("Waiting for operations to complete")
+	  if @pending;
+
+	while (@pending) {
+		my @queue;
+		my $slots = $parallel;
+		$spins++;
+		foreach my $task (@pending) {
+			my $name     = $task->getName();
+			my $duration = $task->getDuration();
+
+			if ( $task->isComplete() ) {
+				$this->trace_info("\t- $name stopped in $duration s");
+			}
+			elsif ( $duration > $timeout ) {
+				$this->trace_info(
+					"\t- $name destroyed due timeout after $duration s");
+				$task->terminate();
+			}
+			else {
+				$task->start()
+				  if not $task->isStarted()
+				  and ( $parallel == 0 || --$slots >= 0 );
+				$this->trace_info("\tretry $name after $duration s")
+				  and $task->signal()
+				  if $retry and $spins % $retry == 0;
+				push @queue, $task;
+			}
+		}
+		sleep(1) if @pending = @queue;
+	}
+}
+
+sub trace_info {
+	shift;
+	print @_, "\n";
+}
+
+sub trace_error {
+	shift;
+	print STDERR @_, "\n";
+}
+
+package Shutdown;
+use fields qw(_domain _startTime _started);
+
+BEGIN {
+	no strict 'refs';
+	*{ __PACKAGE__ . "::$_" } = \*{"Sys::Virt::Domain::$_"}
+	  for qw(STATE_SHUTOFF LIST_PERSISTENT LIST_ACTIVE);
+}
+
+sub new {
+	my Shutdown $self = fields::new(shift);
+	$self->{_domain} = shift;
+	return $self;
+}
+
+sub isComplete {
+	my Shutdown $this = shift;
+	return $this->{_domain}->get_info()->{state} == STATE_SHUTOFF;
+}
+
+sub getName {
+	my Shutdown $this = shift;
+	return $this->{_domain}->get_name();
+}
+
+sub getDuration {
+	my Shutdown $this = shift;
+	return ( $this->{_startTime} ? time - $this->{_startTime} : 0 );
+}
+
+sub terminate {
+	my Shutdown $this = shift;
+	return eval { $this->{_domain}->destroy() };
+}
+
+sub signal {
+	my Shutdown $this = shift;
+
+	eval { $this->{_domain}->shutdown() };
+}
+
+sub start {
+	my Shutdown $this = shift;
+
+	$this->{_started}   = 1;
+	$this->{_startTime} = time;
+
+	$this->signal();
+}
+
+sub isStarted {
+	my Shutdown $this = shift;
+	return $this->{_started};
+}
diff -r 000000000000 -r cd5df456ee84 etc/minions/hive.yaml
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/etc/minions/hive.yaml	Tue Nov 15 01:33:09 2016 +0300
@@ -0,0 +1,9 @@
+vmms:
+  qemu:
+    uri: qemu:///system
+    stop: suspend
+  lxc:
+    uri: lxc:///
+    stop: shutdown
+timeout: 100
+parallel: 4
\ No newline at end of file
diff -r 000000000000 -r cd5df456ee84 usr/lib/systemd/system/libvirt-minion@.service
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/usr/lib/systemd/system/libvirt-minion@.service	Tue Nov 15 01:33:09 2016 +0300
@@ -0,0 +1,18 @@
+[Unit]
+Description=Suspend/Resume running libvirt %I domain
+Requires=libvirtd.service
+After=network.target
+After=time-sync.target
+After=libvirtd.service
+Before=libvirt-minions.service
+
+[Service]
+ExecStart=/usr/lib/minions/minions.pl start %I
+ExecStop=/usr/lib/minions/minions.pl stop %I
+Type=oneshot
+RemainAfterExit=yes
+StandardOutput=journal+console
+TimeoutStopSec=0
+
+[Install]
+WantedBy=multi-user.target
\ No newline at end of file
diff -r 000000000000 -r cd5df456ee84 usr/lib/systemd/system/libvirt-minions.service
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/usr/lib/systemd/system/libvirt-minions.service	Tue Nov 15 01:33:09 2016 +0300
@@ -0,0 +1,17 @@
+[Unit]
+Description=Suspend/Resume running libvirt guests
+Requires=libvirtd.service
+After=network.target
+After=time-sync.target
+After=libvirtd.service
+
+[Service]
+ExecStart=/usr/lib/minions/minions.pl start
+ExecStop=/usr/lib/minions/minions.pl stop
+Type=oneshot
+RemainAfterExit=yes
+StandardOutput=journal+console
+TimeoutStopSec=0
+
+[Install]
+WantedBy=multi-user.target
\ No newline at end of file