Xen::Control - control and fetch information about xen domains
Index
Code Index:
NAME
Xen::Control - control and fetch information about xen domains
SYNOPSIS
my $xen = Xen::Control->new();
my @domains = $xen->ls;
DESCRIPTION
This is a wrapper module interface to Xen `xm` command.
PROPERTIES
xm_cmd
rm_cmd
hibernation_folder
xm_cmd
Holds the command that is used execute xm command. By default it is `sudo xm`.
rm_cmd
Holds the command that is executed to remove xen state files after beeing
restored. default is `sudo rm`.
hibernation_folder
Holds the folder where hibernation domain files will be stored.
XM_METHODS
xm calling methods methods.
create($domain_name)
Starts domain with $domain_name. If the domain is hibernated the the
function calls restore otherwise
$self->xm('create', $domain_name.'.cfg').
ls
list
Returns an array of Xen::Domain objects representing curently running
Xen machines.
save($domain_name)
Hibernate domain named $domain_name. If the name is is not set - undef, will
hibernate all domains.
restore($domain_name)
Wakeup hibernated domain named $domain_name. If the name is is not set - undef, will
wakeup all hibernated domains.
shutdown($domain_name)
Shutdown domain named $domain_name. If the name is is not set - undef, will
shutdown all domains.
xm(@args)
Execute $self->xm_cmd with @args and return the output.
Dies if the execution fails.
METHODS
Other object methods, mostly for internal usage.
new()
hibernated_filename($domain_name)
Returns filename with path of the $domain_name domain.
hibernated_domains()
Search through $self->hibernation_folder for files that end up with
.xen extension and return their names without the extension. So the
return value is an array of hibernated domain names.
TODO
Try IPC::System::Simple instead of ``.
LINKS
BUGS
Please report any bugs or feature requests to bug-xen-control at rt.cpan.org, or through
the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Xen-Control. I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.
SUPPORT
You can find documentation for this module with the perldoc command.
perldoc Xen::Control
You can also look for information at:
- * RT: CPAN's request tracker
-
http://rt.cpan.org/NoAuth/Bugs.html?Dist=Xen-Control
- * AnnoCPAN: Annotated CPAN documentation
-
http://annocpan.org/dist/Xen-Control
- * CPAN Ratings
-
http://cpanratings.perl.org/d/Xen-Control
- * Search CPAN
-
http://search.cpan.org/dist/Xen-Control
ACKNOWLEDGEMENTS
COPYRIGHT & LICENSE
Copyright 2008 Jozef Kutej, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
package Xen::Control;
use warnings;
use strict;
our $VERSION = '0.04';
use Carp::Clan 'croak';
use Xen::Domain;
use base 'Class::Accessor::Fast';
our $XM_COMMAND = 'sudo xm';
our $RM_COMMAND = 'sudo rm';
our $HIBERNATION_FOLDER = '/var/tmp';
__PACKAGE__->mk_accessors(qw{
xm_cmd
rm_cmd
hibernation_folder
});
sub create {
my $self = shift;
my $domain_name = shift;
croak 'pass domain name'
if not defined $domain_name;
if (-f $self->hibernated_filename($domain_name)) {
$self->restore($domain_name);
return;
}
$self->xm('create', $domain_name.'.cfg');
}
*ls = *list;
sub list {
my $self = shift;
my @xm_ls = $self->xm('list');
shift @xm_ls;
my @domains;
foreach my $domain_line (@xm_ls) {
chomp $domain_line;
if ($domain_line !~ /^([-_\w]+)\s+([0-9]+)\s+([0-9]+)\s+([0-9]+)\s+([-a-z]+)\s+([0-9.]+)$/) {
warn 'badly formated domain line - "'.$domain_line.'"';
next;
}
push @domains, Xen::Domain->new(
'name' => $1,
'id' => int($2),
'mem' => int($3),
'vcpus' => int($4),
'state' => $5,
'times' => $6,
);
}
return @domains;
}
sub save {
my $self = shift;
my $domain_name = shift;
if (not defined $domain_name) {
foreach my $domain ($self->ls) {
# skip domain zero
next if $domain->id == 0;
die 'domain with id '.$domain->id.' has a "undef" name'
if not defined $domain->name;
$self->save($domain->name);
}
return;
}
$self->xm('save', $domain_name, $self->hibernated_filename($domain_name));
return;
}
sub restore {
my $self = shift;
my $domain_name = shift;
if (not defined $domain_name) {
foreach my $h_domain_name ($self->hibernated_domains) {
die 'domain with "undef" name'
if not defined $h_domain_name;
$self->restore($h_domain_name);
}
return;
}
$self->xm('restore', $self->hibernated_filename($domain_name));
# remove state file of restored machine
my $rm_cmd = $self->rm_cmd.' '.$self->hibernated_filename($domain_name);
`$rm_cmd`;
return;
}
sub shutdown {
my $self = shift;
my $domain_name = shift;
if (not defined $domain_name) {
$self->xm('shutdown', '-a');
return;
}
$self->xm('shutdown', $domain_name);
return;
}
sub xm {
my $self = shift;
my @args = map { quotemeta($_) } @_;
my $xm_cmd = $self->xm_cmd.' '.join(' ', @args);
my @output = `$xm_cmd`;
die 'failed to execute "'.$xm_cmd.'"' if (($? >> 8) != 0);
return @output;
}
sub new {
my $class = shift;
my $self = $class->SUPER::new({
'xm_cmd' => $XM_COMMAND,
'rm_cmd' => $RM_COMMAND,
'hibernation_folder' => $HIBERNATION_FOLDER,
@_
});
return $self;
}
sub hibernated_filename {
my $self = shift;
my $domain_name = shift;
croak 'set domain_name'
if not defined $domain_name;
return $self->hibernation_folder.'/'.$domain_name.'.xen';
}
sub hibernated_domains {
my $self = shift;
my $hfolder = $self->hibernation_folder;
opendir(my $tmp_folder, $hfolder)
or die 'failed to open "'.$hfolder.'" - '.$!;
my @domain_names =
map { substr($_, 0, -4) } # remove .xen from the filename
grep { $_ =~ m/^[-_\w]+[.]xen$/ and -f $hfolder.'/'.$_ } # just files with .xen extension
readdir($tmp_folder);
closedir($tmp_folder);
return @domain_names;
}
1;
__END__
1;