# 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 get_partitions); =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 } =head2 get_partitions @partitions = get_partitions ($g); This function takes an open libguestfs handle C<$g> and returns all partitions and logical volumes found on it. What is returned is everything that could contain a filesystem (or swap). Physical volumes are excluded from the list, and so are any devices which are partitioned (eg. C would not be returned if C exists). =cut sub get_partitions { my $g = shift; my @partitions = $g->list_partitions (); my @pvs = $g->pvs (); @partitions = grep { ! is_pv ($_, @pvs) } @partitions; my @lvs = $g->lvs (); return sort (@lvs, @partitions); } sub is_pv { local $_; my $t = shift; foreach (@_) { return 1 if $_ eq $t; } 0; } 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