|
0
|
1 #!/usr/bin/perl -T
|
|
|
2 use strict;
|
|
|
3 use warnings;
|
|
|
4
|
|
|
5 package Hive;
|
|
|
6
|
|
|
7 package main;
|
|
|
8 use Pod::Usage;
|
|
|
9 use Getopt::Long qw(:config auto_help);
|
|
|
10 use Sys::Virt;
|
|
|
11 use Sys::Virt::Domain;
|
|
|
12
|
|
|
13 our $VERSION = 0.1;
|
|
|
14 our $CONFIG_FILE = '/etc/minions/hive.yaml';
|
|
|
15 our $STATE_FILE = '/var/lib/minions/session.yaml';
|
|
|
16 our $TIMEOUT = 300;
|
|
|
17 our $PARALLEL = 0;
|
|
|
18 our $RETRY_INTERVAL = 60;
|
|
|
19
|
|
|
20 my $tasks = 2;
|
|
|
21 my @pending;
|
|
|
22
|
|
|
23 my @uri = qw(qemu:///system lxc:///);
|
|
|
24
|
|
|
25 my %commands = (
|
|
|
26 stop => \&doStop,
|
|
|
27 start => \&doStart,
|
|
|
28 help => \&doHelp
|
|
|
29 );
|
|
|
30
|
|
|
31 my $cmd = shift @ARGV;
|
|
|
32
|
|
|
33 &{ $commands{ lc( $cmd || '' ) } || \&doHelp }(@ARGV);
|
|
|
34
|
|
|
35 exit 0;
|
|
|
36
|
|
|
37 sub doHelp {
|
|
|
38 print <<END_HELP;
|
|
|
39 Minions v.$VERSION manages libvirt domains...
|
|
|
40 stop [domain[ stop-method]]
|
|
|
41 Stops the specified libvirt domain with the specified method. If the
|
|
|
42 domain isn't specified then stops all domains on all configured
|
|
|
43 connections and saves the list of stopped domains to
|
|
|
44 /var/lib/minions/session.yaml file.
|
|
|
45
|
|
|
46 start [domain]
|
|
|
47 Starts the specified domain, if the domain is ommited restores the
|
|
|
48 previous session from /var/lib/minions/session.yaml and deletes this
|
|
|
49 file.
|
|
|
50 help
|
|
|
51 Prints this help
|
|
|
52
|
|
|
53 domain must be written in format {connection}.{domain} where {connection} is
|
|
|
54 the one of configured connections from /etc/minions/hive.yaml and {domain}
|
|
|
55 is the name of the libvirt domain.
|
|
|
56 END_HELP
|
|
|
57 }
|
|
|
58
|
|
|
59 sub doStart {
|
|
|
60 my $hive = Hive->new($CONFIG_FILE);
|
|
|
61
|
|
|
62 if ( @_ > 0 ) {
|
|
|
63 if ( my ( $cn, $dn ) = ( $_[0] =~ m/(\w+)\.(\w+)/ ) ) {
|
|
|
64 $hive->startDomain( $cn, $dn );
|
|
|
65 }
|
|
|
66 else {
|
|
|
67 die "Invalid parameter: {connection}.{domain} format is required";
|
|
|
68 }
|
|
|
69 }
|
|
|
70 else {
|
|
|
71 $hive->start();
|
|
|
72 }
|
|
|
73 $hive->waitPending();
|
|
|
74 }
|
|
|
75
|
|
|
76 sub doStop {
|
|
|
77 my $hive = Hive->new($CONFIG_FILE);
|
|
|
78
|
|
|
79 if ( @_ > 0 ) {
|
|
|
80 if ( my ( $cn, $dn ) = ( $_[0] =~ m/(\w+)\.(\w+)/ ) ) {
|
|
|
81 $hive->stopDomain( $cn, $dn );
|
|
|
82 }
|
|
|
83 else {
|
|
|
84 die "Invalid parameter: {connection}.{domain} format is required";
|
|
|
85 }
|
|
|
86 }
|
|
|
87 else {
|
|
|
88 $hive->stop();
|
|
|
89 }
|
|
|
90
|
|
|
91 $hive->waitPending();
|
|
|
92 }
|
|
|
93
|
|
|
94 package Hive;
|
|
|
95 use fields qw(config vmms _pending);
|
|
|
96 use YAML::XS qw(DumpFile LoadFile Dump);
|
|
|
97 use Sys::Virt;
|
|
|
98 use Sys::Virt::Domain;
|
|
|
99 use File::Spec;
|
|
|
100
|
|
|
101 BEGIN {
|
|
|
102 no strict 'refs';
|
|
|
103 *{ __PACKAGE__ . "::$_" } = \*{"Sys::Virt::Domain::$_"}
|
|
|
104 for qw(STATE_SHUTOFF LIST_PERSISTENT LIST_ACTIVE);
|
|
|
105 }
|
|
|
106
|
|
|
107 sub new {
|
|
|
108 my Hive $this = fields::new(shift);
|
|
|
109 $this->init(@_);
|
|
|
110 return $this;
|
|
|
111 }
|
|
|
112
|
|
|
113 sub init {
|
|
|
114 my Hive $this = shift;
|
|
|
115 my $file = shift;
|
|
|
116
|
|
|
117 my $config = $this->{config} = LoadFile($file);
|
|
|
118
|
|
|
119 while ( my ( $name, $info ) = each %{ $config->{vmms} || {} } ) {
|
|
|
120 eval {
|
|
|
121 die "Invalid connection info $name"
|
|
|
122 unless ref($info) and $info->{uri};
|
|
|
123
|
|
|
124 $this->trace_info("Connection '$name': $info->{uri}");
|
|
|
125 $this->{vmms}{$name}{stop} = lc( $info->{stop} || 'shutdown' );
|
|
|
126
|
|
|
127 die "Unsupported stop method: $info->{stop}"
|
|
|
128 unless grep $_ eq $this->{vmms}{$name}{stop},
|
|
|
129 qw(suspend shutdown);
|
|
|
130
|
|
|
131 $this->{vmms}{$name}{instance} =
|
|
|
132 Sys::Virt->new( uri => $info->{uri} );
|
|
|
133 };
|
|
|
134 $this->trace_error("Failed to connect '$name': $@") if $@;
|
|
|
135 }
|
|
|
136 }
|
|
|
137
|
|
|
138 sub stop {
|
|
|
139 my Hive $this = shift;
|
|
|
140
|
|
|
141 my @pending;
|
|
|
142
|
|
|
143 my %stopped;
|
|
|
144
|
|
|
145 while ( my ( $name, $vmm ) = each %{ $this->{vmms} || {} } ) {
|
|
|
146 next unless $vmm->{instance};
|
|
|
147
|
|
|
148 $this->trace_info("Do $vmm->{stop} for all domains on $name");
|
|
|
149
|
|
|
150 my @domains =
|
|
|
151 $vmm->{instance}->list_all_domains( LIST_PERSISTENT | LIST_ACTIVE );
|
|
|
152 $stopped{$name} = [ map $_->get_name(), @domains ];
|
|
|
153
|
|
|
154 $this->trace_info( "\t-" . $_->get_name() )
|
|
|
155 and $this->_safeStop( $_, $vmm->{stop} )
|
|
|
156 for @domains;
|
|
|
157 }
|
|
|
158
|
|
|
159 my $state = $this->{config}{sate_file} || $STATE_FILE;
|
|
|
160
|
|
|
161 my $dir = ( File::Spec->splitpath($state) )[1];
|
|
|
162 mkdir $dir unless -e $dir;
|
|
|
163
|
|
|
164 DumpFile( $state, \%stopped );
|
|
|
165 }
|
|
|
166
|
|
|
167 sub start {
|
|
|
168 my Hive $this = shift;
|
|
|
169
|
|
|
170 my $state = $this->{config}{sate_file} || $STATE_FILE;
|
|
|
171 my $session = -f $state ? LoadFile($state) : {};
|
|
|
172
|
|
|
173 while ( my ( $name, $machines ) = each %{$session} ) {
|
|
|
174 my $vmm = $this->{vmms}{$name}
|
|
|
175 or $this->trace_error(
|
|
|
176 "Failed to resotre session for '$name': no such connection")
|
|
|
177 and next;
|
|
|
178
|
|
|
179 $this->trace_info("Restoring domains on '$name'");
|
|
|
180 for my $m ( @{ $machines || [] } ) {
|
|
|
181 my $d = $vmm->{instance}->get_domain_by_name($m)
|
|
|
182 or $this->trace_error("\t-$m not found")
|
|
|
183 and next;
|
|
|
184
|
|
|
185 eval {
|
|
|
186 $this->trace_info("\t-$m");
|
|
|
187 $this->_safeStart($d);
|
|
|
188 };
|
|
|
189 $this->trace_error("$@") if $@;
|
|
|
190 }
|
|
|
191 }
|
|
|
192
|
|
|
193 unlink $state if -f $state;
|
|
|
194 }
|
|
|
195
|
|
|
196 sub startDomain {
|
|
|
197 my Hive $this = shift;
|
|
|
198 my ( $cn, $dn ) = @_;
|
|
|
199
|
|
|
200 $this->trace_info("Start $cn.$dn");
|
|
|
201 my $con = $this->{vmms}{$cn}
|
|
|
202 or die "Connection '$cn' doesn't exists";
|
|
|
203
|
|
|
204 my $dom = $con->{instance}->get_domain_by_name($dn)
|
|
|
205 or die "Domain $dn isn't found in '$cn'";
|
|
|
206
|
|
|
207 return $this->_safeStart($dom);
|
|
|
208 }
|
|
|
209
|
|
|
210 sub _resolveDomain {
|
|
|
211 my Hive $this = shift;
|
|
|
212 my ( $cn, $dn ) = @_;
|
|
|
213
|
|
|
214 my $con = $this->{vmms}{$cn}
|
|
|
215 or die "Connection '$cn' doesn't exists";
|
|
|
216
|
|
|
217 my $dom = $con->{instance}->get_domain_by_name($dn)
|
|
|
218 or die "Domain $dn isn't found in '$cn'";
|
|
|
219 return $dom;
|
|
|
220 }
|
|
|
221
|
|
|
222 sub _safeStart {
|
|
|
223 my Hive $this = shift;
|
|
|
224 my $dom = shift;
|
|
|
225
|
|
|
226 eval {
|
|
|
227 unless ( $dom->is_active() ) {
|
|
|
228 $dom->create();
|
|
|
229 }
|
|
|
230 else {
|
|
|
231 $this->trace_info(
|
|
|
232 "The domain " . $dom->get_name() . " already active" );
|
|
|
233 }
|
|
|
234 };
|
|
|
235 if ($@) {
|
|
|
236 die "$@" unless $dom->is_active();
|
|
|
237 $this->trace_info("$@");
|
|
|
238 }
|
|
|
239 }
|
|
|
240
|
|
|
241 sub stopDomain {
|
|
|
242 my Hive $this = shift;
|
|
|
243 my ( $cn, $dn, $method ) = @_;
|
|
|
244
|
|
|
245 $this->trace_info("Stop $cn.$dn");
|
|
|
246 my $dom = $this->_resolveDomain( $cn, $dn );
|
|
|
247
|
|
|
248 # if stop method is not specified use the default one
|
|
|
249 $method = $this->{vmms}{$cn}{stop} || 'shutdown'
|
|
|
250 unless $method;
|
|
|
251
|
|
|
252 return $this->_safeStop( $dom, $method );
|
|
|
253 }
|
|
|
254
|
|
|
255 sub _safeStop {
|
|
|
256 my Hive $this = shift;
|
|
|
257 my ( $dom, $method ) = @_;
|
|
|
258
|
|
|
259 eval {
|
|
|
260 if ( $method eq 'shutdown' ) {
|
|
|
261 push @{ $this->{_pending} }, Shutdown->new($dom);
|
|
|
262 }
|
|
|
263 elsif ( $method eq 'suspend' ) {
|
|
|
264 $dom->managed_save();
|
|
|
265 }
|
|
|
266 };
|
|
|
267 $this->trace_error( "failed to $method " . $dom->get_name() . ": $@" )
|
|
|
268 if $@;
|
|
|
269 }
|
|
|
270
|
|
|
271 sub waitPending {
|
|
|
272 my Hive $this = shift;
|
|
|
273
|
|
|
274 my $timeout = $this->{config}{timeout} || $TIMEOUT;
|
|
|
275 my $parallel = $this->{config}{parallel} || $PARALLEL;
|
|
|
276 my $retry = $this->{config}{retryInterval} || $RETRY_INTERVAL;
|
|
|
277
|
|
|
278 my @pending = @{ $this->{_pending} || [] };
|
|
|
279 $this->{_pending} = [];
|
|
|
280
|
|
|
281 my $spins = 0;
|
|
|
282
|
|
|
283 $this->trace_info("Waiting for operations to complete")
|
|
|
284 if @pending;
|
|
|
285
|
|
|
286 while (@pending) {
|
|
|
287 my @queue;
|
|
|
288 my $slots = $parallel;
|
|
|
289 $spins++;
|
|
|
290 foreach my $task (@pending) {
|
|
|
291 my $name = $task->getName();
|
|
|
292 my $duration = $task->getDuration();
|
|
|
293
|
|
|
294 if ( $task->isComplete() ) {
|
|
|
295 $this->trace_info("\t- $name stopped in $duration s");
|
|
|
296 }
|
|
|
297 elsif ( $duration > $timeout ) {
|
|
|
298 $this->trace_info(
|
|
|
299 "\t- $name destroyed due timeout after $duration s");
|
|
|
300 $task->terminate();
|
|
|
301 }
|
|
|
302 else {
|
|
|
303 $task->start()
|
|
|
304 if not $task->isStarted()
|
|
|
305 and ( $parallel == 0 || --$slots >= 0 );
|
|
|
306 $this->trace_info("\tretry $name after $duration s")
|
|
|
307 and $task->signal()
|
|
|
308 if $retry and $spins % $retry == 0;
|
|
|
309 push @queue, $task;
|
|
|
310 }
|
|
|
311 }
|
|
|
312 sleep(1) if @pending = @queue;
|
|
|
313 }
|
|
|
314 }
|
|
|
315
|
|
|
316 sub trace_info {
|
|
|
317 shift;
|
|
|
318 print @_, "\n";
|
|
|
319 }
|
|
|
320
|
|
|
321 sub trace_error {
|
|
|
322 shift;
|
|
|
323 print STDERR @_, "\n";
|
|
|
324 }
|
|
|
325
|
|
|
326 package Shutdown;
|
|
|
327 use fields qw(_domain _startTime _started);
|
|
|
328
|
|
|
329 BEGIN {
|
|
|
330 no strict 'refs';
|
|
|
331 *{ __PACKAGE__ . "::$_" } = \*{"Sys::Virt::Domain::$_"}
|
|
|
332 for qw(STATE_SHUTOFF LIST_PERSISTENT LIST_ACTIVE);
|
|
|
333 }
|
|
|
334
|
|
|
335 sub new {
|
|
|
336 my Shutdown $self = fields::new(shift);
|
|
|
337 $self->{_domain} = shift;
|
|
|
338 return $self;
|
|
|
339 }
|
|
|
340
|
|
|
341 sub isComplete {
|
|
|
342 my Shutdown $this = shift;
|
|
|
343 return $this->{_domain}->get_info()->{state} == STATE_SHUTOFF;
|
|
|
344 }
|
|
|
345
|
|
|
346 sub getName {
|
|
|
347 my Shutdown $this = shift;
|
|
|
348 return $this->{_domain}->get_name();
|
|
|
349 }
|
|
|
350
|
|
|
351 sub getDuration {
|
|
|
352 my Shutdown $this = shift;
|
|
|
353 return ( $this->{_startTime} ? time - $this->{_startTime} : 0 );
|
|
|
354 }
|
|
|
355
|
|
|
356 sub terminate {
|
|
|
357 my Shutdown $this = shift;
|
|
|
358 return eval { $this->{_domain}->destroy() };
|
|
|
359 }
|
|
|
360
|
|
|
361 sub signal {
|
|
|
362 my Shutdown $this = shift;
|
|
|
363
|
|
|
364 eval { $this->{_domain}->shutdown() };
|
|
|
365 }
|
|
|
366
|
|
|
367 sub start {
|
|
|
368 my Shutdown $this = shift;
|
|
|
369
|
|
|
370 $this->{_started} = 1;
|
|
|
371 $this->{_startTime} = time;
|
|
|
372
|
|
|
373 $this->signal();
|
|
|
374 }
|
|
|
375
|
|
|
376 sub isStarted {
|
|
|
377 my Shutdown $this = shift;
|
|
|
378 return $this->{_started};
|
|
|
379 }
|
