## Packages needed for httpi scheme
## httpi (http over unix socket)
package URI::httpi;
require URI::_server;
our @ISA = qw(URI::_server);

## creation of httpi socket
package LWP::Protocol::httpi::Socket;
require LWP::Protocol::http;
require Net::HTTP::Methods;
require IO::Socket::UNIX;

our @ISA = qw(LWP::Protocol::http::SocketMethods
	Net::HTTP::Methods
	IO::Socket::UNIX);

sub configure
{
	my($self, $cnf) = @_;
	$self->http_configure($cnf);
}

sub http_connect
{
	my($self, $cnf) = @_;

	## convert -- to / in hostname
	my $path = "/" . $cnf->{PeerAddr};
	$path =~ s,--,/,g;

	$self->SUPER::configure({ Peer => $path });
}

## functions called but meaningless in UNIX
sub peerport { 80 }
sub peerhost { "localhost" }

## create lwp httpi handler
package LWP::Protocol::httpi;
require LWP::Protocol::http;
our @ISA = qw(LWP::Protocol::http);

## exceptions
package XenAPI::LoginError;
require Error;
our @ISA = qw(Error::Simple);

package XenAPI::TypeError;
require Error;
our @ISA = qw(Error::Simple);

package XenAPI::RPCError;
require Error;
our @ISA = qw(Error::Simple);

package XenAPI::CallError;
require Error;
our @ISA = qw(Error::Simple);

package XenAPI::DeclarationError;
require Error;
our @ISA = qw(Error::Simple);

## XenAPI package proper
package XenAPI;

=head1 NAME

XenAPI - Encapsulate Xend API access

=head1 SYNOPSIS

 use XenAPI;

 $session = XenAPI->new;

=head1 DESCRIPTION

C<XenAPI> provides an object interface for the Xend XML-RPC API. The first
object created will be the session, giving access to its methods, attributes
and procedures (functions disconnected from the object).

Access to static class methods (procedures) can be done via an object of that
class, or by creating a new, disconnected, object, with the C<class> method.

=head1 CONSTRUCTOR

=over

=item new ( [ARGS] )

Creates a C<XenAPI>, which is a reference to a newly created session with the
Xend server. This initial object is of the Xend's class B<session>.
C<new> optionally takes arguments, in key-value pairs:

=over

=item *

B<url> => I<URL>: path or URL to Xend socket. If not specified, the value of
C<$XenAPI::XEND_SOCKET> will be used.

=item *

B<user> => I<username>: username for session, by default empty.

=item *

B<password> => I<password>: password for session, by default empty.

=back

=back

=head1 METHODS

=over

=item $o->description

Returns a textual description of the allowed operations and attributes for the
class of that object.

=item $o->class( $class_name )

Create a disconnected object with the specified class. Only procedures
can be called on that object.

=item $o->get_by_uuid( $uuid )

Get object, of the same class as $o, with the specified B<UUID> global and
unique reference.

=item $o->record

Returns a dictionary with the current values of all (known) attributes of that
object.

=item $o->uuid

Returns the unique identifier/object reference for that object.

=item $o->I<attribute_name>( [I<new value>] )

Get or set the value of the attribute, for that object.

=item $o->I<method_name>( [ARGS] )

Call the specified method for that object.

=back

=head1 EXCEPTIONS

The following exceptions are defined:

=over

=item XenAPI::LoginError

Couldn't login to server, either because an error occurred while creating
the necessary auxiliary objects (HTTP::Request, LWP::UserAgent, ...), or
because server denied the login.

=item XenAPI::TypeError

Couldn't convert to or from an XML::RPC type: invalid value for type, or
unknown type.

=item XenAPI::RPCError

RPC call couldn't be made, or returned an error.

=item XenAPI::CallError

Invalid method/procedure call, or attribute access.

=item XenAPI::DeclarationError

Error parsing textual description of the API.

=back

=head1 GLOBAL VARIABLES

=over

=item B<$XenAPI::XEND_SOCKET>

This variable contains the default Xend's unix socket,
F</var/run/xend/xen-api.sock>.

=back

=head1 NOTE

This implementation parses a textual description of the enums, classes,
attributes, methods and procedures, defined in APIDESC, to create a
dictionary with the allowed calls and conversion of arguments.

An AUTOLOAD sub is then responsible for parsing the arguments and creating the
RPC call.

The implementation is thus limited to that description.

Also, note that the full interface described in the Xen API is not completely
implemented in the current version of Xen, so some operations are commented
out.

=head2 Mapping between Xend types and XML-RPC types:

=over

=item *

B<Floats>: XML-RPC double;

=item *

B<Bools>: XML-RPC boolean or XML-RPC string (VBD.bootable, for instance);

=item *

B<DateTimes>: XML-RPC dateTime.iso8601;

=item *

B<Strings>: XML-RPC string;

=item *

B<ref_*>: opaque types, XML-RPC string;

=item *

B<uuid> of type B<String>: XML-RPC string, in the OSF DCE UUID presentation
format (see B<uuidgen(1)>);

=item *

B<ints>: 64-bit values, XML-RPC string;

=item *

B<enums> values: XML-RPC string;

=item *

B<sets>: XML-RPC array with the values;

=item *

B<maps>: XML-RPC struct, with keys as the names of the members;

=item *

B<Void>: XML-RPC empty string.

=back

=head2 Mapping between Xend types and perl types:

=over

=item *

B<Floats>: scalar, float;

=item *

B<Bools>: scalar, string: "TRUE" or "FALSE";

=item *

B<DateTimes>: scalar, int, seconds since epoch;

=item *

B<Strings>: scalar, string;

=item *

B<ref_*>: object of its type;

=item *

B<uuid> of type B<String>: scalar, string, in the OSF DCE UUID presentation
format (see B<uuidgen(1)>);

=item *

B<ints>: scalar, int;

=item *

B<enums> values: scalar, string;

=item *

B<sets>: array reference;

=item *

B<maps>: hashtable reference;

=item *

B<Void>: undefined value.

=back

=head1 AUTHORS

Luciano Rocha, <F<luciano@eurotux.com>>.

=head1 COPYRIGHT

This module is Copyright (C) Eurotux Informática, S.A., 2007, 2008.
All rights reserved.

=head1 LICENSE

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

=cut

use strict;
use warnings;
use bytes;
use Error qw(:try);

require LWP::UserAgent;
require RPC::XML;
require RPC::XML::Parser;
require Time::Local;

our $VERSION = 0.1;

## default xend socket path
our $XEND_SOCKET = "/var/run/xend/xen-api.sock";

## hash with information about enums/classes/methods/attributes/etc.
our %_xapi : unique;

## create new object:
## create LWP::UserAgent, HTTP::Request and XML::Parser
## attempt to login
sub new
{
	my ($class, %arg) = @_;

	my $url = $arg{url} || $XEND_SOCKET;

	## unix socket?
	if ($url =~ m,^/,) {
		$url =~ s,^/+,,;
		$url =~ s,/,--,g;
		$url = "httpi://" . $url;
	}

	my $ua = LWP::UserAgent->new(agent => "$class/$VERSION")
		or throw XenAPI::LoginError
			"couldn't create new LWP::UserAgent object";
	my $req = HTTP::Request->new(POST => $url,
		[ Content_type => 'text/xml' ])
		or throw XenAPI::LoginError
			"couldn't create new HTTP::Request object";

	$req->protocol('HTTP/1.0');

	my $xp = RPC::XML::Parser->new
		or throw XenAPI::LoginError
			"couldn't create new RPC::XML::Parser object";

	my $self = bless {
		_user_agent => $ua,
		_http_request => $req,
		_xml_parser => $xp
	}, $class;

	my $res = $self->_call("session.login_with_password",
		_convert_to('string', $arg{user} || ''),
		_convert_to('string', $arg{password} || ''));

	$res or throw XenAPI::LoginError
		"couldn't login to server";

	$self->{_self} = $self->{_session} = _convert_from('string', $res);
	$self->{_class} = 'session';

	$self;
}

## convert from perl types to XML-RPC types, as used by Xen-API
sub _convert_to
{
	my ($t, $v) = @_;

	my $r;

	if (ref $t eq "HASH") {
		my ($a, $tt) = ($t->{a}, $t->{t});

		if ($a eq "a") {
			$r = RPC::XML::array->new(map { _convert_to($tt, $_) }
				@$v);
		} elsif ($a eq "s") {
			$r = RPC::XML::struct->new(map
				{ $_ => _convert_to($tt, $v->{$_}) } keys %$v);
		} elsif ($a eq "r") {
			my %h;
			$_xapi{classes}{$tt} or throw XenAPI::TypeError
				"record type `$tt' isn't a class";

			my $attr = $_xapi{classes}{$tt}{a};
			for my $k (keys %$attr) {
				next if $k eq "record" || $k eq "uuid"
					|| !exists($v->{$k});
				$h{$k} = _convert_to($attr->{$k}{t}, $v->{$k});
			}
			$r = RPC::XML::struct->new(\%h);
		} else {
			throw XenAPI::TypeError
				"don't know how to convert aggregate `$a'";
		}
	} elsif ($t eq "int") {
		throw XenAPI::TypeError "invalid value `$v' for type `$t'"
			unless $v =~ /^[-+]?\d+$/;
		$r = RPC::XML::string->new($v);
	} elsif ($t eq "bool") {
		throw XenAPI::TypeError "invalid value `$v' for type `$t'"
			unless lc($v) eq "true" || lc($v) eq "false";
		$r = RPC::XML::boolean->new(lc($v) eq "true");
	} elsif ($t eq "float") {
		throw XenAPI::TypeError "invalid value `$v' for type `$t'"
			unless ($v =~ /^[-+]?\d+\.\d*(e[-+]?\d+)?$/
				|| $v =~ /^\.\d+(e[-+]?\d+)?$/);
		$r = RPC::XML::double->new($v);
	} elsif ($t eq "datetime") {
		my ($S, $M, $H, $d, $m, $y) = gmtime($v);
		$y or throw XenAPI::TypeError "couldn't convert date `".
			$v.
			"' from seconds since epoch format to ISO8601 format";
		$r = sprintf "%04d%02d%02dT%02d:%02d:%02d",
			$y + 1900, $m + 1, $d,
			$H, $M, $S;
	} elsif ($t eq "void") {
		$r = RPC::XML::string->new('');
	} elsif ($t eq "string") {
		$r = RPC::XML::string->new($v);
	} elsif ($_xapi{enums}{$t}) {
		my $vv = $_xapi{enums}{$t}{l}{lc($v)}
			or throw XenAPI::TypeError
				"invalid value `$v' for type `$t'";
		$r = RPC::XML::string->new($vv);
	} elsif ($_xapi{classes}{$t}) {
		$t eq $v->_class or throw XenAPI::TypeError
			"invalid object class `".$v->_class."' for type `$t'";
		$r = RPC::XML::string->new($v->_self);
	} else {
		throw XenAPI::TypeError "unknown type `$t', with value: $v";
	}
}

## convert from XML-RPC types, as used by Xen-API, to perl types
sub _convert_from
{
	my ($t, $v, $o) = @_;

	my $r;

	if (ref $t eq "HASH") {
		my ($a, $tt) = ($t->{a}, $t->{t});

		if ($v->type eq "string" && !length($v->value)) {
			## empty result
			if ($a eq "a") {
				$r = [];
			} else {
				$r = {};
			}
		} elsif ($a eq "a") {
			$v->type eq "array" or throw XenAPI::TypeError
				"invalid type conversion `".$v->type."' -> `$a'";
			$r = [ map { _convert_from($tt, $_, $o) }
				@{$v->value(1)} ];
		} elsif ($a eq "s") {
			$v->type eq "struct" or throw XenAPI::TypeError
				"invalid type conversion `".$v->type."' -> `$a'";
			my $h = $v->value(1);

			$r = { map { $_ => _convert_from($tt, $v->{$_}, $o) }
				keys %$h };
		} elsif ($a eq "r") {
			$v->type eq "struct" or throw XenAPI::TypeError
				"invalid type conversion `".$v->type."' -> `$a'";

			$_xapi{classes}{$tt}
				or throw XenAPI::TypeError
					"record type `$tt' isn't a class";
			my $attr = $_xapi{classes}{$tt}{a};

			my %h;
			$v = $v->value(1);

			for my $k (keys %$attr) {
				next if $k eq "record" || !exists($v->{$k});
				$h{$k} = _convert_from($attr->{$k}{t}, $v->{$k}, $o);
			}
			$r = \%h;
		} else {
			throw XenAPI::TypeError
				"don't know how to convert aggregate `$a'";
		}
	} elsif ($t eq "void") {
		undef $r;
	} elsif ($t eq "int" || $t eq "string") {
		$v->type eq "string" or throw XenAPI::TypeError
			"invalid type conversion ".$v->type." -> $t";
		$r = $v->value;
	} elsif ($t eq "bool") {
		$v->type eq "boolean" || $v->type eq "string"
			or throw XenAPI::TypeError
				"invalid type conversion ".$v->type." -> $t";
		$r = $v->value ? "TRUE": "FALSE";
	} elsif ($t eq "float") {
		$v->type eq "double" or throw XenAPI::TypeError
			"invalid type conversion ".$v->type." -> $t";
		$r = $v->value;
	} elsif ($t eq "datetime") {
		$v->type eq "dateTime.iso8601" or throw XenAPI::TypeError
			"invalid type conversion ".$v->type." -> $t";
		if (my ($y, $m, $d, $H, $M, $S) = $v->value =~ /^
			(\d{4,})(\d\d)(\d\d)
			T
			(\d\d):(\d\d):(\d\d)
			$/x) {
			$r = Time::Local::timegm($S, $M, $H, $d, $m - 1, $y);
		} else {
			throw XenAPI::TypeError "couldn't convert date `".
				$v->value.
				"' from ISO8601 format to seconds since epoch format";
		}
	} elsif ($_xapi{enums}{$t}) {
		$r = $v->value;
	} elsif ($_xapi{classes}{$t}) {
		$v->type eq "string" or throw XenAPI::TypeError
			"invalid type conversion ".$v->type." -> $t";
		$r = bless {
			%$o,
			_class => $t,
			_self => $v->value,
		}, ref $o;
	} else {
		throw XenAPI::TypeError
			"unknown type `$t', with value `".$v->as_string."'";
	}
	$r;
}

sub class
{
	## static class access
	my ($self, $name) = @_;
	my $type = ref $self
		or throw XenAPI::CallError "not an object: $self";

	$name or throw XenAPI::CallError
		"disconnected object creation without type";

	$_xapi{classes}{$name} or throw XenAPI::CallError
		"unknown class type: $name";

	bless {
		%$self,
		_class => $name,
		_self => '',
	}, $type;
}

## list enums/classes or list class methods/attributes
sub description
{
	my $cn = shift;

	my $r;
	$cn = $cn->{_class} if $cn && ref $cn;

	if ($cn) {
		## class description
		my $c = $_xapi{classes}{$cn} or return "unknown class `$cn'";

		$r = "Class $cn:\n";
		$r .= "  (".$c->{d}.")\n" if $c->{d};
		$r .= "  Attributes:\n";

		my $h = $c->{a};
		for my $k (sort keys %$h) {
			$r .= "    ".sprintf("%-1s %-20s %s\n",
				($h->{$k}{a} eq "ro" ? "r" : "w"), $k,
				($h->{$k}{d} || "(no description)"));
		}
		$h = $c->{m};
		$r .= "  Methods:\n";
		for my $k (sort keys %$h) {
			$r .= "    ".sprintf("%-1s %-20s %s\n",
				($h->{$k}{m} ? "m" : "p"), $k,
				($h->{$k}{d} || "(no description)"));
		}
	} else {
		## list classes and enums
		$r = "Enumerations:\n";
		my $h = $_xapi{enums};
		for my $k (sort keys %$h) {
			$r .= "  $k:\n";
			my $hh = $h->{$k};
			$r .= "    (".$hh->{d}.")\n" if $hh->{d};
			for my $kk (sort keys %{$hh->{l}}) {
				$r .= "    ".sprintf("%-20s %s\n",
					$hh->{l}{$kk},
					($hh->{v}{$hh->{l}{$kk}}
						|| "(no description)"));
			}
		}
		$r .= "\nClasses:\n";
		$h = $_xapi{classes};
		for my $k (sort keys %$h) {
			$r .= "  ".sprintf("%-20s %s\n",
				$k,
				($h->{$k}{d} || "(no description)"));
		}
	}
	$r;
}

our $AUTOLOAD;

## get method to call or attribute to get/set
sub AUTOLOAD
{
	my $self = shift;
	my $type = ref $self
		or throw XenAPI::CallError "not an object: $self";

	my $name = $AUTOLOAD;
	$name =~ s/.*://;

	return undef if $name eq "DESTROY";

	if ($name =~ /^_/) {
		## perl object attribute access
		exists $self->{$name}
			or throw XenAPI::CallError "access to non-existant internal attribute `$name'";
		$self->{$name} = shift
			if @_;
		return $self->{$name};
	}

	my $sub = $self->{_class};

	my $i = $_xapi{classes}{$sub}
		or throw XenAPI::CallError "unknown class: $sub";

	my @args = ($self->{_session});

	my $rt;

	## attr?
	if ($i->{a}{$name}) {
		$self->{_self} or throw XenAPI::CallError
			"get/set of attribute `$sub.$name' on disconnected object";
		push @args, $self->{_self};
		my $a = $i->{a}{$name};

		if (@_ == 1) {
			## set
			$a->{a} eq "rw" or throw XenAPI::CallError
				"attempt to write to r/o attribute `$sub.$name'";
			$sub .= ".set_".$name;
			push @args, _convert_to($a->{t}, shift);
			$rt = "void";
		} elsif (@_ == 0) {
			## get
			$sub .= ".get_".$name;
			$rt = $a->{t};
		} else {
			throw XenAPI::CallError
				"attribute set with more than one value for ".
				"`$sub.$name'";
		}
	} elsif ($i->{m}{$name}) {
		my $m = $i->{m}{$name};

		$sub .= ".".$name;

		## method call?
		if ($m->{m}) {
			$self->{_self} or throw XenAPI::CallError
				"called method `$sub' on disconnected object";
			push @args, $self->{_self};
		}

		my @a = $m->{a} ? @{$m->{a}} : ();

		@a == @_ or throw XenAPI::CallError
			"invalid number of arguments for `$sub', expected ".
			scalar(@a).", got ".scalar(@_);
		for my $a (@a) {
			push @args, _convert_to($a->{t}, shift);
		}
		$rt = $m->{r};
	} else {
		throw XenAPI::CallError
			"unknown method/procedure: $sub.$name";
	}

	my $r = $self->_call($sub, @args);
	_convert_from($rt, $r, $self);
}

sub _call
{
	my ($self, $name, @args) = @_;

	my $req = RPC::XML::request->new($name, @args)->as_string;

	my $r = $self->_http_request->clone;

	$r->content($req);
	$r->content_length(length $req);

	my $parser = $self->_xml_parser->parse;
	my $res = $self->_user_agent->request($r,
		sub { $parser->parse_more($_[0]) });

	## die triggered?
	$res->headers->header('X-Died')
		and throw XenAPI::RPCError "error parsing response: ".
		$res->headers->header('X-Died');

	## http ok?
	$res->is_success
		or throw XenAPI::RPCError "request error: ".$res->message;

	my $value;
	eval { $value = $parser->parse_done; };
	## die triggered?
	$@
		and throw XenAPI::RPCError "error parsing response: $@";

	## valid result?
	ref $value
		or throw XenAPI::RPCError "error parsing response: $value";

	## parse status
	$value->is_fault
		and throw XenAPI::RPCError "rpc fault: $value->value";

	## check result, xend returns an XML-RPC struct with:
	## - Status:
	##   a) Success
	##   - Value: value
	##   b) Failure:
	##   - ErrorDescription: Array of string values:
	##     1. error code;
	##     2.. eror parameters.

	ref $value eq "RPC::XML::response"
		or throw XenAPI::RPCError "invalid response format: $value";

	$value = $value->value;
	ref $value eq "RPC::XML::struct"
		or throw XenAPI::RPCError "invalid response object: $value";

	$value = $value->value(1);

	exists($value->{Status}) or throw XenAPI::RPCError
		"invalid response object: $value";

	my $st = $value->{Status}->value;

	$st eq "Error" and throw XenAPI::RPCError "internal server error: ".
			join(" ", @{$value->{ErrorDescription}->value});
	$st eq "Failure" and throw XenAPI::RPCError "call failed: ".
			join(" ", @{$value->{ErrorDescription}->value});
	$st eq "Success" or throw XenAPI::RPCError
		"invalid response result: $st, $value";

	$value->{Value} or throw XenAPI::RPCError "no result value";
}

## parse type, name and description
sub _parse_type
{
	my ($ln, $o, $type, @data) = @_;
	my $name;
	my $desc;

	$type or throw XenAPI::DeclarationError
		"missing type in line $ln: $o\n";

	my $t = lc $type;
	my $sub;
	if ($t eq "set") {
		$sub = 'a';
	} elsif ($t eq "map") {
		$sub = 's';
	} elsif ($t eq "record") {
		$sub = 'r';
	}

	if ($sub) {
		($t, $name, $desc) = _parse_type($ln, $o, @data);
		$type = { a => $sub, t => $t };
	} else {
		$name = shift @data
			or throw XenAPI::DeclarationError
				"missing name in line $ln: $o\n";
		$desc = join(" ", @data);
	}
	($type, $name, $desc);
}

## parse API description and create dictionary
## note: moved from __DATA__ due to inability to access it in CHECK
## and failure to run INIT if not at the very start of the program (use XenAPI)

BEGIN
{
	my $group;
	my ($in_enum, $in_class, $proc);
	my $ln;
	for my $l (split("\n", <<'APIDESC')) {
enum event_operation
	val add an object has been created
	val del an object has been deleted
	val mod an object has been modified

enum console_protocol
	val vt100 VT100 terminal
	val rfb remote framebuffer protocol (as used in VNC)
	val rdp remote desktop protocol

enum vdi_type
	val system a disk that may be replaced on upgrade
	val user a disk that is always preserved on upgrade
	val ephemeral a disk that may be reformatted on upgrade
	val suspend a disk that stores a suspend image
	val crashdump a disk that stores VM crashdump information

enum vm_power_state
	val Halted Halted
	val Paused Paused
	val Running Running
	val Suspended Suspended
	val Unknown Some other unknown state

enum task_allowed_operations
	val Cancel Cancel

enum task_status_type
	val pending task is in progress
	val success task was completed successfully
	val failure task has failed
	val cancelling task is being cancelled
	val cancelled task has been cancelled

enum on_normal_exit
	val destroy destroy the VM state
	val restart restart the VM

enum on_crash_behaviour
	val destroy destroy the VM state
	val coredump_and_destroy record a coredump and then destroy the VM state
	val restart restart the VM
	val coredump_and_restart record a coredump and then restart the VM
	val preserve leave the crashed VM as-is
	val rename_restart rename the crashed VM and start a new copy

enum vbd_mode
	val RO disk is mounted read-only
	val RW disk is mounted read-write

enum vbd_type
	val CD VBD will appear to guest as CD
	val Disk VBD will appear to guest as disk

class session A session
	attr ro host this_host currently connected host
	attr ro user this_user currently connected user
	attr ro int last_inactive timestamp for last time session was active

	proc void logout logout of a session

class task A long-running asynchronous task
	attr ro string name_label a human-readable name
	attr ro string name_description a notes field containing human-readable description
	attr ro task_status_type status current status of the task
	attr ro session session the session that created the task
	attr ro int progress estimated percentage complete, 100 on completed
	attr ro string type type of encoded result, if task was successful
	attr ro string result result value, either Void or an object reference, if task was successful
	attr ro set string error_info set of associated error strings, if task failed
	attr ro set task_allowed_operations allowed_operations operations allowed on this task

	method void cancel cancel this task

	proc set task get_all returns a list of all the tasks known to the system
	proc set task get_by_name_label get all the task instances with the given label
		arg string label

class event Asynchronous event registration and handling
	attr ro int id an ID, monotonically increasing, and local to the current session
	attr ro datetime timestamp the time at which the event occurred
	attr ro string class the name of the class of the object that changed
	attr ro event_operation operation the operation that was performed
	attr ro string ref a reference to the object that changed
	attr ro string obj_uuid the uuid of the object that changed

	proc void register register this session with the event system. an empty list will registar for all classes
		arg set string classes
	proc void unregister unregister this session with the event system
		arg set string classes
	proc set record event next blocking call which returns a (possibly empty) batch of events

class VM A virtual machine (or 'guest')
	attr ro vm_power_state power_state current power state of the machine
	attr rw string name_label a human-readable name
	attr rw string name_description a notes field containing human-readable description
	#attr rw int user_version a user version number for this machine
	#attr rw bool is_a_template true if this is a template; template VMs can never be started, only used for cloning other VMs
	attr rw bool auto_power_on true if this VM should be started automatically after host boot
	attr ro VDI suspend_VDI the VDI that a suspend image is stored on (if VM is currently suspended)
	attr ro host resident_on the host the VM is currently resident on
	attr rw int memory_static_max statically-set (ie. absolute) maximum (bytes)
	attr rw int memory_dynamic_max dynamic maximum (bytes)
	attr rw int memory_dynamic_min dynamic minimum (bytes)
	attr rw int memory_static_min statically-set (ie. absolute) minimum (bytes)
	attr rw map string VCPUs_params configuration parameters for the selected VCPU policy
	#attr rw int VCPUs_max max number of VCPUs
	#attr rw int VCPUs_at_startup boot number of VCPUs
	attr rw on_normal_exit actions_after_shutdown action to take after the guest has shutdown itself
	attr rw on_normal_exit actions_after_reboot action to take after the guest has rebooted itself
	attr rw on_crash_behaviour actions_after_crash action to take if the guest crashes
	attr ro set console consoles virtual console devices
	attr ro set VIF VIFs virtual network interfaces
	attr ro set VBD VBDs virtual block devices
	#attr ro set crashdump crash_dumps crash dumps associated with this VM
	attr ro set VTPM VTPMs virtual TPMs
	attr rw string PV_bootloader name of or path to bootloader
	attr rw string PV_kernel path to the kernel
	attr rw string PV_ramdisk path to the initrd
	attr rw string PV_args kernel command-line arguments
	attr rw string PV_bootloader_args miscellaneous arguments for the bootloader
	attr rw string HVM_boot_policy HVM boot policy
	attr rw map string HVM_boot_params HVM boot params
	attr rw map string platform platform-specific configuration
	attr rw string PCI_bus PCI bus path for pass-through devices
	attr rw map string other_config additional configuration
	attr ro int domid domain ID (if available, -1 otherwise)
	attr ro bool is_control_domain true if this is a control domain (domain 0 or a driver domain)
	attr ro VM_metrics metrics metrics associated with this VM
	attr ro VM_guest_metrics guest_metrics metrics associated with the running guest

	method VM clone clones the VM, making a new one; can only be called when the VM is halted
		arg string new_name
	method void start start the VM; can only be called when the VM is halted
		arg bool start_paused
	method void pause pause the VM; can only be called when the VM is running
	method void unpause unpause the VM; can only be called when the VM is paused
	method void clean_shutdown attempt to cleanly shutdown the VM, and then poweroff; can only be called when the VM is running
	method void clean_reboot attempt to cleanly shutdown the VM, and then reboot; can only be called when the VM is running
	method void hard_shutdown stop executing the VM without attempting a clean shutdown, then poweroff
	method void hard_reboot stop executing the VM without attempting a clean shutdown, then reboot
	method void suspend suspend the VM to disk; can only be called when the VM is running
	method void resume awaken the VM and resume it; can only be called when the VM is suspended
		arg bool start_paused
	method void set_VCPUs_number_live set this VM's VCPUs
		arg int nvcpu
	method void add_to_VCPUs_params_live add the given key-value pair to VM.VCPUs_params
		arg string key
		arg string value
	method void set_memory_dynamic_max_live set memory.dynamic_max in database and on running VM
		arg int max
	method void set_memory_dynamic_min_live set memory.dynamic_min in database and on running VM
		arg int min
	method void send_sysrq send the given key as a sysrq to the VM, specified as a single character; can only be called when the VM is running
		arg string key
	method void send_trigger send the named trigger to the VM; can only be called when the VM is running
		arg string trigger
	method void migrate migrate the VM to another host; can only be called when the VM is running
		arg string dest
		arg bool live
		arg map string options
	method void destroy destroy the VM, completely removing it from the system; can only be called when the VM is halted

	proc set VM get_all return a list of all the VMs known to the system
	proc VM create create a new VM instance
		arg record VM args
	proc set VM get_by_name_label get all the VM instances with the given label
		arg string label

class VM_metrics The metrics associated with a VM
	attr ro int memory_actual guest's actual memory (bytes)
	attr ro int VCPUs_number current number of VCPUs
	attr ro map float VCPUs_utilisation utilisation for all of guest's current VCPUs
	attr ro map int VPUs_CPU VCPU to PCPU map
	attr ro map string VCPUs_params the live equivalent to VM.VCPUs_params
	attr ro map set string VCPUs_flags CPU flags (blocked, online, running)
	attr ro set string state state of the guest, e.g. blocked, dying, etc.
	attr ro datetime start_time time at which this vm was last booted
	attr ro datetime last_updated time at which this information was last updated

	proc set VM_metrics get_all return a list of all the VM_metrics instances known to the system

class VM_guest_metrics The metrics reported by the guest (as opposed to inferred from outside)
	attr ro map string os_version version of the OS
	attr ro map string PV_drivers_version version of the PV drivers
	attr ro map string memory free/used/total memory
	attr ro map string disks disk configuration/free space
	attr ro map string networks network configuration
	attr ro map string other anything else
	attr ro datetime last_updated time at which this information was last updated

	proc set VM_guest_metrics get_all return a list of all the VM_guest_metrics instances known to the system

class host A physical host
	attr rw string name_label a human-readable name
	attr rw string name_description a notes field containing human-readable description
	attr ro int API_version_major major version number
	attr ro int API_version_minor minor version number
	attr ro string API_version_vendor identification of vendor
	attr ro map string API_version_vendor_implementation details of vendor implementation
	attr ro bool enabled true if the host is currently enabled
	attr ro map string software_version version strings
	attr rw map string other_config additional configuration
	attr ro set string capabilities Xen capabilities
	attr ro map string cpu_configuration the CPU configuration on this host; may contain keys such as "nr_nodes", "sockets_per_node", "cores_per_socket" or "threads_per_core"
	attr ro string sched_policy scheduler policy currently in force on this host
	attr ro set string supported_bootloaders a list of the bootloaders installed on the machine
	attr ro set VM resident_VMs list of VMs currently resident on this host
	#attr rw map string logging logging configuration
	#attr ro set PIF PIFs physical network interfaces
	#attr rw SR suspend_image_sr the sr in which VDIs for suspend images are created
	#attr rw SR crash_dump_sr the sr in which VDIs for crash dumps are created
	attr ro set PBD PBDs physical blockdevices
	attr ro set host_cpu host_CPUs the physical cpus on this host
	attr ro host_metrics metrics metrics associated with this host

	method void disable put this host into a state in which no new VMs can be started; currently active VMs on the host continue to execute
	method void enable puts the host into a state in which new VMs can be started
	method void shutdown shutdown the host; can only be called if there are no currently running VMs on the host and it is disabled
	method void reboot reboot the host; can only be called if there are no currently running VMs on the host and it is disabled
	method string dmesg get the host xen dmesg
	method void dmesg_clear get the host xen dmesg, and clear the buffer
	method string get_log get the host's log file
	method void send_debug_keys inject the given string as debugging keys into Xen
		arg string keys

	method void add_to_other_config add the given key-value pair to the other_config field
		arg string key
		arg string value
	method void remove_from_other_config remove the given key and its value from the other_config field
		arg string key
	method void add_to_logging add the given key-value pair to the logging field
		arg string key
		arg string value
	method void remove_from_logging remove the given key and its value from the logging field
		arg string key

	proc set host get_all return a list of all the hosts known to the system
	proc set string list_methods list all supported methods

class host_metrics The metrics associated with a host
	attr ro int memory_total host's total memory (bytes)
	attr ro int memory_free host's free memory (bytes)
	attr ro datetime last_updated time at which this information was last updated

	proc set host_metrics get_all return a list of all the host_metrics instances known to the system

class host_cpu A physical CPU
	attr ro host host the host the cpu is in
	attr ro int number the number of the physical CPU within the host
	attr ro string vendor the vendor of the physical CPU
	attr ro int speed the speed of the physical CPU
	attr ro string modelname the model name of the physical CPU
	attr ro string stepping the stepping of the physical CPY
	attr ro string flags the flags of the physical CPU (a decoded version of the features field)
	attr ro string features the physical CPU feature bitmap
	attr ro float utilisation the current CPU utilisation

	proc set host_cpu get_all return a list of all the host_cpu instances known to the system

class network A virtual network
	attr rw string name_label a human-readable name
	#attr rw string name_description a notes field containing human-readable description
	attr ro set VIF VIFs list of connected vifs
	attr ro set PIF PIFs list of connected pifs
	attr rw map string other_config additional configuration

	method void add_to_other_config add the given key-value pair to the other_config field
		arg string key
		arg string value
	method void remove_from_other_config add the given key-value pair to the other_config field
		arg string key
	method void destroy destroy the network instance

	proc set network get_all return a list of all the network instances known to the system
	proc network create create a new network instance
		arg record network args
	proc set network get_by_name_label get all the network instances with the given label
		arg string label

class VIF A virtual network interface
	attr rw string device name of network device as exposed to guest, e.g. eth0
	attr ro network network virtual network to which this vif is connected
	attr ro VM VM virtual machine to which this vif is connected
	attr rw string MAC ethernet MAC address of virtual interface, as exposed to guest
	attr rw int MTU MTU in octets
	attr ro bool currently_attached is the device currently attached (erased on reboot)
	attr ro int status_code error/success code associated with last attach-operation (erased on reboot)
	attr ro string status_detail error/success information associated with last attach-operation status (erased on reboot)
	attr ro map string runtime_properties device runtime properties
	attr rw string qos_algorithm_type QoS algorithm to use
	attr rw map string qos_algorithm_params parameters for chosen QoS algorithm
	attr ro set string qos_supported_algorithms supported QoS algorithms for this VIF
	attr ro VIF_metrics metrics metrics associated with this VIF

	method void plug dynamically attach to the running VM
	method void unplug dynamically dettach from the running VM
	method void add_to_qos_algorithm_params add the given key-value pair to the qos/algorithm_params field
		arg string key
		arg string value
	method void remove_from_qos_algorithm_params remove the given key and its value from the qos/algorithm_params field
		arg string key
	method void destroy destroy this VIF

	proc set VIF get_all return a list of all the VIF instances known to the system
	proc VIF create create a new VIF instance
		arg record VIF args

class VIF_metrics The metrics associated with a virtual network device
	attr ro float io_read_kbs read bandwidth (KiB/s)
	attr ro float io_write_kbs write bandwidth (KiB/s)
	attr ro datetime last_updated time at which this information was last updated

	proc set VIF_metrics get_all return a list of all the VIF_metrics instances known to the system

class PIF A physical network interface (note: separate VLANs are represented as several PIFs)
	attr rw string device machine-readable name of the interface (e.g. eth0)
	attr ro network network virtual network to which this pif is connected
	attr ro host host physical machine to which this pif is connected
	attr rw string MAC ethernet MAC address of physical interface
	attr rw int MTU MTU in octets
	attr rw int VLAN VLAN tag for all traffic passing through this interface
	attr ro PIF_metrics metrics metrics associated with this PIF

	method void destroy destroy the interface (provided it is a synthetic interface like a VLAN; fail if it is a physical interface)

	proc PIF create_VLAN create a VLAN interface from an existing physical interface
		arg string device
		arg network network
		arg host host
		arg int VLAN
	proc set PIF get_all return a list of all the PIF instances known to the system

class PIF_metrics The metrics associated with a physical network interface
	attr ro float io_read_kbs read bandwidth (KiB/s)
	attr ro float io_write_kbs write bandwidth (KiB/s)
	attr ro datetime last_updated time at which this information was last updated

	proc set PIF_metrics get_all return a list of all the PIF_metrics instances known to the system

class SR A storage repository
	attr rw string name_label a human-readable name
	attr rw string name_description a notes field containing human-readable description
	attr ro set VDI VDIs managed virtual disks
	attr ro set PBD PBDs physical blockdevices
	attr ro int virtual_allocation sum of virtual_sizes of all VDIs in this storage repository (in bytes)
	attr ro int physical_utilisation physical space current utilised on the storage repository (in bytes)
	attr ro int physical_size total physical size of the repository (in bytes)
	attr ro string type type of the storage repository
	attr ro string content_type type of the SR's content, fi required (e.g. ISOs)

	proc set string get_supported_types return a set of all the SR types supported by the system
	proc set SR get_all return a list of all the SR instances known to the system

class VDI A virtual disk image
	attr rw string name_label a human-readable name
	attr rw string name_description a notes field containing human-readable description
	attr ro SR SR storage repository in which the VDI resides
	attr ro set VBD VBDs list of vbds that refer to this disk
	attr ro set crashdump crash_dumps list of crash dumps that refer to this disk
	attr rw int virtual_size size of disk as presented to the guest (in bytes)
	attr ro int physical_utilisation amount of physical space that the disk image is currently taking up on the storage repository (in bytes)
	attr ro vdi_type type type of the VDI
	attr rw bool sharable true if this disk may be shared
	attr rw bool read_only true if this disk may ONLY be mounted read-only
	attr rw map string other_config additional configuration

	method void add_to_other_config add the given key-value pair to the other_config field
		arg string key
		arg string value
	method void remove_from_other_config add the given key-value pair to the other_config field
		arg string key

	method void destroy destroy this VDI

	proc set VDI get_all return a list of all the VDI instances known to the system
	proc VDI create create a new VDI instance
		arg record VDI args

class VBD A virtual block device
	attr ro VM VM the virtual machine
	attr ro VDI VDI the virtual disk
	attr rw string device device seen by the guest (e.g. hda1)
	attr rw bool bootable true if this VBD is bootable
	attr rw vbd_mode mode the mode the VBD should be mounted with
	attr rw vbd_type type how the VBD will appear to the guest (e.g. disk or CD)
	attr ro bool currently_attached is the device currently attached (erased on reboot)
	attr ro int status_code error/success code associated with last attach-operation (erased on reboot)
	attr ro string status_detail error/success information associated with last attach-operation status (erased on reboot)
	attr ro map string runtime_properties device runtime properties
	attr rw string qos_algorithm_type QoS algorithm to use
	attr rw map string qos_algorithm_params parameters for chosen QoS algorithm
	attr ro set string qos_supported_algorithms supported QoS algorithms for this VBD
	attr ro VBD_metrics metrics metrics associated with this VBD

	method void media_change change the media in the deivce for CDROM-like devices only. For other devices, detach the VBD and attach a new one
		arg VDI vdi
	method void plug dynamically attach the VBD to the running VM
	method void unplug dynamically dettach the VBD to the running VM
	method void destroy destroy this VBD
	method void add_to_qos_algorithm_params add the given key-value pair to the qos/algorithm_params field
		arg string key
		arg string value
	method void remove_from_qos_algorithm_params remove the given key and its value from the qos/algorithm_params field
		arg string key

	proc set VBD get_all return a list of all the VBD instances known to the system
	proc VBD create create a new VBD instance
		arg record VBD args

class VBD_metrics The metrics associated with a virtual block device
	attr ro float io_read_kbs read bandwidth (KiB/s)
	attr ro float io_write_kbs write bandwidth (KiB/s)
	attr ro datetime last_updated time at which this information was last updated

	proc set VBD_metrics get_all return a list of all the VBD_metrics instances known to the system

class PBD The physical block devices through which hosts access SRs
	attr ro host host physical machine on which the pbd is available
	attr ro SR SR the storage repository that the pbd realises
	attr ro map string device_config a config string to string map that is provided to the host's SR-backend-driver
	attr ro bool currently_attached is the SR currently attached on this host?

	method void destroy destroy this PBD
	proc set PBD get_all return a list of all the PBD instances known to the system
	proc PBD create create a new PBD instance
		arg record PBD args

class crashdump A VM crashdump
	attr ro VM VM the virtual machine
	attr ro VDI VDI the virtual disk

	method void destroy destroy this crashdump instance

	proc set crashdump get_all return a list of all the crashdump instances known to the system

class VTPM A virtual TPM device
	attr ro VM VM the virtual machine
	attr ro VM backend the domain where the backend is located

	method void destroy destroy this VTPM instance

	proc VTPM create create a new VTPM instance
		arg record VTPM args

class console A console
	attr ro console_protocol protocol the protocol used by this console
	attr ro string location URI for the console service
	attr ro VM VM VM to which this console is attached
	attr rw map string other_config additional configuration

	method void destroy destroy this console instance

	proc set console get_all return a list of all the console instances known to the system
	proc console create create a new console instance
		arg record console args

class user A user of the system
	attr ro string short_name short name (e.g. userid)
	attr rw string fullname full name

	method void destroy destroy this user instance

	proc user create create a new user instance
		arg record user args

class debug A basic class for testing
	proc set debug get_all return a list of all the debug instances known to the system
	proc void return_failure return an PI 'successful' failure
	proc debug create create a new debug instance
		arg record debug args
	method void destroy destroy this debug instance
APIDESC
		$ln++;
		chomp $l;
		my $o = $l;

		## remove comments
		$l =~ s/#.*//;
		## skip empty lines
		next if $l =~ /^\s*$/;
		## trim empty space
		$l =~ s/^\s+//;
		$l =~ s/\s+$//;

		my ($desc, $p1, @data) = split " ", $l;

		$p1 or throw XenAPI::DeclarationError
			"invalid declaration in line $ln: $o\n";

		$desc = lc $desc;
		if ($desc eq "enum") {
			$_xapi{enums}{$p1}{d} = join(" ", @data);
			$group = $p1;
			$in_enum = 1;
			$in_class = 0;
			undef $proc;
		} elsif ($desc eq "class") {
			$_xapi{classes}{$p1}{d} = join(" ", @data);
			$group = $p1;
			$in_enum = 0;
			$in_class = 1;
			undef $proc;

			## in every class:
			$_xapi{classes}{$p1}{m}{get_by_uuid} = {
				r => $p1,
				d => "get object with this uuid",
				a => [{
					t => "string",
					n => "uuid",
					d => "uuid value",
				}],
			};
			## in every object:
			$_xapi{classes}{$p1}{a}{record} = {
				d => "record containing the current state of the given object",
				t => { a => 'r', t => $p1 },
				a => "ro",
			};
			$_xapi{classes}{$p1}{a}{uuid} = {
				d => "unique identifier/object reference",
				t => "string",
				a => "ro",
			};
		} elsif ($desc eq "val" && $in_enum) {
			$_xapi{enums}{$group}{v}{$p1} = join(" ", @data);
			$_xapi{enums}{$group}{l}{lc $p1} = $p1;
		} elsif ($desc eq "attr" && $in_class) {
			undef $proc;
			$p1 = lc $p1;
			$p1 eq "ro" || $p1 eq "rw"
				or throw XenAPI::DeclarationError
					"invalid attribute protection `$p1' ".
					"in line $ln: $o\n";
			my ($type, $name, $desc) = _parse_type($ln, $o, @data);
			$_xapi{classes}{$group}{a}{$name} = {
				d => $desc,
				t => $type,
				a => $p1,
			};
		} elsif ($desc eq "method" && $in_class) {
			my ($type, $name, $desc) = _parse_type($ln, $o, $p1, @data);
			$proc = $name;
			$_xapi{classes}{$group}{m}{$name} = {
				m => 1,
				r => $type,
				d => $desc,
			};
		} elsif ($desc eq "proc" && $in_class) {
			my ($type, $name, $desc) = _parse_type($ln, $o, $p1, @data);
			$proc = $name;
			$_xapi{classes}{$group}{m}{$name} = {
				r => $type,
				d => $desc,
			};
		} elsif ($desc eq "arg" && $in_class && $proc) {
			my ($type, $name, $desc) = _parse_type($ln, $o, $p1, @data);
			push @{$_xapi{classes}{$group}{m}{$proc}{a}}, {
				t => $type,
				n => $name,
				d => $desc,
			};
		} else {
			throw XenAPI::DeclarationError
				"unexpected type `$desc' in line $ln: $o\n";
		}
	}
}

1;