Mercurial > pub > Minions

changeset 0:cd5df456ee84

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Initial working version of minions.pl ans sysyemd units
author cin
date Tue, 15 Nov 2016 01:33:09 +0300
parents
children 0279d995d493
files .includepath .project Changes README bin/minions.pl etc/minions/hive.yaml usr/lib/systemd/system/libvirt-minion@.service usr/lib/systemd/system/libvirt-minions.service
diffstat 8 files changed, 502 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- /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>
+
--- /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>
--- /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.
+
--- /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.
+
--- /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};
+}
--- /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
--- /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
--- /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