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(feature_available);
  24
  25 use Pod::Usage;
  26 use Getopt::Long;
  27 use File::Basename qw(basename);
  28 use POSIX qw(ceil);
  29
  30 use Locale::TextDomain 'libguestfs';
  31
  32 =encoding utf8
  33
  34 =head1 NAME
  35
  36 virt-df - Display free space on virtual filesystems
  37
  38 =head1 SYNOPSIS
  39
  40  virt-df [--options]
  41
  42  virt-df [--options] domname
  43
  44  virt-df [--options] disk.img [disk.img ...]
  45
  46 =head1 DESCRIPTION
  47
  48 C<virt-df> is a command line tool to display free space on virtual
  49 machine filesystems.  Unlike other tools, it doesn't just display the
  50 amount of space allocated to a virtual machine, but can look inside
  51 the virtual machine to see how much space is really being used.
  52
  53 It is like the L<df(1)> command, but for virtual machines, except that
  54 it also works for Windows virtual machines.
  55
  56 If used without any arguments, C<virt-df> checks with libvirt to get a
  57 list of all active and inactive guests, and performs a C<df>-type
  58 operation on each one in turn, printing out the results.
  59
  60 If used with any argument(s), C<virt-df> performs a C<df>-type
  61 operation on either the single named libvirt domain, or on the disk
  62 image(s) listed on the command line (which must all belong to a single
  63 VM).  In this mode (with arguments), C<virt-df> will I<only work for a
  64 single guest>.  If you want to run on multiple guests, then you have
  65 to invoke C<virt-df> multiple times.
  66
  67 Use the C<--csv> option to get a format which can be easily parsed by
  68 other programs.  Other options are mostly similar to standard C<df>
  69 options.  See below for the complete list.
  70
  71 =head1 OPTIONS
  72
  73 =over 4
  74
  75 =cut
  76
  77 my $help;
  78
  79 =item B<--help>
  80
  81 Display brief help.
  82
  83 =cut
  84
  85 my $version;
  86
  87 =item B<--version>
  88
  89 Display version number and exit.
  90
  91 =cut
  92
  93 my $uri;
  94
  95 =item B<--connect URI> | B<-c URI>
  96
  97 If using libvirt, connect to the given I<URI>.  If omitted, then we
  98 connect to the default libvirt hypervisor.
  99
 100 If you specify guest block devices directly, then libvirt is not used
 101 at all.
 102
 103 =cut
 104
 105 my $csv;
 106
 107 =item B<--csv>
 108
 109 Write out the results in CSV format (comma-separated values).  This format
 110 can be imported easily into databases and spreadsheets, but
 111 read L</NOTE ABOUT CSV FORMAT> below.
 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 You are not allowed to use I<-h> and I<--csv> at the same time.
 122
 123 =cut
 124
 125 my $inodes;
 126
 127 =item B<--inodes> | B<-i>
 128
 129 Print inodes instead of blocks.
 130
 131 =back
 132
 133 =cut
 134
 135 GetOptions ("help|?" => \$help,
 136             "version" => \$version,
 137             "connect|c=s" => \$uri,
 138             "csv" => \$csv,
 139             "human-readable|human|h" => \$human,
 140             "inodes|i" => \$inodes,
 141     ) or pod2usage (2);
 142 pod2usage (1) if $help;
 143 if ($version) {
 144     my $g = Sys::Guestfs->new ();
 145     my %h = $g->version ();
 146     print "$h{major}.$h{minor}.$h{release}$h{extra}\n";
 147     exit
 148 }
 149
 150 # RHBZ#600977
 151 die __"virt-df: cannot use -h and --csv options together\n" if $human && $csv;
 152
 153 # Get the list of domains and block devices.
 154 #
 155 # We can't use Sys::Guestfs::Lib::open_guest here because we want to
 156 # create the libguestfs handle/appliance as few times as possible.
 157 #
 158 # If virt-df is called with no parameters, then run the libvirt
 159 # equivalent of "virsh list --all", get the XML for each domain, and
 160 # get the disk devices.
 161 #
 162 # If virt-df is called with parameters, assume it must either be a
 163 # single disk image filename, a list of disk image filenames, or a
 164 # single libvirt guest name.  Construct disk devices accordingly.
 165
 166 my @domains = ();
 167
 168 if (@ARGV == 0) {               # No params, use libvirt.
 169     my $conn;
 170
 171     if ($uri) {
 172         $conn = Sys::Virt->new (readonly => 1, address => $uri);
 173     } else {
 174         $conn = Sys::Virt->new (readonly => 1);
 175     }
 176
 177     my @doms = $conn->list_defined_domains ();
 178     push @doms, $conn->list_domains ();
 179
 180     # https://bugzilla.redhat.com/show_bug.cgi?id=538041
 181     @doms = grep { $_->get_id () != 0 } @doms;
 182
 183     exit 0 unless @doms;
 184
 185     foreach my $dom (@doms) {
 186         my @disks = get_disks_from_libvirt ($dom);
 187         push @domains, { dom => $dom,
 188                          name => $dom->get_name (),
 189                          disks => \@disks }
 190     }
 191 } elsif (@ARGV == 1) {          # One param, could be disk image or domname.
 192     if (-e $ARGV[0]) {
 193         push @domains, { name => basename ($ARGV[0]),
 194                          disks => [ $ARGV[0] ] }
 195     } else {
 196         my $conn;
 197
 198         if ($uri) {
 199             $conn = Sys::Virt->new (readonly => 1, address => $uri);
 200         } else {
 201             $conn = Sys::Virt->new (readonly => 1);
 202         }
 203
 204         my $dom = $conn->get_domain_by_name ($ARGV[0])
 205             or die __x("{name} is not the name of a libvirt domain\n",
 206                        name => $ARGV[0]);
 207         my @disks = get_disks_from_libvirt ($dom);
 208         push @domains, { dom => $dom,
 209                          name => $dom->get_name (),
 210                          disks => \@disks }
 211     }
 212 } else {                        # >= 2 params, all disk images.
 213     push @domains, { name => basename ($ARGV[0]),
 214                      disks => \@ARGV }
 215 }
 216
 217 sub get_disks_from_libvirt
 218 {
 219     my $dom = shift;
 220     my $xml = $dom->get_xml_description ();
 221
 222     my $p = XML::XPath->new (xml => $xml);
 223     my @disks = $p->findnodes ('//devices/disk/source/@dev');
 224     push (@disks, $p->findnodes ('//devices/disk/source/@file'));
 225
 226     # Code in Sys::Guestfs::Lib dies here if there are no disks at all.
 227
 228     return map { $_->getData } @disks;
 229 }
 230
 231 # Sort the domains by name for display.
 232 @domains = sort { $a->{name} cmp $b->{name} } @domains;
 233
 234 # Since we got this far, we're somewhat sure we're going to
 235 # get to print the result, so display the title.
 236 print_title ();
 237
 238 # To minimize the number of times we have to launch the appliance,
 239 # shuffle as many domains together as we can, but not exceeding 26
 240 # disks per request.  (26 = # of letters in the English alphabet, and
 241 # we are only confident that /dev/sd[a-z] will work because of various
 242 # limits).
 243 my $n = 0;
 244 my @request = ();
 245 while (@domains) {
 246     while (@domains) {
 247         my $c = @{$domains[0]->{disks}};
 248         last if $n + $c > 26;
 249         push @request, shift @domains;
 250     }
 251     multi_df (@request);
 252 }
 253
 254 sub multi_df
 255 {
 256     local $_;
 257     my $g = Sys::Guestfs->new ();
 258
 259     my ($d, $disk);
 260
 261     foreach $d (@_) {
 262         foreach $disk (@{$d->{disks}}) {
 263             $g->add_drive_ro ($disk);
 264         }
 265     }
 266
 267     $g->launch ();
 268     my $has_lvm2 = feature_available ($g, "lvm2");
 269
 270     my @devices = $g->list_devices ();
 271     my @partitions = $g->list_partitions ();
 272
 273     my $n = 0;
 274     foreach $d (@_) {
 275         my $name = $d->{name};
 276         my $nr_disks = @{$d->{disks}};
 277
 278         # Filter LVM to only the devices applying to the original domain.
 279         my @devs = @devices[$n .. $n+$nr_disks-1];
 280         $g->lvm_set_filter (\@devs) if $has_lvm2;
 281
 282         # Find which whole devices (RHBZ#590167), partitions and LVs
 283         # contain mountable filesystems.  Stat those which are
 284         # mountable, and ignore the others.
 285         foreach (@devs) {
 286             try_df ($name, $g, $_, canonical_dev ($_, $n));
 287         }
 288         foreach (filter_partitions (\@devs, @partitions)) {
 289             try_df ($name, $g, $_, canonical_dev ($_, $n));
 290         }
 291         if ($has_lvm2) {
 292             foreach ($g->lvs ()) {
 293                 try_df ($name, $g, $_);
 294             }
 295         }
 296
 297         $n += $nr_disks;
 298     }
 299 }
 300
 301 sub filter_partitions
 302 {
 303     my $devs = shift;
 304     my @devs = @$devs;
 305     my @r;
 306
 307     foreach my $p (@_) {
 308         foreach my $d (@devs) {
 309             if ($p =~ /^$d\d/) {
 310                 push @r, $p;
 311                 last;
 312             }
 313         }
 314     }
 315
 316     return @r;
 317 }
 318
 319 # Calculate the canonical name for a device.
 320 # eg: /dev/vdb1 when offset = 1
 321 #     => canonical name is /dev/sda1
 322 sub canonical_dev
 323 {
 324     local $_;
 325     my $dev = shift;
 326     my $offset = shift;
 327
 328     return $dev unless $dev =~ m{^/dev/.d([a-z])(\d*)$};
 329     my $disk = $1;
 330     my $partnum = $2;
 331
 332     $disk = chr (ord ($disk) - $offset);
 333
 334     return "/dev/sd$disk$partnum"
 335 }
 336
 337 sub try_df
 338 {
 339     local $_;
 340     my $domname = shift;
 341     my $g = shift;
 342     my $dev = shift;
 343     my $display = shift || $dev;
 344
 345     my %stat;
 346     eval {
 347         $g->mount_ro ($dev, "/");
 348         %stat = $g->statvfs ("/");
 349     };
 350     if (!$@) {
 351         print_stat ($domname, $display, \%stat);
 352     }
 353     $g->umount_all ();
 354 }
 355
 356 sub print_stat
 357 {
 358     my $domname = shift;
 359     my $dev = shift;
 360     my $stat = shift;
 361
 362     my @cols = ($domname, $dev);
 363
 364     if (!$inodes) {
 365         my $bsize = $stat->{bsize};     # block size
 366         my $blocks = $stat->{blocks};   # total number of blocks
 367         my $bfree = $stat->{bfree};     # blocks free (total)
 368         my $bavail = $stat->{bavail};   # blocks free (for non-root users)
 369
 370         my $factor = $bsize / 1024;
 371
 372         push @cols, $blocks*$factor;    # total 1K blocks
 373         push @cols, ($blocks-$bfree)*$factor; # total 1K blocks used
 374         push @cols, $bavail*$factor;    # total 1K blocks available
 375
 376         push @cols, 100.0 - 100.0 * $bfree / $blocks;
 377
 378         if ($human) {
 379             $cols[2] = human_size ($cols[2]);
 380             $cols[3] = human_size ($cols[3]);
 381             $cols[4] = human_size ($cols[4]);
 382         }
 383     } else {
 384         my $files = $stat->{files};     # total number of inodes
 385         my $ffree = $stat->{ffree};     # inodes free (total)
 386         my $favail = $stat->{favail};   # inodes free (for non-root users)
 387
 388         push @cols, $files;
 389         push @cols, $files-$ffree;
 390         push @cols, $ffree;
 391
 392         push @cols, 100.0 - 100.0 * $ffree / $files;
 393     }
 394
 395     print_cols (@cols);
 396 }
 397
 398 sub print_title
 399 {
 400     my @cols = (__"Virtual Machine", __"Filesystem");
 401     if (!$inodes) {
 402         if (!$human) {
 403             push @cols, __"1K-blocks";
 404         } else {
 405             push @cols, __"Size";
 406         }
 407         push @cols, __"Used";
 408         push @cols, __"Available";
 409         push @cols, __"Use%";
 410     } else {
 411         push @cols, __"Inodes";
 412         push @cols, __"IUsed";
 413         push @cols, __"IFree";
 414         push @cols, __"IUse%";
 415     }
 416
 417     if (!$csv) {
 418         # ignore $cols[0] in this mode
 419         printf "%-36s%10s %10s %10s %5s\n",
 420           $cols[1], $cols[2], $cols[3], $cols[4], $cols[5];
 421     } else {
 422         print (join (",", @cols), "\n");
 423     }
 424 }
 425
 426 sub print_cols
 427 {
 428     if (!$csv) {
 429         my $label = sprintf "%s:%s", $_[0], $_[1];
 430
 431         printf ("%-36s", $label);
 432         print "\n"," "x36 if length ($label) > 36;
 433
 434         # Use 'ceil' on the percentage in order to emulate
 435         # what df itself does.
 436         my $percent = sprintf "%3d%%", ceil($_[5]);
 437
 438         printf ("%10s %10s %10s %5s\n", $_[2], $_[3], $_[4], $percent);
 439     } else {
 440         printf ("\"%s\",\"%s\",%d,%d,%d,%.1f%%\n", @_);
 441     }
 442 }
 443
 444 # Convert a number of 1K blocks to a human-readable number.
 445 sub human_size
 446 {
 447     local $_ = shift;
 448
 449     if ($_ < 1024) {
 450         sprintf "%dK", $_;
 451     } elsif ($_ < 1024 * 1024) {
 452         sprintf "%.1fM", ($_ / 1024);
 453     } else {
 454         sprintf "%.1fG", ($_ / 1024 / 1024);
 455     }
 456 }
 457
 458 =head1 NOTE ABOUT CSV FORMAT
 459
 460 Comma-separated values (CSV) is a deceptive format.  It I<seems> like
 461 it should be easy to parse, but it is definitely not easy to parse.
 462
 463 Myth: Just split fields at commas.  Reality: This does I<not> work
 464 reliably.  This example has two columns:
 465
 466  "foo,bar",baz
 467
 468 Myth: Read the file one line at a time.  Reality: This does I<not>
 469 work reliably.  This example has one row:
 470
 471  "foo
 472  bar",baz
 473
 474 For shell scripts, use C<csvtool> (L<http://merjis.com/developers/csv>
 475 also packaged in major Linux distributions).
 476
 477 For other languages, use a CSV processing library (eg. C<Text::CSV>
 478 for Perl or Python's built-in csv library).
 479
 480 Most spreadsheets and databases can import CSV directly.
 481
 482 =head1 SEE ALSO
 483
 484 L<guestfs(3)>,
 485 L<guestfish(1)>,
 486 L<Sys::Guestfs(3)>,
 487 L<Sys::Guestfs::Lib(3)>,
 488 L<Sys::Virt(3)>,
 489 L<http://libguestfs.org/>.
 490
 491 =head1 AUTHOR
 492
 493 Richard W.M. Jones L<http://people.redhat.com/~rjones/>
 494
 495 =head1 COPYRIGHT
 496
 497 Copyright (C) 2009-2010 Red Hat Inc.
 498
 499 This program is free software; you can redistribute it and/or modify
 500 it under the terms of the GNU General Public License as published by
 501 the Free Software Foundation; either version 2 of the License, or
 502 (at your option) any later version.
 503
 504 This program is distributed in the hope that it will be useful,
 505 but WITHOUT ANY WARRANTY; without even the implied warranty of
 506 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 507 GNU General Public License for more details.
 508
 509 You should have received a copy of the GNU General Public License
 510 along with this program; if not, write to the Free Software
 511 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.