tools/virt-df

   1 #!/usr/bin/perl -w
   2 # virt-df
   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(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 $format;
 116
 117 =item B<--format> raw
 118
 119 Specify the format of disk images given on the command line.  If this
 120 is omitted then the format is autodetected from the content of the
 121 disk image.
 122
 123 If disk images are requested from libvirt, then this program asks
 124 libvirt for this information.  In this case, the value of the format
 125 parameter is ignored.
 126
 127 If working with untrusted raw-format guest disk images, you should
 128 ensure the format is always specified.
 129
 130 =cut
 131
 132 my $human;
 133
 134 =item B<--human-readable> | B<-h>
 135
 136 Print sizes in human-readable format.
 137
 138 You are not allowed to use I<-h> and I<--csv> at the same time.
 139
 140 =cut
 141
 142 my $inodes;
 143
 144 =item B<--inodes> | B<-i>
 145
 146 Print inodes instead of blocks.
 147
 148 =cut
 149
 150 my $one_per_guest;
 151
 152 =item B<--one-per-guest>
 153
 154 Run one libguestfs appliance per guest.  Normally C<virt-df> will
 155 add the disks from several guests to a single libguestfs appliance.
 156
 157 You might use this option in the following circumstances:
 158
 159 =over 4
 160
 161 =item *
 162
 163 If you think an untrusted guest might actively try to exploit the
 164 libguestfs appliance kernel, then this prevents one guest from
 165 interfering with the stats printed for another guest.
 166
 167 =item *
 168
 169 If the kernel has a bug which stops it from accessing a
 170 filesystem in one guest (see for example RHBZ#635373) then
 171 this allows libguestfs to continue and report stats for further
 172 guests.
 173
 174 =back
 175
 176 =cut
 177
 178 my $uuid;
 179
 180 =item B<--uuid>
 181
 182 Print UUIDs instead of names.  This is useful for following
 183 a guest even when the guest is migrated or renamed, or when
 184 two guests happen to have the same name.
 185
 186 Note that only domains that we fetch from libvirt come with UUIDs.
 187 For disk images, we still print the disk image name even when
 188 this option is specified.
 189
 190 =back
 191
 192 =cut
 193
 194 GetOptions ("help|?" => \$help,
 195             "version" => \$version,
 196             "connect|c=s" => \$uri,
 197             "csv" => \$csv,
 198             "format=s" => \$format,
 199             "human-readable|human|h" => \$human,
 200             "inodes|i" => \$inodes,
 201             "one-per-guest" => \$one_per_guest,
 202             "uuid" => \$uuid,
 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 # RHBZ#600977
 213 die __"virt-df: cannot use -h and --csv options together\n" if $human && $csv;
 214
 215 # RHBZ#635373
 216 #
 217 # Limit the number of devices we will ever add to the appliance.  The
 218 # overall limit in current libguestfs is 25: 26 = number of letters in
 219 # the English alphabet since we are only confident that /dev/sd[a-z]
 220 # will work because of various limits, minus 1 because that may be
 221 # used by the ext2 initial filesystem.
 222 my $max_disks = 25;
 223
 224 # Get the list of domains and block devices.
 225 #
 226 # We can't use Sys::Guestfs::Lib::open_guest here because we want to
 227 # create the libguestfs handle/appliance as few times as possible.
 228 #
 229 # If virt-df is called with no parameters, then run the libvirt
 230 # equivalent of "virsh list --all", get the XML for each domain, and
 231 # get the disk devices.
 232 #
 233 # If virt-df is called with parameters, assume it must either be a
 234 # single disk image filename, a list of disk image filenames, or a
 235 # single libvirt guest name.  Construct disk devices accordingly.
 236
 237 my @domains = ();
 238
 239 if (@ARGV == 0) {               # No params, use libvirt.
 240     my $conn;
 241
 242     if ($uri) {
 243         $conn = Sys::Virt->new (readonly => 1, address => $uri);
 244     } else {
 245         $conn = Sys::Virt->new (readonly => 1);
 246     }
 247
 248     my @doms = $conn->list_defined_domains ();
 249     push @doms, $conn->list_domains ();
 250
 251     # https://bugzilla.redhat.com/show_bug.cgi?id=538041
 252     @doms = grep { $_->get_id () != 0 } @doms;
 253
 254     exit 0 unless @doms;
 255
 256     foreach my $dom (@doms) {
 257         my @disks = get_disks_from_libvirt ($dom);
 258         push @domains, { dom => $dom,
 259                          name => $dom->get_name (),
 260                          uuid => $dom->get_uuid_string (),
 261                          disks => \@disks }
 262     }
 263 } elsif (@ARGV == 1) {          # One param, could be disk image or domname.
 264     if (-e $ARGV[0]) {
 265         push @domains, { name => basename ($ARGV[0]),
 266                          disks => [ [ $ARGV[0], $format ] ] }
 267     } else {
 268         my $conn;
 269
 270         if ($uri) {
 271             $conn = Sys::Virt->new (readonly => 1, address => $uri);
 272         } else {
 273             $conn = Sys::Virt->new (readonly => 1);
 274         }
 275
 276         my $dom = $conn->get_domain_by_name ($ARGV[0])
 277             or die __x("{name} is not the name of a libvirt domain\n",
 278                        name => $ARGV[0]);
 279         my @disks = get_disks_from_libvirt ($dom);
 280         push @domains, { dom => $dom,
 281                          name => $dom->get_name (),
 282                          uuid => $dom->get_uuid_string (),
 283                          disks => \@disks }
 284     }
 285 } else {                        # >= 2 params, all disk images.
 286     my @disks = map { [ $_, $format ] } @ARGV;
 287     push @domains, { name => basename ($ARGV[0]),
 288                      disks => \@disks }
 289 }
 290
 291 sub get_disks_from_libvirt
 292 {
 293     my $dom = shift;
 294     my $xml = $dom->get_xml_description ();
 295
 296     my $p = XML::XPath->new (xml => $xml);
 297     my $nodes = $p->find ('//devices/disk');
 298
 299     my @disks;
 300     my $node;
 301     foreach $node ($nodes->get_nodelist) {
 302         # The filename can be in dev or file attribute, hence:
 303         my $filename = $p->find ('./source/@dev', $node);
 304         unless ($filename) {
 305             $filename = $p->find ('./source/@file', $node);
 306             next unless $filename;
 307         }
 308         $filename = $filename->to_literal;
 309
 310         # Get the disk format (may not be set).
 311         my $format = $p->find ('./driver/@type', $node);
 312         $format = $format->to_literal if $format;
 313
 314         push @disks, [ $filename, $format ];
 315     }
 316
 317     # Code in Sys::Guestfs::Lib dies here if there are no disks at all.
 318
 319     return @disks;
 320 }
 321
 322 # Sort the domains by name for display.
 323 @domains = sort { $a->{name} cmp $b->{name} } @domains;
 324
 325 # Since we got this far, we're somewhat sure we're going to
 326 # get to print the result, so display the title.
 327 print_title ();
 328
 329 # To minimize the number of times we have to launch the appliance,
 330 # shuffle as many domains together as we can, but not exceeding
 331 # MAX_DISKS per request.  If --one-per-guest was requested then only
 332 # request disks from a single guest each time.
 333 if ($one_per_guest) {
 334     foreach (@domains) {
 335         my @request = ( $_ );
 336         multi_df (@request);
 337     }
 338 } else {
 339     while (@domains) {
 340         my $n = 0; # number of disks added so far
 341         my @request = ();
 342         while (@domains) {
 343             my $c = @{$domains[0]->{disks}};
 344             if ($c > $max_disks) {
 345                 warn __x("virt-df: ignoring {name}, it has too many disks ({c} > {max})",
 346                          name => $domains[0]->{name},
 347                          c => $c, max => $max_disks);
 348                 next;
 349             }
 350             last if $n + $c > $max_disks;
 351             $n += $c;
 352             push @request, shift (@domains);
 353         }
 354         multi_df (@request);
 355     }
 356 }
 357
 358 sub multi_df
 359 {
 360     local $_;
 361     eval {
 362         my $g = Sys::Guestfs->new ();
 363
 364         my ($d, $disk);
 365
 366         foreach $d (@_) {
 367             foreach $disk (@{$d->{disks}}) {
 368                 my $filename = $disk->[0];
 369                 my $format = $disk->[1];
 370                 my @args = ($filename);
 371                 push @args, readonly => 1;
 372                 push @args, format => $format if defined $format;
 373                 $g->add_drive_opts (@args);
 374             }
 375         }
 376
 377         $g->launch ();
 378         my $has_lvm2 = feature_available ($g, "lvm2");
 379
 380         my @devices = $g->list_devices ();
 381         my @partitions = $g->list_partitions ();
 382
 383         my $n = 0;
 384         foreach $d (@_) {
 385             my $name = $d->{name};
 386             my $uuid = $d->{uuid};
 387             my $nr_disks = @{$d->{disks}};
 388
 389             # Filter LVM to only the devices applying to the original domain.
 390             my @devs = @devices[$n .. $n+$nr_disks-1];
 391             $g->lvm_set_filter (\@devs) if $has_lvm2;
 392
 393             # Find which whole devices (RHBZ#590167), partitions and LVs
 394             # contain mountable filesystems.  Stat those which are
 395             # mountable, and ignore the others.
 396             foreach (@devs) {
 397                 try_df ($name, $uuid, $g, $_, canonical_dev ($_, $n));
 398             }
 399             foreach (filter_partitions (\@devs, @partitions)) {
 400                 try_df ($name, $uuid, $g, $_, canonical_dev ($_, $n));
 401             }
 402             if ($has_lvm2) {
 403                 foreach ($g->lvs ()) {
 404                     try_df ($name, $uuid, $g, $_);
 405                 }
 406             }
 407
 408             $n += $nr_disks;
 409         }
 410     };
 411     warn if $@;
 412 }
 413
 414 sub filter_partitions
 415 {
 416     my $devs = shift;
 417     my @devs = @$devs;
 418     my @r;
 419
 420     foreach my $p (@_) {
 421         foreach my $d (@devs) {
 422             if ($p =~ /^$d\d/) {
 423                 push @r, $p;
 424                 last;
 425             }
 426         }
 427     }
 428
 429     return @r;
 430 }
 431
 432 # Calculate the canonical name for a device.
 433 # eg: /dev/vdb1 when offset = 1
 434 #     => canonical name is /dev/sda1
 435 sub canonical_dev
 436 {
 437     local $_;
 438     my $dev = shift;
 439     my $offset = shift;
 440
 441     return $dev unless $dev =~ m{^/dev/.d([a-z])(\d*)$};
 442     my $disk = $1;
 443     my $partnum = $2;
 444
 445     $disk = chr (ord ($disk) - $offset);
 446
 447     return "/dev/sd$disk$partnum"
 448 }
 449
 450 sub try_df
 451 {
 452     local $_;
 453     my $domname = shift;
 454     my $domuuid = shift;
 455     my $g = shift;
 456     my $dev = shift;
 457     my $display = shift || $dev;
 458
 459     my %stat;
 460     eval {
 461         $g->mount_ro ($dev, "/");
 462         %stat = $g->statvfs ("/");
 463     };
 464     if (!$@) {
 465         print_stat ($domname, $domuuid, $display, \%stat);
 466     }
 467     $g->umount_all ();
 468 }
 469
 470 sub print_stat
 471 {
 472     my $domname = shift;
 473     my $domuuid = shift;
 474     my $dev = shift;
 475     my $stat = shift;
 476
 477     my @cols;
 478     if (!$uuid || !defined $domuuid) {
 479         push @cols, $domname;
 480     } else {
 481         push @cols, $domuuid;
 482     }
 483     push @cols, $dev;
 484
 485     if (!$inodes) {
 486         my $bsize = $stat->{bsize};     # block size
 487         my $blocks = $stat->{blocks};   # total number of blocks
 488         my $bfree = $stat->{bfree};     # blocks free (total)
 489         my $bavail = $stat->{bavail};   # blocks free (for non-root users)
 490
 491         my $factor = $bsize / 1024;
 492
 493         push @cols, $blocks*$factor;    # total 1K blocks
 494         push @cols, ($blocks-$bfree)*$factor; # total 1K blocks used
 495         push @cols, $bavail*$factor;    # total 1K blocks available
 496
 497         push @cols, 100.0 - 100.0 * $bfree / $blocks;
 498
 499         if ($human) {
 500             $cols[2] = human_size ($cols[2]);
 501             $cols[3] = human_size ($cols[3]);
 502             $cols[4] = human_size ($cols[4]);
 503         }
 504     } else {
 505         my $files = $stat->{files};     # total number of inodes
 506         my $ffree = $stat->{ffree};     # inodes free (total)
 507         my $favail = $stat->{favail};   # inodes free (for non-root users)
 508
 509         push @cols, $files;
 510         push @cols, $files-$ffree;
 511         push @cols, $ffree;
 512
 513         push @cols, 100.0 - 100.0 * $ffree / $files;
 514     }
 515
 516     print_cols (@cols);
 517 }
 518
 519 sub print_title
 520 {
 521     my @cols = (__"Virtual Machine", __"Filesystem");
 522     if (!$inodes) {
 523         if (!$human) {
 524             push @cols, __"1K-blocks";
 525         } else {
 526             push @cols, __"Size";
 527         }
 528         push @cols, __"Used";
 529         push @cols, __"Available";
 530         push @cols, __"Use%";
 531     } else {
 532         push @cols, __"Inodes";
 533         push @cols, __"IUsed";
 534         push @cols, __"IFree";
 535         push @cols, __"IUse%";
 536     }
 537
 538     if (!$csv) {
 539         # ignore $cols[0] in this mode
 540         printf "%-36s%10s %10s %10s %5s\n",
 541           $cols[1], $cols[2], $cols[3], $cols[4], $cols[5];
 542     } else {
 543         # Columns don't need special CSV quoting.
 544         print (join (",", @cols), "\n");
 545     }
 546 }
 547
 548 sub print_cols
 549 {
 550     if (!$csv) {
 551         my $label = sprintf "%s:%s", $_[0], $_[1];
 552
 553         printf ("%-36s", $label);
 554         print "\n"," "x36 if length ($label) > 36;
 555
 556         # Use 'ceil' on the percentage in order to emulate
 557         # what df itself does.
 558         my $percent = sprintf "%3d%%", ceil($_[5]);
 559
 560         printf ("%10s %10s %10s %5s\n", $_[2], $_[3], $_[4], $percent);
 561     } else {
 562         # Need to quote libvirt domain and filesystem.
 563         my $dom = shift;
 564         my $fs = shift;
 565         print csv_quote($dom), ",", csv_quote($fs), ",";
 566         printf ("%d,%d,%d,%.1f%%\n", @_);
 567     }
 568 }
 569
 570 # Convert a number of 1K blocks to a human-readable number.
 571 sub human_size
 572 {
 573     local $_ = shift;
 574
 575     if ($_ < 1024) {
 576         sprintf "%dK", $_;
 577     } elsif ($_ < 1024 * 1024) {
 578         sprintf "%.1fM", ($_ / 1024);
 579     } else {
 580         sprintf "%.1fG", ($_ / 1024 / 1024);
 581     }
 582 }
 583
 584 # Quote field for CSV without using an external module.
 585 sub csv_quote
 586 {
 587     local $_ = shift;
 588
 589     my $needs_quoting = /[ ",\n\0]/;
 590     return $_ unless $needs_quoting;
 591
 592     my $i;
 593     my $out = '"';
 594     for ($i = 0; $i < length; ++$i) {
 595         my $c = substr $_, $i, 1;
 596         if ($c eq '"') {
 597             $out .= '""';
 598         } elsif ($c eq '\0') {
 599             $out .= '"0';
 600         } else {
 601             $out .= $c;
 602         }
 603     }
 604     $out .= '"';
 605
 606     return $out;
 607 }
 608
 609 =head1 NOTE ABOUT CSV FORMAT
 610
 611 Comma-separated values (CSV) is a deceptive format.  It I<seems> like
 612 it should be easy to parse, but it is definitely not easy to parse.
 613
 614 Myth: Just split fields at commas.  Reality: This does I<not> work
 615 reliably.  This example has two columns:
 616
 617  "foo,bar",baz
 618
 619 Myth: Read the file one line at a time.  Reality: This does I<not>
 620 work reliably.  This example has one row:
 621
 622  "foo
 623  bar",baz
 624
 625 For shell scripts, use C<csvtool> (L<http://merjis.com/developers/csv>
 626 also packaged in major Linux distributions).
 627
 628 For other languages, use a CSV processing library (eg. C<Text::CSV>
 629 for Perl or Python's built-in csv library).
 630
 631 Most spreadsheets and databases can import CSV directly.
 632
 633 =head1 SHELL QUOTING
 634
 635 Libvirt guest names can contain arbitrary characters, some of which
 636 have meaning to the shell such as C<#> and space.  You may need to
 637 quote or escape these characters on the command line.  See the shell
 638 manual page L<sh(1)> for details.
 639
 640 =head1 SEE ALSO
 641
 642 L<guestfs(3)>,
 643 L<guestfish(1)>,
 644 L<Sys::Guestfs(3)>,
 645 L<Sys::Guestfs::Lib(3)>,
 646 L<Sys::Virt(3)>,
 647 L<http://libguestfs.org/>.
 648
 649 =head1 AUTHOR
 650
 651 Richard W.M. Jones L<http://people.redhat.com/~rjones/>
 652
 653 =head1 COPYRIGHT
 654
 655 Copyright (C) 2009-2010 Red Hat Inc.
 656
 657 This program is free software; you can redistribute it and/or modify
 658 it under the terms of the GNU General Public License as published by
 659 the Free Software Foundation; either version 2 of the License, or
 660 (at your option) any later version.
 661
 662 This program is distributed in the hope that it will be useful,
 663 but WITHOUT ANY WARRANTY; without even the implied warranty of
 664 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 665 GNU General Public License for more details.
 666
 667 You should have received a copy of the GNU General Public License
 668 along with this program; if not, write to the Free Software
 669 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.