From 2f70ca487bee8babe5aef27f00a2131ea86ebd50 Mon Sep 17 00:00:00 2001 From: Richard Jones Date: Thu, 9 Jul 2009 14:01:58 +0100 Subject: [PATCH] Add Sys::Guestfs::Lib - useful functions for using libguestfs from Perl. This adds an extra Perl module called Sys::Guestfs::Lib which adds useful functions for using libguestfs from Perl. The intention is that common code shared between virt-inspector, virt-df and virt-v2v will move into this library. This patch also changes virt-inspector to use this library. --- inspector/virt-inspector.pl | 65 ++------------ perl/Makefile.am | 1 + perl/README | 20 +++++ perl/lib/Sys/Guestfs/Lib.pm | 205 ++++++++++++++++++++++++++++++++++++++++++++ src/generator.ml | 9 +- 5 files changed, 243 insertions(+), 57 deletions(-) create mode 100644 perl/README create mode 100644 perl/lib/Sys/Guestfs/Lib.pm diff --git a/inspector/virt-inspector.pl b/inspector/virt-inspector.pl index 3557a38..2922ecc 100755 --- a/inspector/virt-inspector.pl +++ b/inspector/virt-inspector.pl @@ -20,6 +20,7 @@ use warnings; use strict; use Sys::Guestfs; +use Sys::Guestfs::Lib qw(open_guest); use Pod::Usage; use Getopt::Long; use Data::Dumper; @@ -27,9 +28,6 @@ use File::Temp qw/tempdir/; use XML::Writer; # Optional: -eval "use Sys::Virt;"; -eval "use XML::XPath;"; -eval "use XML::XPath::XMLParser;"; eval "use YAML::Any;"; =encoding utf8 @@ -202,61 +200,15 @@ GetOptions ("help|?" => \$help, pod2usage (1) if $help; pod2usage ("$0: no image or VM names given") if @ARGV == 0; -# Domain name or guest image(s)? - -my @images; -if (-e $ARGV[0]) { - @images = @ARGV; - - foreach (@images) { - if (! -r $_) { - die "guest image $_ does not exist or is not readable\n" - } - } +my $rw = 0; +$rw = 1 if $output eq "fish"; +my $g; +if ($uri) { + $g = open_guest (\@ARGV, rw => $rw, address => $uri); } else { - die "virt-inspector: no libvirt support (install Sys::Virt, XML::XPath and XML::XPath::XMLParser)\n" - unless exists $INC{"Sys/Virt.pm"} && - exists $INC{"XML/XPath.pm"} && - exists $INC{"XML/XPath/XMLParser.pm"}; - - pod2usage ("$0: too many domains listed on command line") if @ARGV > 1; - - my $vmm; - if (defined $uri) { - $vmm = Sys::Virt->new (uri => $uri, readonly => 1); - } else { - $vmm = Sys::Virt->new (readonly => 1); - } - die "cannot connect to libvirt $uri\n" unless $vmm; - - my @doms = $vmm->list_defined_domains (); - my $isitinactive = "an inactive libvirt domain"; - if ($output ne "fish") { - # In the special case where we want read-only access to - # a domain, allow the user to specify an active domain too. - push @doms, $vmm->list_domains (); - $isitinactive = "a libvirt domain"; - } - my $dom; - foreach (@doms) { - if ($_->get_name () eq $ARGV[0]) { - $dom = $_; - last; - } - } - die "$ARGV[0] is not the name of $isitinactive\n" unless $dom; - - # Get the names of the image(s). - my $xml = $dom->get_xml_description (); - - my $p = XML::XPath->new (xml => $xml); - my @disks = $p->findnodes ('//devices/disk/source/@dev'); - @images = map { $_->getData } @disks; + $g = open_guest (\@ARGV, rw => $rw); } -# We've now got the list of @images, so feed them to libguestfs. -my $g = Sys::Guestfs->new (); -$g->add_drive_ro ($_) foreach @images; $g->launch (); $g->wait_ready (); @@ -948,7 +900,7 @@ if ($output eq "fish" || $output eq "ro-fish") { print "--ro "; } - print "-a $_ " foreach @images; + print "-a $_ " foreach @ARGV; my $mounts = $oses{$root_dev}->{mounts}; # Have to mount / first. Luckily '/' is early in the ASCII @@ -1405,6 +1357,7 @@ sub output_query_virtio_drivers L, L, L, +L, L, L. diff --git a/perl/Makefile.am b/perl/Makefile.am index 66d1d4b..55761b9 100644 --- a/perl/Makefile.am +++ b/perl/Makefile.am @@ -22,6 +22,7 @@ EXTRA_DIST = \ examples/LICENSE \ examples/*.pl \ lib/Sys/Guestfs.pm \ + lib/Sys/Guestfs/Lib.pm \ run-bindtests \ run-perl-tests \ bindtests.pl \ diff --git a/perl/README b/perl/README new file mode 100644 index 0000000..6d7d646 --- /dev/null +++ b/perl/README @@ -0,0 +1,20 @@ +Sys::Guestfs +------------ + +This directory contains the Perl bindings for the libguestfs API. + +The basic libguestfs bindings have the name 'Sys::Guestfs'. + +As with all other language bindings, these bindings are generated +automatically. See src/generator.ml. + +Sys::Guestfs::Lib +----------------- + +Because we use Perl for writing lots of additional tools around +libguestfs, the Perl bindings also contain an extra library of useful +functions, called 'Sys::Guestfs::Lib'. This extra library is entirely +optional, and only enhances the usefulness of the ordinary libguestfs +API. + +One of the features of this library is tighter libvirt integration. diff --git a/perl/lib/Sys/Guestfs/Lib.pm b/perl/lib/Sys/Guestfs/Lib.pm new file mode 100644 index 0000000..ae49740 --- /dev/null +++ b/perl/lib/Sys/Guestfs/Lib.pm @@ -0,0 +1,205 @@ +# Sys::Guestfs::Lib +# Copyright (C) 2009 Red Hat Inc. +# +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; either +# version 2 of the License, or (at your option) any later version. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +package Sys::Guestfs::Lib; + +use strict; +use warnings; + +use Sys::Guestfs; + +# Optional: +eval "use Sys::Virt;"; +eval "use XML::XPath;"; +eval "use XML::XPath::XMLParser;"; + +=pod + +=head1 NAME + +Sys::Guestfs::Lib - Useful functions for using libguestfs from Perl + +=head1 SYNOPSIS + + use Sys::Guestfs::Lib qw(#any symbols you want to use); + + $g = open_guest ($name); + +=head1 DESCRIPTION + +C is an extra library of useful functions for using +the libguestfs API from Perl. It also provides tighter integration +with libvirt. + +The basic libguestfs API is not covered by this manpage. Please refer +instead to L and L. The libvirt API is +also not covered. For that, see L. + +=head1 FUNCTIONS + +=cut + +require Exporter; + +use vars qw(@EXPORT_OK @ISA); + +@ISA = qw(Exporter); +@EXPORT_OK = qw(open_guest); + +=head2 open_guest + + $g = open_guest ($name); + + $g = open_guest ($name, rw => 1, ...); + + $g = open_guest ($name, address => $uri, ...); + + $g = open_guest ([$img1, $img2, ...], address => $uri, ...); + + ($g, $conn, $dom) = open_guest ($name); + +This function opens a libguestfs handle for either the libvirt domain +called C<$name>, or the disk image called C<$name>. Any disk images +found through libvirt or specified explicitly are attached to the +libguestfs handle. + +The C handle C<$g> is returned, or if there was an error +it throws an exception. To catch errors, wrap the call in an eval +block. + +The first parameter is either a string referring to a libvirt domain +or a disk image, or (if a guest has several disk images) an arrayref +C<[$img1, $img2, ...]>. + +The handle is I by default. Use the optional parameter +C 1> to open a read-write handle. However if you open a +read-write handle, this function will refuse to use active libvirt +domains. + +The handle is still in the config state when it is returned, so you +have to call C<$g-Elaunch ()> and C<$g-Ewait_ready>. + +The optional C
parameter can be added to specify the libvirt +URI. In addition, L lists other parameters which are +passed through to Cnew> unchanged. + +The implicit libvirt handle is closed after this function, I +you call the function in C context, in which case the +function returns a tuple of: the open libguestfs handle, the open +libvirt handle, and the open libvirt domain handle. (This is useful +if you want to do other things like pulling the XML description of the +guest). Note that if this is a straight disk image, then C<$conn> and +C<$dom> will be C. + +If the C module is not available, then libvirt is bypassed, +and this function can only open disk images. + +=cut + +sub open_guest +{ + my $first = shift; + my %params = @_; + + my $readwrite = $params{rw}; + + my @images = (); + if (ref ($first) eq "ARRAY") { + @images = @$first; + } elsif (ref ($first) eq "SCALAR") { + @images = ($first); + } else { + die "open_guest: first parameter must be a string or an arrayref" + } + + my ($conn, $dom); + + if (-e $images[0]) { + foreach (@images) { + die "guest image $_ does not exist or is not readable" + unless -r $_; + } + } else { + die "open_guest: no libvirt support (install Sys::Virt, XML::XPath and XML::XPath::XMLParser)" + unless exists $INC{"Sys/Virt.pm"} && + exists $INC{"XML/XPath.pm"} && + exists $INC{"XML/XPath/XMLParser.pm"}; + + die "open_guest: too many domains listed on command line" + if @images > 1; + + $conn = Sys::Virt->new (readonly => 1, @_); + die "open_guest: cannot connect to libvirt" unless $conn; + + my @doms = $conn->list_defined_domains (); + my $isitinactive = "an inactive libvirt domain"; + unless ($readwrite) { + # In the case where we want read-only access to a domain, + # allow the user to specify an active domain too. + push @doms, $conn->list_domains (); + $isitinactive = "a libvirt domain"; + } + foreach (@doms) { + if ($_->get_name () eq $images[0]) { + $dom = $_; + last; + } + } + die "$images[0] is not the name of $isitinactive\n" unless $dom; + + # Get the names of the image(s). + my $xml = $dom->get_xml_description (); + + my $p = XML::XPath->new (xml => $xml); + my @disks = $p->findnodes ('//devices/disk/source/@dev'); + @images = map { $_->getData } @disks; + } + + # We've now got the list of @images, so feed them to libguestfs. + my $g = Sys::Guestfs->new (); + foreach (@images) { + if ($readwrite) { + $g->add_drive ($_); + } else { + $g->add_drive_ro ($_); + } + } + + return wantarray ? ($g, $conn, $dom) : $g +} + +1; + +=head1 COPYRIGHT + +Copyright (C) 2009 Red Hat Inc. + +=head1 LICENSE + +Please see the file COPYING.LIB for the full license. + +=head1 SEE ALSO + +L, +L, +L, +L, +L, +L, +L. + +=cut diff --git a/src/generator.ml b/src/generator.ml index bc5b805..d94ec14 100755 --- a/src/generator.ml +++ b/src/generator.ml @@ -6120,6 +6120,10 @@ Libguestfs provides ways to enumerate guest storage (eg. partitions, LVs, what filesystem is in each LV, etc.). It can also run commands in the context of the guest. Also you can access filesystems over FTP. +See also L for a set of useful library +functions for using libguestfs from Perl, including integration +with libvirt. + =head1 ERRORS All errors turn into calls to C (see L). @@ -6191,7 +6195,10 @@ Please see the file COPYING.LIB for the full license. =head1 SEE ALSO -L, L. +L, +L, +L, +L. =cut " -- 1.8.3.1