New event API - Perl bindings (RHBZ#664558).
[libguestfs.git] / tools / virt-tar
1 #!/usr/bin/perl -w
2 # virt-tar
3 # Copyright (C) 2009-2010 Red Hat Inc.
4 #
5 # This program is free software; you can redistribute it and/or modify
6 # it under the terms of the GNU General Public License as published by
7 # the Free Software Foundation; either version 2 of the License, or
8 # (at your option) any later version.
9 #
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 # GNU General Public License for more details.
14 #
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
18
19 use warnings;
20 use strict;
21
22 use Sys::Guestfs;
23 use Sys::Guestfs::Lib qw(open_guest);
24 use Pod::Usage;
25 use Getopt::Long;
26 use File::Basename;
27 use Locale::TextDomain 'libguestfs';
28
29 =encoding utf8
30
31 =head1 NAME
32
33 virt-tar - Extract or upload files to a virtual machine
34
35 =head1 SYNOPSIS
36
37  virt-tar [--options] -x domname directory tarball
38
39  virt-tar [--options] -u domname tarball directory
40
41  virt-tar [--options] disk.img [disk.img ...] -x directory tarball
42
43  virt-tar [--options] disk.img [disk.img ...] -u tarball directory
44
45 =head1 NOTE
46
47 This tool is obsolete.  Use L<virt-copy-in(1)>, L<virt-copy-out(1)>,
48 L<virt-tar-in(1)>, L<virt-tar-out(1)> as replacements.
49
50 =head1 EXAMPLES
51
52 Download C</home> from the VM into a local tarball:
53
54  virt-tar -x domname /home home.tar
55
56  virt-tar -zx domname /home home.tar.gz
57
58 Upload a local tarball and unpack it inside C</tmp> in the VM:
59
60  virt-tar -u domname uploadstuff.tar /tmp
61
62  virt-tar -zu domname uploadstuff.tar.gz /tmp
63
64 =head1 WARNING
65
66 You must I<not> use C<virt-tar> with the C<-u> option (upload) on live
67 virtual machines.  If you do this, you risk disk corruption in the VM.
68 C<virt-tar> tries to stop you from doing this, but doesn't catch all
69 cases.
70
71 You can use C<-x> (extract) on live virtual machines, but you might
72 get inconsistent results or errors if there is filesystem activity
73 inside the VM.  If the live VM is synched and quiescent, then
74 C<virt-tar> will usually work, but the only way to guarantee
75 consistent results is if the virtual machine is shut down.
76
77 =head1 DESCRIPTION
78
79 C<virt-tar> is a general purpose archive tool for downloading and
80 uploading parts of a guest filesystem.  There are many possibilities:
81 making backups, uploading data files, snooping on guest activity,
82 fixing or customizing guests, etc.
83
84 If you want to just view a single file, use L<virt-cat(1)>.  If you
85 just want to edit a single file, use L<virt-edit(1)>.  For more
86 complex cases you should look at the L<guestfish(1)> tool.
87
88 There are two modes of operation: C<-x> (eXtract) downloads a
89 directory and its contents (recursively) from the virtual machine into
90 a local tarball.  C<-u> uploads from a local tarball, unpacking it
91 into a directory inside the virtual machine.  You cannot use these two
92 options together.
93
94 In addition, you may need to use the C<-z> (gZip) option to enable
95 compression.  When uploading, you have to specify C<-z> if the upload
96 file is compressed because virt-tar won't detect this on its own.
97
98 C<virt-tar> can only handle tar (optionally gzipped) format tarballs.
99 For example it cannot do PKZip files or bzip2 compression.  If you
100 want that then you'll have to rebuild the tarballs yourself.  (This is
101 a limitation of the L<libguestfs(3)> API).
102
103 =head1 OPTIONS
104
105 =over 4
106
107 =cut
108
109 my $help;
110
111 =item B<--help>
112
113 Display brief help.
114
115 =cut
116
117 my $version;
118
119 =item B<--version>
120
121 Display version number and exit.
122
123 =cut
124
125 my $uri;
126
127 =item B<--connect URI> | B<-c URI>
128
129 If using libvirt, connect to the given I<URI>.  If omitted, then we
130 connect to the default libvirt hypervisor.
131
132 If you specify guest block devices directly, then libvirt is not used
133 at all.
134
135 =cut
136
137 my $format;
138
139 =item B<--format> raw
140
141 Specify the format of disk images given on the command line.  If this
142 is omitted then the format is autodetected from the content of the
143 disk image.
144
145 If disk images are requested from libvirt, then this program asks
146 libvirt for this information.  In this case, the value of the format
147 parameter is ignored.
148
149 If working with untrusted raw-format guest disk images, you should
150 ensure the format is always specified.
151
152 =cut
153
154 my $mode;
155
156 =item B<-x> | B<--extract> | B<--download>
157
158 =item B<-u> | B<--upload>
159
160 Use C<-x> to extract (download) a directory from a virtual machine
161 to a local tarball.
162
163 Use C<-u> to upload and unpack from a local tarball into a virtual
164 machine.  Please read the L</WARNING> section above before using this
165 option.
166
167 You must specify exactly one of these options.
168
169 =cut
170
171 my $gzip;
172
173 =item B<-z> | B<--gzip>
174
175 Specify that the input or output tarball is gzip-compressed.
176
177 =back
178
179 =cut
180
181 sub set_mode_x
182 {
183     die __"virt-tar: extract/upload mode specified twice on the command line\n"
184         if $mode;
185     $mode = "x";
186 }
187
188 sub set_mode_u
189 {
190     die __"virt-tar: extract/upload mode specified twice on the command line\n"
191         if $mode;
192     $mode = "u";
193 }
194
195 Getopt::Long::Configure ("bundling");
196 GetOptions ("help|?" => \$help,
197             "version" => \$version,
198             "connect|c=s" => \$uri,
199             "format=s" => \$format,
200             "extract|download|x" => \&set_mode_x,
201             "upload|u" => \&set_mode_u,
202             "gzip|z" => \$gzip,
203     ) or pod2usage (2);
204 pod2usage (1) if $help;
205 if ($version) {
206     my $g = Sys::Guestfs->new ();
207     my %h = $g->version ();
208     print "$h{major}.$h{minor}.$h{release}$h{extra}\n";
209     exit
210 }
211
212 pod2usage (__"virt-tar: no image, VM names, directory or filename given")
213     if @ARGV <= 2;
214
215 die __"virt-tar: either -x or -u must be specified on the command line\n"
216     unless $mode;
217
218 # Note: 'pop' reads arguments right to left.
219 my ($tarball, $directory);
220 if ($mode eq "x") {
221     $tarball = pop @ARGV;
222     $directory = pop @ARGV;
223 } else { # $mode eq "u"
224     $directory = pop @ARGV;
225     $tarball = pop @ARGV;
226     die __x("virt-tar: {tarball}: file not found\n",
227             tarball => $tarball) unless -f $tarball;
228 }
229 die __x("virt-tar: {dir}: directory name must start with '/' character\n",
230         dir => $directory)
231     unless substr ($directory, 0, 1) eq "/";
232
233 my @args = (\@ARGV);
234 push @args, address => $uri if $uri;
235 push @args, rw => 1 if $mode eq "u";
236 push @args, format => $format if defined $format;
237
238 my $g = open_guest (@args);
239 $g->launch ();
240
241 my @roots = $g->inspect_os ();
242 if (@roots == 0) {
243     die __x("{prog}: No operating system could be detected inside this disk image.\n\nThis may be because the file is not a disk image, or is not a virtual machine\nimage, or because the OS type is not understood by libguestfs.\n\nIf you feel this is an error, please file a bug report including as much\ninformation about the disk image as possible.\n",
244             prog => basename ($0));
245 }
246 if (@roots > 1) {
247     die __x("{prog}: multiboot operating systems are not supported.\n",
248             prog => basename ($0))
249 }
250 my %fses = $g->inspect_get_mountpoints ($roots[0]);
251 my @fses = sort { length $a <=> length $b } keys %fses;
252 my $mountopts = $mode eq "u" ? "" : "ro";
253 foreach (@fses) {
254     $g->mount_options ($mountopts, $fses{$_}, $_);
255 }
256
257 # Do the tar command.
258 if ($mode eq "x") {
259     if ($gzip) {
260         $g->tgz_out ($directory, $tarball);
261     } else {
262         $g->tar_out ($directory, $tarball);
263     }
264 } else { # mode eq "u"
265     if ($gzip) {
266         $g->tgz_in ($tarball, $directory);
267     } else {
268         $g->tar_in ($tarball, $directory);
269     }
270 }
271
272 $g->sync ();
273 $g->umount_all ();
274
275 undef $g;
276
277 exit 0;
278
279 =head1 SHELL QUOTING
280
281 Libvirt guest names can contain arbitrary characters, some of which
282 have meaning to the shell such as C<#> and space.  You may need to
283 quote or escape these characters on the command line.  See the shell
284 manual page L<sh(1)> for details.
285
286 =head1 SEE ALSO
287
288 L<guestfs(3)>,
289 L<guestfish(1)>,
290 L<virt-cat(1)>,
291 L<virt-edit(1)>,
292 L<virt-copy-in(1)>,
293 L<virt-copy-out(1)>,
294 L<virt-tar-in(1)>,
295 L<virt-tar-out(1)>,
296 L<Sys::Guestfs(3)>,
297 L<Sys::Guestfs::Lib(3)>,
298 L<Sys::Virt(3)>,
299 L<http://libguestfs.org/>.
300
301 =head1 AUTHOR
302
303 Richard W.M. Jones L<http://people.redhat.com/~rjones/>
304
305 =head1 COPYRIGHT
306
307 Copyright (C) 2009 Red Hat Inc.
308
309 This program is free software; you can redistribute it and/or modify
310 it under the terms of the GNU General Public License as published by
311 the Free Software Foundation; either version 2 of the License, or
312 (at your option) any later version.
313
314 This program is distributed in the hope that it will be useful,
315 but WITHOUT ANY WARRANTY; without even the implied warranty of
316 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
317 GNU General Public License for more details.
318
319 You should have received a copy of the GNU General Public License
320 along with this program; if not, write to the Free Software
321 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.