=head1 NAME
Xen::API Perl interface to the Xen RPC-XML API.
=head1 SYNOPSIS
use Xen::API;
my $x = Xen::API->new;
my %vms = $x->list_vms
my %templates = $x->list_templates
my $vm = $x->create_vm(template=>'my_template',cpu=>4,memory=>'16G',vmname=>'this_vm');
my $vm_records = $x->Xen::API::VM::get_all_records();
=head1 DESCRIPTION
Perl interface to the Xen RPC-XML API. Contains some shortcuts for creating,
destroying, importing, and exporting VMs. All RPC API commands are available in
the Xen::API:: package space. Simply replace the dots with :: and prepend
Xen::API:: to the command, and execute it as if it were a perl function. Be
sure to pass the Xen object as the first parameter.
=head1 METHODS
=cut
package Xen::API;
use RPC::XML;
$RPC::XML::FORCE_STRING_ENCODING = 1;
use RPC::XML::Client;
use IO::Prompt ();
use Net::OpenSSH;
use URI;
use URI::QueryParam;
use LWP::UserAgent;
use HTTP::Request;
use Net::HTTP;
use Number::Format qw(:subs);
use FileHandle;
require Exporter;
our @ISA = qw(Exporter);
BEGIN {
our @EXPORT_OK=qw(bool true false string Int i4 i8 double datetime
nil base64 array struct fault prompt mem xen run);
our %EXPORT_TAGS=(all=>\@EXPORT_OK);
our $PACKAGE_PREFIX = __PACKAGE__;
our $VERSION = '0.02';
}
=head2 prompt
Display a password prompt.
=cut
sub prompt {
my $message = shift || 'Enter password: ';
IO::Prompt::prompt($message, -e=>'', '-tty').'';
}
=head2 mem
Convert suffix notation (k, M, G) to byte count. Useful for writing memory to give
to VM.
=cut
sub mem { unformat_number(@_) }
=head2 bool true false string Int i4 i8 double datetime nil base64 array struct fault
shortcuts for RPC::XML explicit typecasts
=cut
sub bool { RPC::XML::boolean->new(@_) }
sub true { RPC::XML::boolean->new(1) }
sub false { RPC::XML::boolean->new(0) }
sub string { RPC::XML::string->new(@_) }
sub Int { RPC::XML::int->new(@_) }
sub i4 { RPC::XML::i4->new(@_) }
sub i8 { RPC::XML::i8->new(@_) }
sub double { RPC::XML::double->new(@_) }
sub datetime { RPC::XML::datetime_iso8601->new(@_) }
sub nil { RPC::XML::nil->new(@_) }
sub base64 { RPC::XML::base64->new(@_) }
sub array { RPC::XML::array->new(@_) }
sub struct { RPC::XML::struct->new(@_) }
sub fault { RPC::XML::fault->new(@_) }
=head2 xen
Create a new instance of a Xen class.
=cut
sub xen {Xen::API->new(@_)}
=head2 new($uri, $user, $password)
New Xen instance.
=cut
sub new {
my $class = shift or return;
my $uri = shift or return;
my $user = shift || 'root';
my $password = shift;
my $self = {};
bless $self, $class;
$uri = "http://$uri" if !URI->new($uri)->scheme;
$self->{uri} = $uri;
$self->{xen} = RPC::XML::Client->new($self->{uri});
# set up autoload packages for Xen API.
my %seen;
my %classes =
map {(
__PACKAGE__."::$_"=>__PACKAGE__,
$PACKAGE_PREFIX? ("${PACKAGE_PREFIX}::$_"=>$PACKAGE_PREFIX) : ($_=>undef),
)}
map {s/\.[^.]*$//; s/\./::/g; !$seen{$_}++?$_:()}
@{$self->{xen}->simple_request('system.listMethods')||[]};
for my $c (keys %classes) {
my $package = $classes{$c};
my $eval = <<EOS;
package $c;
no warnings 'redefine';
our \$AUTOLOAD;
sub AUTOLOAD {
my \$self = shift;
\$AUTOLOAD=~s/^\\Q\${package}::\\E// if defined \$package;
\$AUTOLOAD=~s/::/./g;
\$self->request(\$AUTOLOAD,\@_);
};
EOS
eval $eval;
}
# login
$self->{user} = $user;
$password = prompt("Enter xen admin password for ".$self->{uri}.": ")
if !defined($password);
$self->{session} = $self->value(
$self->{xen}->simple_request('session.login_with_password',$user,$password));
return $self;
}
=head2 create_vm
Create a new VM.
Arguments:
- vmname - The xen name of the VM.
- template - The template to base the VM from.
- cpu - How many CPUs to assign
- memory - How much memory to assign
- hostname - The hostname to set. Works for Debian/Ubuntu and RedHat/CentOS only.
- sudo - Should sudo be used to edit the hostname config file?
- user - SSH user name for editing the hostname config file
- password - SSH password for editing the hostname config file
- port - SSH port for editing the hostname config file
Returns a ref to the newly created VM.
=cut
BEGIN {
my $lastpassword;
sub create_vm {
my $self = shift or return;
# read arguments
my %args = @_;
my $sudo=exists $args{sudo}?$args{sudo}:1;
my $user = $args{user};
$sudo=1 if !defined($sudo) && $user ne 'root';
my $password = exists $args{password}?$args{password}:$lastpassword;
my $vmname = defined $args{vmname}?$args{vmname}:$args{hostname};
my $hostname = $args{hostname};
my $port = $args{port};
my $cpu=$args{cpu};
my $memory=$args{memory};
my $template = $args{template} or return;
die "No VM name given" if !defined $vmname;
# prompt for password
if (defined($hostname) && !defined($password)) {
$password = prompt("Enter login password to set hostname: ");
}
$lastpassword = $password;
# get the list of VMs and templates in this pool
my %vms = %{$self->Xen::API::VM::get_all_records||{}};
my @templates = grep {$vms{$_}{is_a_template} && @{$vms{$_}{VBDs}||[]}} keys %vms;
# query for the template by name or uuid
my @use_template = grep {
$vms{$_}{name_label} eq $template
|| $vms{$_}{uuid} eq $template
|| $_ eq $template} @templates;
die "No template named \"$template\"!\n" if !@use_template;
die "Multiple templates found matching \"$template\":\n"
.join(', ',map {"\"$vms{$_}{name_label}\" ($vms{$_}{uuid})"} @use_template)
if @use_template>1;
my $use_template = $use_template[0];
# clone the template into a new VM
my $new_vm = $self->Xen::API::VM::clone($use_template,$vmname);
# set number of VCPUs
if (defined($cpu)) {
$self->Xen::API::VM::set_VCPUs_max($new_vm,$cpu);
$self->Xen::API::VM::set_VCPUs_at_startup($new_vm,$cpu);
}
# set memory. There seem to be two mutually incompatible APIs: One used by
# XenAPI 6.1, and another for earlier XenAPI versions. Try both, and
# hopefully one of them will succeed.
if (defined($memory)) {
my $mem = unformat_number($memory);
# new API, try this first
my @err;
eval {
$self->Xen::API::VM::set_memory_limits($new_vm,$mem,$mem,$mem,$mem);
};
if ($@) {
push @err, $@;
# try the old API if the new API call fails
eval {
$self->Xen::API::VM::set_memory_dynamic_min($new_vm,$mem);
$self->Xen::API::VM::set_memory_dynamic_max($new_vm,$mem);
$self->Xen::API::VM::set_memory_static_min($new_vm,$mem);
$self->Xen::API::VM::set_memory_static_max($new_vm,$mem);
};
if ($@) {
push @err, $@;
die "Could not set memory for $vmname: \n".join("\n",@err);
}
}
}
# provision the VM
$self->Xen::API::VM::provision($new_vm);
# start the VM
$self->Xen::API::VM::start($new_vm,false,true);
# set the hostname using SSH. This step is distro-specific, so try everything
# and see what sticks.
if (defined $hostname) {
# get the IP
my $ip = $self->get_ip($new_vm);
my $ssh = Net::OpenSSH->new($ip,
defined($user)?(user=>$user):(),
defined($password)?(password=>$password):(),
defined($port)?(port=>$port):(),
master_opts=>[-o=>'StrictHostKeyChecking=no'],
);
die "Couldn't establish SSH connection: ".$ssh->error if $ssh->error;
if ($sudo) {
$ssh->system({stdin_data=>"$password\n", quote_args=>1, stderr_discard=>1},
'sudo','-Sk','-p','--','sed','-ri','1,1s#^.*$#'.$hostname.'#','/etc/hostname');
$ssh->system({stdin_data=>"$password\n", quote_args=>1, stderr_discard=>1},
'sudo','-Sk','-p','--','sed','-ri','s#^HOSTNAME=.*#HOSTNAME='.$hostname.'#','/etc/sysconfig/network');
}
else {
$ssh->system({quote_args=>1, stderr_discard=>1},
'sed','-ri','1,1s#^.*$#'.$hostname.'#','/etc/hostname');
$ssh->system({quote_args=>1, stderr_discard=>1},
'sed','-ri','s#^HOSTNAME=.*#HOSTNAME='.$hostname.'#','/etc/sysconfig/network');
}
# reboot to set the new host name
$self->Xen::API::VM::clean_reboot($new_vm);
}
return $new_vm;
}
}
=head2 get_ip
Gets the IP address of a VM.
=cut
sub get_ip {
my $self = shift or return;
my $vmname = shift or return;
my $maxwait = shift;
$maxwait = 60 if !defined($maxwait);
my %vms = %{$self->Xen::API::VM::get_all_records||{}};
my @vms = grep {
$vms{$_}{name_label} eq $vmname
|| $vms{$_}{uuid} eq $vmname
|| $_ eq $vmname} keys %vms;
my $vm = $vms[0] or die "Could not find vm $vmname";
my $ip = $self->_get_ip($vm, $maxwait)
or die "Could not get IP address of VM $vmname: timeout";
return $ip;
}
sub _get_ip {
my $self = shift or return;
my $vm = shift or return;
my $maxwait = shift;
$maxwait=60 if !defined $maxwait;
# get the IP address of the VM
my $wait=0;
my $ip;
while (!$ip && $wait < $maxwait) {
eval {
my $vgm = $self->Xen::API::VM::get_guest_metrics($vm);
my $net = $self->Xen::API::VM_guest_metrics::get_networks($vgm);
$ip = $net->{'0/ip'} if $net;
};
$wait++;
sleep 1 if !$ip && $wait < $maxwait;
}
return $ip;
}
=head2 destroy_vm
Destroys a VM and its associated VDIs.
=cut
sub destroy_vm {
my $self = shift or return;
my $vmname = shift or return;
# find the VM
my %vms = %{$self->Xen::API::VM::get_all_records||{}};
my @vms = grep {
$vms{$_}{name_label} eq $vmname
|| $vms{$_}{uuid} eq $vmname
|| $_ eq $vmname} keys %vms;
die "Multiple VMs matched $vmname" if @vms > 1;
my $vm = $vms[0] or die "Could not find vm $vmname";
# make sure the VM is shut down
if (($vms{$vm}{power_state}||'') ne 'Halted') {
$self->Xen::API::VM::hard_shutdown($vm);
}
# destroy the attached VDIs
for my $vbd (@{$vms{$vm}{VBDs}||[]}) {
my $vbd_record = $self->Xen::API::VBD::get_record($vbd);
$self->Xen::API::VDI::destroy($vbd_record->{VDI})
if $vbd_record->{VDI}
&& $vbd_record->{VDI} ne 'OpaqueRef:NULL'
&& $vbd_record->{type} ne 'CD';
}
#destroy the VM
$self->Xen::API::VM::destroy($vm);
return '';
}
=head2 import_vm
Import a VM from a xva file.
=cut
sub import_vm {
my $self = shift or return;
my $filename = shift or return;
my $sr_id = shift;
# find the storage repository if specified
my $sr_uuid;
if ($sr_id) {
my %sr = %{$self->Xen::API::SR::get_all_records||{}};
my @srs = grep {
$sr{$_}{name_label} eq $sr_id
|| $sr{$_}{uuid} eq $sr_id
|| $_ eq $sr_id} keys %sr;
my $sr = $srs[0]
or die "Could not find storage repository $sr_id";
$sr_uuid = $sr{$sr}{uuid};
}
# create the source and destination tasks
my $task = $self->Xen::API::task::create("import_$filename","Import VM $filename");
# URI
my $uri = URI->new($self->{uri});
$uri->path('import');
$uri->query_param(session_id=>$self->{session});
$uri->query_param(task_id=>$task);
$uri->query_param(sr_uuid=>$sr_uuid) if $sr_uuid;
my $net = Net::HTTP->new(Host=>$uri->host_port)
or die "Could not connect to host at ".$uri->host_port.": $@";
$net->write_request(
PUT=>$uri->path_query,
'Content-Length'=>(-s $filename));
my $fh = FileHandle->new($filename, 'r')
or die "Could not open $filename for reading: $!";
$fh->binmode;
my $chunk_size = 4096;
while ($fh->read(my $data, $chunk_size)) {
$net->print($data);
}
$fh->close;
# check HTTP status code
my ($code, $message, %headers) = $net->read_response_headers;
$net->close;
die "import returned HTTP Status code: $code" if $code != 200;
# Wait for the task status to be updated
my $wait=0;
my $maxwait=60;
my $task_record = $self->Xen::API::task::get_record($task);
while ($task_record && ($task_record->{status}||'') eq 'pending'
&& $wait < $maxwait)
{
$task_record = $self->Xen::API::task::get_record($task);
sleep 1;
$wait++;
}
$self->Xen::API::task::destroy($task) if $task_record->{status} eq 'success' || $task_record->{status} eq 'failure';
die "Import task returned status $task_record->{status}: ".join(', ',@{$task_record->{error_info}||[]})
if $task_record->{status} ne 'success';
return '';
}
=head2 export_vm
Export a VM to a xva file.
=cut
sub export_vm {
my $self = shift or return;
my $vmname = shift or return;
my $filename = shift or return;
# find the VM
my %vms = %{$self->Xen::API::VM::get_all_records||{}};
my @vms = grep {
$vms{$_}{name_label} eq $vmname
|| $vms{$_}{uuid} eq $vmname
|| $_ eq $vmname} keys %vms;
my $vm = $vms[0] or die "Could not find vm $vmname";
my $task = $self->Xen::API::task::create("export_$vm","Export VM $vm");
# URI
my $uri = URI->new($self->{uri});
$uri->path('export');
$uri->query_param(session_id=>$self->{session});
$uri->query_param(task_id=>$task);
$uri->query_param(ref=>$vm);
my $ua = LWP::UserAgent->new;
my $req = HTTP::Request->new(GET=>$uri->as_string);
my $res = $ua->request($req, $filename);
my $task_record = $self->Xen::API::task::get_record($task);
$self->Xen::API::task::destroy($task) if $task_record->{status} eq 'success' || $task_record->{status} eq 'failure';
die "Export task returned status $task_record->{status}: ".join(', ',@{$task_record->{error_info}||[]})
if $task_record->{status} ne 'success';
return '';
}
=head2 set_template
Set the is_a_template flag for a VM.
=cut
sub set_template {
my $self = shift or return;
my $vmname = shift or return;
my $set_template = shift;
$set_template = 1 if !defined($set_template);
# find the VM
my %vms = %{$self->Xen::API::VM::get_all_records||{}};
my @vms = grep {
$vms{$_}{name_label} eq $vmname
|| $vms{$_}{uuid} eq $vmname
|| $_ eq $vmname} keys %vms;
my $vm = $vms[0] or die "Could not find vm $vmname";
$self->Xen::API::VM::set_is_a_template(
$vm,
$set_template?
ref($set_template)? $set_template : true
: false);
return '';
}
=head2 list_vms
List the VMs on this Xen server.
=cut
sub list_vms {
my $self = shift or return;
my %vms = %{$self->Xen::API::VM::get_all_records||{}};
my @vms = grep {!$vms{$_}{is_a_template}} keys %vms;
return map {{
name_label=>$vms{$_}{name_label},
uuid=>$vms{$_}{uuid},
ref=>$_,
power_state=>$vms{$_}{power_state},
ip=>($vms{$_}{power_state}||'') eq 'Running' ? $self->_get_ip($_,1) : undef,
}}
sort {$vms{$a}{name_label} cmp $vms{$b}{name_label}} @vms;
}
=head2 list_templates
List the templates on this Xen server.
=cut
sub list_templates {
my $self = shift or return;
my %vms = %{$self->Xen::API::VM::get_all_records||{}};
my @templates = grep {$vms{$_}{is_a_template} && @{$vms{$_}{VBDs}||[]}} keys %vms;
return map {{
name_label=>$vms{$_}{name_label},
uuid=>$vms{$_}{uuid},
ref=>$_,
}}
sort {$vms{$a}{name_label} cmp $vms{$b}{name_label}} @templates;
}
=head2 list_hosts
List the physical hosts and related information.
=cut
sub list_hosts {
my $self = shift or return;
my %hosts = %{$self->Xen::API::host::get_all_records||{}};
my %cpus = %{$self->Xen::API::host_cpu::get_all_records||{}};
my %metrics = map {$_=>$self->Xen::API::host_metrics::get_record($hosts{$_}{metrics})} keys %hosts;
return map {{
name_label=>$hosts{$_}{name_label},
uuid=>$hosts{$_}{uuid},
ref=>$_,
cpus=>scalar(@{$hosts{$_}{host_CPUs}||[]}),
%{$metrics{$_}},
memory_free=>format_bytes($metrics{$_}{memory_free}, mode=>'iec'),
memory_total=>format_bytes($metrics{$_}{memory_total}, mode=>'iec'),
}} sort {$hosts{$a}{name_label} cmp $hosts{$b}{name_labe}} keys %hosts;
}
sub value {
my $self = shift or return;
my ($val) = @_;
return $val && ($val->{Status}||'') eq "Success"
? $val->{Value}
: die "Received status \"$val->{Status}\" from xen server at ".$self->{uri}.": "
.join(', ',@{$val->{ErrorDescription}||[]});
}
sub request {
my $self = shift or return;
my $request = shift or return;
return $self->value($self->{xen}->simple_request($request, $self->{session}, @_));
}
1;
=head1 AUTHOR
Ben Booth, benwbooth@gmail.com
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2012 by Ben Booth
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.1 or,
at your option, any later version of Perl 5 you may have available.
=cut