hivex: Add 'hivexsh' program (shell for navigating registry hives).
[libguestfs.git] / tools / virt-df
1 #!/usr/bin/perl -w
2 # virt-df
3 # Copyright (C) 2009 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 get_partitions resolve_windows_path
24   inspect_all_partitions inspect_partition
25   inspect_operating_systems mount_operating_system inspect_in_detail);
26 use Pod::Usage;
27 use Getopt::Long;
28 use Data::Dumper;
29 use File::Temp qw/tempdir/;
30 use XML::Writer;
31 use Locale::TextDomain 'libguestfs';
32
33 =encoding utf8
34
35 =head1 NAME
36
37 virt-df - Display free space on virtual filesystems
38
39 =head1 SYNOPSIS
40
41  virt-df [--options]
42
43  virt-df [--options] domname
44
45  virt-df [--options] disk.img [disk.img ...]
46
47 =head1 DESCRIPTION
48
49 C<virt-df> is a command line tool to display free space on virtual
50 machine filesystems.  Unlike other tools, it doesn't just display the
51 amount of space allocated to a virtual machine, but can look inside
52 the virtual machine to see how much space is really being used.
53
54 It is like the L<df(1)> command, but for virtual machines, except that
55 it also works for Windows virtual machines.
56
57 If used without any arguments, C<virt-df> checks with libvirt to get a
58 list of all active and inactive guests, and performs a C<df>-type
59 operation on each one in turn, printing out the results.
60
61 If used with any argument(s), C<virt-df> performs a C<df>-type
62 operation on either the single named libvirt domain, or on the disk
63 image(s) listed on the command line (which must all belong to a single
64 VM).  In this mode (with arguments), C<virt-df> will I<only work for a
65 single guest>.  If you want to run on multiple guests, then you have
66 to invoke C<virt-df> multiple times.
67
68 Use the C<--csv> option to get a format which can be easily parsed by
69 other programs.  Other options are mostly similar to standard C<df>
70 options.  See below for the complete list.
71
72 =head1 OPTIONS
73
74 =over 4
75
76 =cut
77
78 my $help;
79
80 =item B<--help>
81
82 Display brief help.
83
84 =cut
85
86 my $version;
87
88 =item B<--version>
89
90 Display version number and exit.
91
92 =cut
93
94 my $uri;
95
96 =item B<--connect URI> | B<-c URI>
97
98 If using libvirt, connect to the given I<URI>.  If omitted, then we
99 connect to the default libvirt hypervisor.
100
101 If you specify guest block devices directly, then libvirt is not used
102 at all.
103
104 =cut
105
106 my $csv;
107
108 =item B<--csv>
109
110 Write out the results in CSV format (comma-separated values).  This
111 format can be imported easily into databases and spreadsheets, but
112 read L</NOTE ABOUT CSV FORMAT> below.
113
114 =cut
115
116 my $human;
117
118 =item B<--human-readable> | B<-h>
119
120 Print sizes in human-readable format.
121
122 =cut
123
124 my $inodes;
125
126 =item B<--inodes> | B<-i>
127
128 Print inodes instead of blocks.
129
130 =back
131
132 =cut
133
134 GetOptions ("help|?" => \$help,
135             "version" => \$version,
136             "connect|c=s" => \$uri,
137             "csv" => \$csv,
138             "human-readable|human|h" => \$human,
139             "inodes|i" => \$inodes,
140     ) or pod2usage (2);
141 pod2usage (1) if $help;
142 if ($version) {
143     my $g = Sys::Guestfs->new ();
144     my %h = $g->version ();
145     print "$h{major}.$h{minor}.$h{release}$h{extra}\n";
146     exit
147 }
148
149 # Open the guest handle.
150
151 if (@ARGV == 0) {
152     my $conn;
153
154     if ($uri) {
155         $conn = Sys::Virt->new (readonly => 1, address => $uri);
156     } else {
157         $conn = Sys::Virt->new (readonly => 1);
158     }
159
160     my @doms = $conn->list_defined_domains ();
161     push @doms, $conn->list_domains ();
162
163     # https://bugzilla.redhat.com/show_bug.cgi?id=538041
164     @doms = grep { $_->get_id () != 0 } @doms;
165
166     my @domnames = map { $_->get_name () } @doms;
167
168     if (@domnames) {
169         print_title ();
170         foreach (@domnames) {
171             eval { do_df ($_); };
172             warn $@ if $@;
173         }
174     }
175 } else {
176     print_title ();
177     do_df (@ARGV);
178 }
179
180 sub do_df
181 {
182     my $g;
183
184     if ($uri) {
185         $g = open_guest (\@_, address => $uri);
186     } else {
187         $g = open_guest (\@_);
188     }
189
190     $g->launch ();
191
192     my @partitions = get_partitions ($g);
193
194     # Think of a printable name for this domain.  Just choose the
195     # first parameter passed to this function, which will work for
196     # most cases (it'll either be the domain name or the first disk
197     # image name).
198     my $domname = $_[0];
199
200     # Mount each partition in turn, and if mountable, do a statvfs on it.
201     foreach my $partition (@partitions) {
202         my %stat;
203         eval {
204             $g->mount_ro ($partition, "/");
205             %stat = $g->statvfs ("/");
206         };
207         if (!$@) {
208             print_stat ($domname, $partition, \%stat);
209         }
210         $g->umount_all ();
211     }
212 }
213
214 sub print_stat
215 {
216     my $domname = shift;
217     my $partition = shift;
218     my $stat = shift;
219
220     my @cols = ($domname, $partition);
221
222     if (!$inodes) {
223         my $bsize = $stat->{bsize};     # block size
224         my $blocks = $stat->{blocks};   # total number of blocks
225         my $bfree = $stat->{bfree};     # blocks free (total)
226         my $bavail = $stat->{bavail};   # blocks free (for non-root users)
227
228         my $factor = $bsize / 1024;
229
230         push @cols, $blocks*$factor;    # total 1K blocks
231         push @cols, ($blocks-$bfree)*$factor; # total 1K blocks used
232         push @cols, $bavail*$factor;    # total 1K blocks available
233
234         # XXX %used column comes out different from the native 'df'
235         # program.  Need to check how 'df' calculates this.
236         push @cols, 100.0 - 100.0 * $bavail / $blocks;
237
238         if ($human) {
239             $cols[2] = human_size ($cols[2]);
240             $cols[3] = human_size ($cols[3]);
241             $cols[4] = human_size ($cols[4]);
242         }
243     } else {
244         my $files = $stat->{files};     # total number of inodes
245         my $ffree = $stat->{ffree};     # inodes free (total)
246         my $favail = $stat->{favail};   # inodes free (for non-root users)
247
248         push @cols, $files;
249         push @cols, $files-$ffree;
250         push @cols, $ffree;
251
252         # XXX %used column comes out different from the native 'df'
253         # program.  Need to check how 'df' calculates this.
254         push @cols, 100.0 - 100.0 * $favail / $files;
255     }
256
257     print_cols (@cols);
258 }
259
260 sub print_title
261 {
262     my @cols = (__"Virtual Machine", __"Filesystem");
263     if (!$inodes) {
264         if (!$human) {
265             push @cols, __"1K-blocks";
266         } else {
267             push @cols, __"Size";
268         }
269         push @cols, __"Used";
270         push @cols, __"Available";
271         push @cols, __"Use%";
272     } else {
273         push @cols, __"Inodes";
274         push @cols, __"IUsed";
275         push @cols, __"IFree";
276         push @cols, __"IUse%";
277     }
278
279     if (!$csv) {
280         # ignore $cols[0] in this mode
281         printf "%-36s%10s %10s %10s %5s\n",
282           $cols[1], $cols[2], $cols[3], $cols[4], $cols[5];
283     } else {
284         print (join (",", @cols), "\n");
285     }
286 }
287
288 sub print_cols
289 {
290     if (!$csv) {
291         my $label = sprintf "%s:%s", $_[0], $_[1];
292
293         printf ("%-36s", $label);
294         print "\n"," "x36 if length ($label) > 36;
295
296         my $percent = sprintf "%3.1f%%", $_[5];
297         printf ("%10s %10s %10s %5s\n", $_[2], $_[3], $_[4], $percent);
298     } else {
299         printf ("\"%s\",\"%s\",%d,%d,%d,%.1f%%\n", @_);
300     }
301 }
302
303 # Convert a number of 1K blocks to a human-readable number.
304 sub human_size
305 {
306     local $_ = shift;
307
308     if ($_ < 1024) {
309         sprintf "%dK", $_;
310     } elsif ($_ < 1024 * 1024) {
311         sprintf "%.1fM", ($_ / 1024);
312     } else {
313         sprintf "%.1fG", ($_ / 1024 / 1024);
314     }
315 }
316
317 =head1 NOTE ABOUT CSV FORMAT
318
319 Comma-separated values (CSV) is a deceptive format.  It I<seems> like
320 it should be easy to parse, but it is definitely not easy to parse.
321
322 Myth: Just split fields at commas.  Reality: This does I<not> work
323 reliably.  This example has two columns:
324
325  "foo,bar",baz
326
327 Myth: Read the file one line at a time.  Reality: This does I<not>
328 work reliably.  This example has one row:
329
330  "foo
331  bar",baz
332
333 For shell scripts, use C<csvtool> (L<http://merjis.com/developers/csv>
334 also packaged in major Linux distributions).
335
336 For other languages, use a CSV processing library (eg. C<Text::CSV>
337 for Perl or Python's built-in csv library).
338
339 Most spreadsheets and databases can import CSV directly.
340
341 =head1 SEE ALSO
342
343 L<guestfs(3)>,
344 L<guestfish(1)>,
345 L<Sys::Guestfs(3)>,
346 L<Sys::Guestfs::Lib(3)>,
347 L<Sys::Virt(3)>,
348 L<http://libguestfs.org/>.
349
350 =head1 AUTHOR
351
352 Richard W.M. Jones L<http://et.redhat.com/~rjones/>
353
354 =head1 COPYRIGHT
355
356 Copyright (C) 2009 Red Hat Inc.
357
358 This program is free software; you can redistribute it and/or modify
359 it under the terms of the GNU General Public License as published by
360 the Free Software Foundation; either version 2 of the License, or
361 (at your option) any later version.
362
363 This program is distributed in the hope that it will be useful,
364 but WITHOUT ANY WARRANTY; without even the implied warranty of
365 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
366 GNU General Public License for more details.
367
368 You should have received a copy of the GNU General Public License
369 along with this program; if not, write to the Free Software
370 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.