--- /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};
+}