Commit 00d377b1 authored by Daniel P. Berrange's avatar Daniel P. Berrange

Fully implement domain events, event loops and authentication APIs. Update to 0.2.0

parent a2ee083d
Sys::Virt ChangeLog
===================
Since 0.1.2:
- Implement storage, node device, event APIs
- Full covereage of all APIs in 0.6.1 release of libvirt
- Full documentation coverage
- Ability to authenticate when openning connections
Since 0.1.1:
- Added manual written META.yml
......
......@@ -15,3 +15,5 @@ CVS
^Makefile$
^cover_db/
.hg
.*\.orig
.*\.sh
......@@ -39,6 +39,7 @@ build_requires:
XML::XPath: 0
XML::XPath::XMLParser: 0
Sys::Hostname: 0
Time::HiRes: 0
resources:
license: http://www.gnu.org/licenses/gpl.html
......
......@@ -4,7 +4,9 @@
This module provides a Perl XS binding for the libvirt APIs. For
further details on libvirt consult its website http://libvirt.org/
The only pre-requisite for this module is libvirt itself. For
The only pre-requisite for this module is libvirt itself. For
installation instructions, consult the INSTALL file.
The current minimum required version of libvirt is 0.6.1
-- End
This diff is collapsed.
# -*- perl -*-
use strict;
use warnings;
use Sys::Virt;
my $addr = @ARGV ? shift @ARGV : "";
print "Addr $addr\n";
my $con = Sys::Virt->new(address => $addr, readonly => 0, auth => 1,
credlist => [
Sys::Virt::CRED_AUTHNAME,
Sys::Virt::CRED_PASSPHRASE,
],
callback => sub {
my $creds = shift;
foreach my $cred (@{$creds}) {
if ($cred->{type} == Sys::Virt::CRED_AUTHNAME) {
$cred->{result} = "test";
}
if ($cred->{type} == Sys::Virt::CRED_PASSPHRASE) {
$cred->{result} = "123456";
}
}
return 0;
});
print "VMM type: ", $con->get_type(), "\n";
......@@ -63,7 +63,7 @@ use Sys::Virt::Error;
use Sys::Virt::Domain;
use Sys::Virt::Network;
our $VERSION = '0.1.2';
our $VERSION = '0.2.0';
require XSLoader;
XSLoader::load('Sys::Virt', $VERSION);
......@@ -118,7 +118,18 @@ sub new {
my $uri = exists $params{address} ? $params{address} : exists $params{uri} ? $params{uri} : "";
my $readonly = exists $params{readonly} ? $params{readonly} : 0;
my $self = Sys::Virt::_open($uri, $readonly);
my $auth = exists $params{auth} ? $params{auth} : 0;
my $authcb = exists $params{callback} ? $params{callback} : undef;
my $credlist = exists $params{credlist} ? $params{credlist} : undef;
my $self;
if ($auth) {
$self = Sys::Virt::_open_auth($uri, $readonly, $credlist, $authcb);
} else {
$self = Sys::Virt::_open($uri, $readonly);
}
bless $self, $class;
......@@ -687,6 +698,23 @@ sub get_version {
Returns a hash reference summarising the capabilities of the host
node. The elements of the hash are as follows:
=item $conn->domain_event_register($callback)
Register a callback to received notificaitons of domain state change
events. Only a single callback can be registered with each connection
instance. The callback will be invoked with four paramters, an
instance of C<Sys::Virt> for the connection, an instance of C<Sys::Virt::Domain>
for the domain changing state, and a C<event> and C<detail> arguments,
corresponding to the event constants defined in the C<Sys::Virt::Domain>
module. Before discarding the connection object, the callback must be
deregistered, otherwise the connection object memory will never be
released in garbage collection.
=item $conn->domain_event_deregister()
Unregister a callback, allowing the connection object to be garbage
collected.
=over 4
=item memory
......@@ -749,31 +777,6 @@ Returns the free memory on each NUMA cell between C<$start> and C<$end>.
The following sets of constants are useful when dealing with APIs
in this package
=head2 EVENT LOOP INTEGRATION
When integrating with an event loop the following constants
define the file descriptor events
=over 4
=item Sys::Virt::EVENT_HANDLE_READABLE
The file descriptor has data available for read without blocking
=item Sys::Virt::EVENT_HANDLE_WRITABLE
The file descriptor has ability to write data without blocking
=item Sys::Virt::EVENT_HANDLE_ERROR
An error occurred on the file descriptor
=item Sys::Virt::EVENT_HANDLE_HANGUP
The remote end of the file descriptor closed
=back
=head2 CREDENTIAL TYPES
When providing authentication callbacks, the following constants
......
# -*- perl -*-
#
# Copyright (C) 2006 Red Hat
# Copyright (C) 2006-2007 Daniel P. Berrange
#
# This program is free software; You can redistribute it and/or modify
# it under either:
#
# a) the GNU General Public License as published by the Free
# Software Foundation; either version 2, or (at your option) any
# later version,
#
# or
#
# b) the "Artistic License"
#
# The file "LICENSE" distributed along with this file provides full
# details of the terms and conditions of the two licenses.
=pod
=head1 NAME
Sys::Virt::Event - An event loop contract
=head1 DESCRIPTION
The C<Sys::Virt::Event> module represents the contract for integrating
libvirt with an event loop. This package is abstract and intended to
be subclassed to provide an actual implementation.
=head1 METHODS
=over 4
=cut
package Sys::Virt::Event;
use strict;
use warnings;
our $eventimpl = undef;
=item register($impl)
Register an event loop implementation. The implementation should be a
instance of a sub-class of the C<Sys::Virt::Event> package.
=cut
sub register {
my $impl = shift;
if (!(ref($impl) &&
$impl->isa("Sys::Virt::Event"))) {
die "event implementation must be a subclass of Sys::Virt::Event";
}
$eventimpl = $impl;
Sys::Virt::Event::_register_impl();
}
sub _add_handle {
$eventimpl->add_handle(@_);
}
sub _update_handle {
$eventimpl->update_handle(@_);
}
sub _remove_handle {
$eventimpl->remove_handle(@_);
}
sub _add_timeout {
$eventimpl->add_timeout(@_);
}
sub _update_timeout {
$eventimpl->update_timeout(@_);
}
sub _remove_timeout {
$eventimpl->remove_timeout(@_);
}
=item $self->_run_handle_callback($watch, $fd, $events, $cb, $opaque)
A helper method for executing a callback in response to one of more
C<$events> on the file handle C<$fd>. The C<$watch> number is the
unique idenifier associated with the file descriptor. The C<$cb>
and C<$opaque> parameters are the callback and data registered for
the handle.
=cut
sub _run_handle_callback {
my $self = shift;
my $watch = shift;
my $fd = shift;
my $events = shift;
my $cb = shift;
my $opaque = shift;
Sys::Virt::Event::_run_handle_callback_helper($watch, $fd, $events, $cb, $opaque);
}
=item $self->_run_timeout_callback($timer, $cb, $opaque)
A helper method for executing a callback in response to the
expiry of a timeout identified by C<$timer>. The C<$cb>
and C<$opaque> parameters are the callback and data registered for
the timeout.
=cut
sub _run_timeout_callback {
my $self = shift;
my $timer = shift;
my $cb = shift;
my $opaque = shift;
Sys::Virt::Event::_run_timeout_callback_helper($timer, $cb, $opaque);
}
=item $self->_free_callback_opaque($ff, $opaque)
A helper method for freeing the data associated with a callback.
The C<$ff> and C<$opaque> parameters are the callback and data
registered for the handle/timeout.
=cut
sub _free_callback_opaque {
my $self = shift;
my $ff = shift;
my $opaque = shift;
Sys::Virt::Event::_free_callback_opaque_helper($ff, $opaque);
}
1;
=back
=head1 CONSTANTS
=head2 FILE HANDLE EVENTS
When integrating with an event loop the following constants
define the file descriptor events
=over 4
=item Sys::Virt::Event::HANDLE_READABLE
The file descriptor has data available for read without blocking
=item Sys::Virt::Event::HANDLE_WRITABLE
The file descriptor has ability to write data without blocking
=item Sys::Virt::Event::HANDLE_ERROR
An error occurred on the file descriptor
=item Sys::Virt::Event::HANDLE_HANGUP
The remote end of the file descriptor closed
=back
=head1 AUTHORS
Daniel P. Berrange <berrange@redhat.com>
=head1 COPYRIGHT
Copyright (C) 2006-2009 Red Hat
Copyright (C) 2006-2009 Daniel P. Berrange
=head1 LICENSE
This program is free software; you can redistribute it and/or modify
it under the terms of either the GNU General Public License as published
by the Free Software Foundation (either version 2 of the License, or at
your option any later version), or, the Artistic License, as specified
in the Perl README file.
=head1 SEE ALSO
L<Sys::Virt>, C<http://libvirt.org>
=cut
......@@ -11,7 +11,7 @@ unless (do 'lib/Sys/Virt.pm')
if ($@) { die $@ };
die "lib/Sys/Virt.pm: $!";
}
local $/ = undef;
$_ = <DATA>;
s/\@VERSION\@/$Sys::Virt::VERSION/g;
......@@ -41,12 +41,14 @@ Group: Development/Tools
Source: %{appname}-%{version}.tar.gz
BuildRoot: /var/tmp/%{appname}-%{version}-root
Requires: perl >= %{perlversion}
Requires: libvirt >= 0.1.0
BuildRequires: libvirt-devel >= 0.1.0
Requires: libvirt >= 0.6.1
BuildRequires: libvirt-devel >= 0.6.1
BuildRequires: perl(Test::More)
BuildRequires: perl(Time::HiRes)
%description
Sys::Virt provides an API for using the libvirt library from Perl
%prep
%setup -q -n %{appname}-%{version}
......
# -*- perl -*-
use strict;
use warnings;
use Test::More tests => 12;
my $URI = "test:///default";
my $DOM = "test";
BEGIN {
use_ok('Sys::Virt');
}
package Sys::Virt::Event::Simple;
use Time::HiRes qw(gettimeofday);
use base qw(Sys::Virt::Event);
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {};
$self->{nexthandle} = 1;
$self->{handles} = [];
$self->{nexttimeout} = 1;
$self->{timeouts} = [];
bless $self, $class;
$self->register;
return $self;
}
sub _now {
my $self;
my @now = gettimeofday;
return $now[0] * 1000 + (($now[1] - ($now[1] % 1000)) / 1000);
}
sub _bits {
my $self = shift;
my $event = shift;
my $vec = '';
my $count = 0;
foreach my $handle (@{$self->{handles}}) {
next unless $handle->{events} & $event;
$count++;
vec($vec, $handle->{fd}, 1) = 1;
}
return ($vec, $count);
}
sub run_once {
my $self = shift;
my ($ri, $ric) = $self->_bits(Sys::Virt::Event::HANDLE_READABLE);
my ($wi, $wic) = $self->_bits(Sys::Virt::Event::HANDLE_WRITABLE);
my ($ei, $eic) = $self->_bits(Sys::Virt::Event::HANDLE_READABLE |
Sys::Virt::Event::HANDLE_WRITABLE);
my $timeout = $self->_timeout($self->_now);
if (!$ric && !$wic && !$eic && !(defined $timeout)) {
return;
}
my ($ro, $wo, $eo);
my $n = select($ro=$ri,$wo=$wi,$eo=$ei,
(defined $timeout ? ($timeout ? $timeout/1000 : 0) : undef));
if ($n) {
$self->_dispatch_handles($ro, $wo, $eo);
}
$self->_dispatch_timeouts($self->_now);
return 1;
}
sub run {
my $self = shift;
$self->{shutdown} = 0;
while (!$self->{shutdown}) {
$self->_run_once();
}
}
sub _dispatch_handles {
my $self = shift;
my $ro = shift;
my $wo = shift;
my $eo = shift;
foreach my $handle (@{$self->{handles}}) {
my $events = 0;
if (vec($ro, $handle->{fd}, 1)) {
$events |= Sys::Virt::Event::HANDLE_READABLE;
}
if (vec($wo, $handle->{fd}, 1)) {
$events |= Sys::Virt::Event::HANDLE_WRITABLE;
}
if (vec($eo, $handle->{fd}, 1)) {
$events |= Sys::Virt::Event::HANDLE_ERROR;
}
if ($events) {
$self->_run_handle_callback($handle->{watch},
$handle->{fd},
$events,
$handle->{cb},
$handle->{opaque});
}
}
}
sub _timeout {
my $self = shift;
my $now = shift;
my $ret = undef;
foreach my $timeout (@{$self->{timeouts}}) {
if ($timeout->{interval} != -1) {
my $wait = $timeout->{expiresAt} - $now;
$wait = 0 if $wait < 0;
$ret = $wait if !defined($ret) || $wait < $ret;
}
}
return $ret;
}
sub _dispatch_timeouts {
my $self = shift;
my $now = shift;
foreach my $timeout (@{$self->{timeouts}}) {
if ($timeout->{interval} != -1 &&
$now >= $timeout->{expiresAt}) {
$self->_run_timeout_callback($timeout->{timer},
$timeout->{cb},
$timeout->{opaque});
$timeout->{expiresAt} = $now + $timeout->{interval};
}
}
}
sub add_handle {
my $self = shift;
my $fd = shift;
my $events = shift;
my $cb = shift;
my $opaque = shift;
my $ff = shift;
my $handle = {
fd => $fd,
events => $events,
cb => $cb,
opaque => $opaque,
ff => $ff,
watch => $self->{nexthandle}++,
};
push @{$self->{handles}}, $handle;
return $handle->{watch};
}
sub update_handle {
my $self = shift;
my $watch = shift;
my $events = shift;
my @handle = grep { $_->{watch} == $watch } @{$self->{handles}};
$handle[0]->{events} = $events;
}
sub remove_handle {
my $self = shift;
my $watch = shift;
my @handle = grep { $_->{watch} == $watch } @{$self->{handles}};
my @handles = grep { $_->{watch} != $watch } @{$self->{handles}};
$self->{handles} = \@handles;
$self->_free_callback_opaque($handle[0]->{ff},
$handle[0]->{opaque});
}
sub add_timeout {
my $self = shift;
my $interval = shift;
my $cb = shift;
my $opaque = shift;
my $ff = shift;
my $timeout = {
interval => $interval,
cb => $cb,
opaque => $opaque,
ff => $ff,
timer => $self->{nexttimeout}++,
expiresAt => $self->_now() + $interval,
};
push @{$self->{timeouts}}, $timeout;
return $timeout->{timer};
}
sub update_timeout {
my $self = shift;
my $timer = shift;
my $interval = shift;
my @timeout = grep { $_->{timer} == $timer } @{$self->{timeouts}};
$timeout[0]->{interval} = $interval;
$timeout[0]->{expiresAt} = $self->_now() + $interval;
}
sub remove_timeout {
my $self = shift;
my $timer = shift;
my @timeout = grep { $_->{timer} == $timer } @{$self->{timeouts}};
my @timeouts = grep { $_->{timer} != $timer } @{$self->{timeouts}};
$self->{timeouts} = \@timeouts;
$self->_free_callback_opaque($timeout[0]->{ff},
$timeout[0]->{opaque});
}
package main;
my $ev = Sys::Virt::Event::Simple->new();
my $conn = Sys::Virt->new(uri => $URI);
isa_ok($conn, "Sys::Virt");
my $dom = $conn->get_domain_by_name($DOM);
my @events;
$conn->domain_event_register(
sub {
my $con = shift;
my $dom = shift;
my $event = shift;
my $detail = shift;
push @events, [$con, $dom, $event, $detail];
});
$dom->destroy;
$ev->run_once();
is(int(@events), 1, "got 1st event");
is($events[0]->[0]->get_uri(), $URI, "got URI");
is($events[0]->[1]->get_name(), $DOM, "got name");
is($events[0]->[2], Sys::Virt::Domain::EVENT_STOPPED, "stopped");
is($events[0]->[3], Sys::Virt::Domain::EVENT_STOPPED_DESTROYED, "destroy");
$dom->create;
$ev->run_once();
is(int(@events), 2, "got 2nd event");
is($events[1]->[0]->get_uri(), $URI, "got URI");
is($events[1]->[1]->get_name(), $DOM, "got name");
is($events[1]->[2], Sys::Virt::Domain::EVENT_STARTED, "started");
is($events[1]->[3], Sys::Virt::Domain::EVENT_STARTED_BOOTED, "booted");
$conn->domain_event_deregister;
$conn = undef;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment