Lib.pm: Skip tests if perl-libintl module is not available.
[libguestfs.git] / df / virt-df.pl
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).
111 This format can be imported easily into databases and spreadsheets.
112
113 =cut
114
115 my $human;
116
117 =item B<--human-readable> | B<-h>
118
119 Print sizes in human-readable format.
120
121 =cut
122
123 my $inodes;
124
125 =item B<--inodes> | B<-i>
126
127 Print inodes instead of blocks.
128
129 =back
130
131 =cut
132
133 GetOptions ("help|?" => \$help,
134             "version" => \$version,
135             "connect|c=s" => \$uri,
136             "csv" => \$csv,
137             "human-readable|human|h" => \$human,
138             "inodes|i" => \$inodes,
139     ) or pod2usage (2);
140 pod2usage (1) if $help;
141 if ($version) {
142     my $g = Sys::Guestfs->new ();
143     my %h = $g->version ();
144     print "$h{major}.$h{minor}.$h{release}$h{extra}\n";
145     exit
146 }
147
148 # Open the guest handle.
149
150 if (@ARGV == 0) {
151     my $conn;
152
153     if ($uri) {
154         $conn = Sys::Virt->new (readonly => 1, address => $uri);
155     } else {
156         $conn = Sys::Virt->new (readonly => 1);
157     }
158
159     my @doms = $conn->list_defined_domains ();
160     push @doms, $conn->list_domains ();
161
162     my @domnames = map { $_->get_name () } @doms;
163
164     if (@domnames) {
165         print_title ();
166         foreach (@domnames) {
167             do_df ($_);
168         }
169     }
170 } else {
171     print_title ();
172     do_df (@ARGV);
173 }
174
175 sub do_df
176 {
177     my $g;
178
179     if ($uri) {
180         $g = open_guest (\@_, address => $uri);
181     } else {
182         $g = open_guest (\@_);
183     }
184
185     $g->launch ();
186     $g->wait_ready ();
187
188     my @partitions = get_partitions ($g);
189
190     # Think of a printable name for this domain.  Just choose the
191     # first parameter passed to this function, which will work for
192     # most cases (it'll either be the domain name or the first disk
193     # image name).
194     my $domname = $_[0];
195
196     # Mount each partition in turn, and if mountable, do a statvfs on it.
197     foreach my $partition (@partitions) {
198         my %stat;
199         eval {
200             $g->mount_ro ($partition, "/");
201             %stat = $g->statvfs ("/");
202         };
203         if (!$@) {
204             print_stat ($domname, $partition, \%stat);
205         }
206         $g->umount_all ();
207     }
208 }
209
210 sub print_stat
211 {
212     my $domname = shift;
213     my $partition = shift;
214     my $stat = shift;
215
216     my @cols = ($domname, $partition);
217
218     if (!$inodes) {
219         my $bsize = $stat->{bsize};     # block size
220         my $blocks = $stat->{blocks};   # total number of blocks
221         my $bfree = $stat->{bfree};     # blocks free (total)
222         my $bavail = $stat->{bavail};   # blocks free (for non-root users)
223
224         my $factor = $bsize / 1024;
225
226         push @cols, $blocks*$factor;    # total 1K blocks
227         push @cols, ($blocks-$bfree)*$factor; # total 1K blocks used
228         push @cols, $bavail*$factor;    # total 1K blocks available
229
230         # XXX %used column comes out different from the native 'df'
231         # program.  Need to check how 'df' calculates this.
232         push @cols, 100.0 - 100.0 * $bavail / $blocks;
233
234         if ($human) {
235             $cols[2] = human_size ($cols[2]);
236             $cols[3] = human_size ($cols[3]);
237             $cols[4] = human_size ($cols[4]);
238         }
239     } else {
240         my $files = $stat->{files};     # total number of inodes
241         my $ffree = $stat->{ffree};     # inodes free (total)
242         my $favail = $stat->{favail};   # inodes free (for non-root users)
243
244         push @cols, $files;
245         push @cols, $files-$ffree;
246         push @cols, $ffree;
247
248         # XXX %used column comes out different from the native 'df'
249         # program.  Need to check how 'df' calculates this.
250         push @cols, 100.0 - 100.0 * $favail / $files;
251     }
252
253     print_cols (@cols);
254 }
255
256 sub print_title
257 {
258     my @cols = (__"Virtual Machine", __"Filesystem");
259     if (!$inodes) {
260         if (!$human) {
261             push @cols, __"1K-blocks";
262         } else {
263             push @cols, __"Size";
264         }
265         push @cols, __"Used";
266         push @cols, __"Available";
267         push @cols, __"Use%";
268     } else {
269         push @cols, __"Inodes";
270         push @cols, __"IUsed";
271         push @cols, __"IFree";
272         push @cols, __"IUse%";
273     }
274
275     if (!$csv) {
276         # ignore $cols[0] in this mode
277         printf "%-36s%10s %10s %10s %5s\n",
278           $cols[1], $cols[2], $cols[3], $cols[4], $cols[5];
279     } else {
280         print (join (",", @cols), "\n");
281     }
282 }
283
284 sub print_cols
285 {
286     if (!$csv) {
287         my $label = sprintf "%s:%s", $_[0], $_[1];
288
289         printf ("%-36s", $label);
290         print "\n"," "x32 if length ($label) > 36;
291
292         my $percent = sprintf "%3.1f%%", $_[5];
293         printf ("%10s %10s %10s %5s\n", $_[2], $_[3], $_[4], $percent);
294     } else {
295         printf ("\"%s\",\"%s\",%d,%d,%d,%.1f%%\n", @_);
296     }
297 }
298
299 # Convert a number of 1K blocks to a human-readable number.
300 sub human_size
301 {
302     local $_ = shift;
303
304     if ($_ < 1024) {
305         sprintf "%dK", $_;
306     } elsif ($_ < 1024 * 1024) {
307         sprintf "%.1fM", ($_ / 1024);
308     } else {
309         sprintf "%.1fG", ($_ / 1024 / 1024);
310     }
311 }
312
313 =head1 SEE ALSO
314
315 L<guestfs(3)>,
316 L<guestfish(1)>,
317 L<Sys::Guestfs(3)>,
318 L<Sys::Guestfs::Lib(3)>,
319 L<Sys::Virt(3)>,
320 L<http://libguestfs.org/>.
321
322 =head1 AUTHOR
323
324 Richard W.M. Jones L<http://et.redhat.com/~rjones/>
325
326 =head1 COPYRIGHT
327
328 Copyright (C) 2009 Red Hat Inc.
329
330 This program is free software; you can redistribute it and/or modify
331 it under the terms of the GNU General Public License as published by
332 the Free Software Foundation; either version 2 of the License, or
333 (at your option) any later version.
334
335 This program is distributed in the hope that it will be useful,
336 but WITHOUT ANY WARRANTY; without even the implied warranty of
337 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
338 GNU General Public License for more details.
339
340 You should have received a copy of the GNU General Public License
341 along with this program; if not, write to the Free Software
342 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.