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