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