#!/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};
}