Add Sys::Guestfs::Lib - useful functions for using libguestfs from Perl.
[libguestfs.git] / perl / lib / Sys / Guestfs / Lib.pm
1 # Sys::Guestfs::Lib
2 # Copyright (C) 2009 Red Hat Inc.
3 #
4 # This library is free software; you can redistribute it and/or
5 # modify it under the terms of the GNU Lesser General Public
6 # License as published by the Free Software Foundation; either
7 # version 2 of the License, or (at your option) any later version.
8 #
9 # This library is distributed in the hope that it will be useful,
10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
12 # Lesser General Public License for more details.
13 #
14 # You should have received a copy of the GNU Lesser General Public
15 # License along with this library; if not, write to the Free Software
16 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
17
18 package Sys::Guestfs::Lib;
19
20 use strict;
21 use warnings;
22
23 use Sys::Guestfs;
24
25 # Optional:
26 eval "use Sys::Virt;";
27 eval "use XML::XPath;";
28 eval "use XML::XPath::XMLParser;";
29
30 =pod
31
32 =head1 NAME
33
34 Sys::Guestfs::Lib - Useful functions for using libguestfs from Perl
35
36 =head1 SYNOPSIS
37
38  use Sys::Guestfs::Lib qw(#any symbols you want to use);
39
40  $g = open_guest ($name);
41
42 =head1 DESCRIPTION
43
44 C<Sys::Guestfs::Lib> is an extra library of useful functions for using
45 the libguestfs API from Perl.  It also provides tighter integration
46 with libvirt.
47
48 The basic libguestfs API is not covered by this manpage.  Please refer
49 instead to L<Sys::Guestfs(3)> and L<guestfs(3)>.  The libvirt API is
50 also not covered.  For that, see L<Sys::Virt(3)>.
51
52 =head1 FUNCTIONS
53
54 =cut
55
56 require Exporter;
57
58 use vars qw(@EXPORT_OK @ISA);
59
60 @ISA = qw(Exporter);
61 @EXPORT_OK = qw(open_guest);
62
63 =head2 open_guest
64
65  $g = open_guest ($name);
66
67  $g = open_guest ($name, rw => 1, ...);
68
69  $g = open_guest ($name, address => $uri, ...);
70
71  $g = open_guest ([$img1, $img2, ...], address => $uri, ...);
72
73  ($g, $conn, $dom) = open_guest ($name);
74
75 This function opens a libguestfs handle for either the libvirt domain
76 called C<$name>, or the disk image called C<$name>.  Any disk images
77 found through libvirt or specified explicitly are attached to the
78 libguestfs handle.
79
80 The C<Sys::Guestfs> handle C<$g> is returned, or if there was an error
81 it throws an exception.  To catch errors, wrap the call in an eval
82 block.
83
84 The first parameter is either a string referring to a libvirt domain
85 or a disk image, or (if a guest has several disk images) an arrayref
86 C<[$img1, $img2, ...]>.
87
88 The handle is I<read-only> by default.  Use the optional parameter
89 C<rw =E<gt> 1> to open a read-write handle.  However if you open a
90 read-write handle, this function will refuse to use active libvirt
91 domains.
92
93 The handle is still in the config state when it is returned, so you
94 have to call C<$g-E<gt>launch ()> and C<$g-E<gt>wait_ready>.
95
96 The optional C<address> parameter can be added to specify the libvirt
97 URI.  In addition, L<Sys::Virt(3)> lists other parameters which are
98 passed through to C<Sys::Virt-E<gt>new> unchanged.
99
100 The implicit libvirt handle is closed after this function, I<unless>
101 you call the function in C<wantarray> context, in which case the
102 function returns a tuple of: the open libguestfs handle, the open
103 libvirt handle, and the open libvirt domain handle.  (This is useful
104 if you want to do other things like pulling the XML description of the
105 guest).  Note that if this is a straight disk image, then C<$conn> and
106 C<$dom> will be C<undef>.
107
108 If the C<Sys::Virt> module is not available, then libvirt is bypassed,
109 and this function can only open disk images.
110
111 =cut
112
113 sub open_guest
114 {
115     my $first = shift;
116     my %params = @_;
117
118     my $readwrite = $params{rw};
119
120     my @images = ();
121     if (ref ($first) eq "ARRAY") {
122         @images = @$first;
123     } elsif (ref ($first) eq "SCALAR") {
124         @images = ($first);
125     } else {
126         die "open_guest: first parameter must be a string or an arrayref"
127     }
128
129     my ($conn, $dom);
130
131     if (-e $images[0]) {
132         foreach (@images) {
133             die "guest image $_ does not exist or is not readable"
134                 unless -r $_;
135         }
136     } else {
137         die "open_guest: no libvirt support (install Sys::Virt, XML::XPath and XML::XPath::XMLParser)"
138             unless exists $INC{"Sys/Virt.pm"} &&
139             exists $INC{"XML/XPath.pm"} &&
140             exists $INC{"XML/XPath/XMLParser.pm"};
141
142         die "open_guest: too many domains listed on command line"
143             if @images > 1;
144
145         $conn = Sys::Virt->new (readonly => 1, @_);
146         die "open_guest: cannot connect to libvirt" unless $conn;
147
148         my @doms = $conn->list_defined_domains ();
149         my $isitinactive = "an inactive libvirt domain";
150         unless ($readwrite) {
151             # In the case where we want read-only access to a domain,
152             # allow the user to specify an active domain too.
153             push @doms, $conn->list_domains ();
154             $isitinactive = "a libvirt domain";
155         }
156         foreach (@doms) {
157             if ($_->get_name () eq $images[0]) {
158                 $dom = $_;
159                 last;
160             }
161         }
162         die "$images[0] is not the name of $isitinactive\n" unless $dom;
163
164         # Get the names of the image(s).
165         my $xml = $dom->get_xml_description ();
166
167         my $p = XML::XPath->new (xml => $xml);
168         my @disks = $p->findnodes ('//devices/disk/source/@dev');
169         @images = map { $_->getData } @disks;
170     }
171
172     # We've now got the list of @images, so feed them to libguestfs.
173     my $g = Sys::Guestfs->new ();
174     foreach (@images) {
175         if ($readwrite) {
176             $g->add_drive ($_);
177         } else {
178             $g->add_drive_ro ($_);
179         }
180     }
181
182     return wantarray ? ($g, $conn, $dom) : $g
183 }
184
185 1;
186
187 =head1 COPYRIGHT
188
189 Copyright (C) 2009 Red Hat Inc.
190
191 =head1 LICENSE
192
193 Please see the file COPYING.LIB for the full license.
194
195 =head1 SEE ALSO
196
197 L<virt-inspector(1)>,
198 L<Sys::Guestfs(3)>,
199 L<guestfs(3)>,
200 L<http://libguestfs.org/>,
201 L<Sys::Virt(3)>,
202 L<http://libvirt.org/>,
203 L<guestfish(1)>.
204
205 =cut