+++ /dev/null
-#!/usr/bin/perl -w
-# virt-df
-# Copyright (C) 2009-2010 Red Hat Inc.
-#
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2 of the License, or
-# (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-use warnings;
-use strict;
-
-use Sys::Guestfs;
-use Sys::Guestfs::Lib qw(feature_available);
-
-use Pod::Usage;
-use Getopt::Long;
-use File::Basename qw(basename);
-use POSIX qw(ceil);
-
-use Locale::TextDomain 'libguestfs';
-
-=encoding utf8
-
-=head1 NAME
-
-virt-df - Display free space on virtual filesystems
-
-=head1 SYNOPSIS
-
- virt-df [--options]
-
- virt-df [--options] domname
-
- virt-df [--options] disk.img [disk.img ...]
-
-=head1 DESCRIPTION
-
-C<virt-df> is a command line tool to display free space on virtual
-machine filesystems. Unlike other tools, it doesn't just display the
-amount of space allocated to a virtual machine, but can look inside
-the virtual machine to see how much space is really being used.
-
-It is like the L<df(1)> command, but for virtual machines, except that
-it also works for Windows virtual machines.
-
-If used without any arguments, C<virt-df> checks with libvirt to get a
-list of all active and inactive guests, and performs a C<df>-type
-operation on each one in turn, printing out the results.
-
-If used with any argument(s), C<virt-df> performs a C<df>-type
-operation on either the single named libvirt domain, or on the disk
-image(s) listed on the command line (which must all belong to a single
-VM). In this mode (with arguments), C<virt-df> will I<only work for a
-single guest>. If you want to run on multiple guests, then you have
-to invoke C<virt-df> multiple times.
-
-Use the C<--csv> option to get a format which can be easily parsed by
-other programs. Other options are mostly similar to standard C<df>
-options. See below for the complete list.
-
-=head1 OPTIONS
-
-=over 4
-
-=cut
-
-my $help;
-
-=item B<--help>
-
-Display brief help.
-
-=cut
-
-my $version;
-
-=item B<--version>
-
-Display version number and exit.
-
-=cut
-
-my $uri;
-
-=item B<--connect URI> | B<-c URI>
-
-If using libvirt, connect to the given I<URI>. If omitted, then we
-connect to the default libvirt hypervisor.
-
-If you specify guest block devices directly, then libvirt is not used
-at all.
-
-=cut
-
-my $csv;
-
-=item B<--csv>
-
-Write out the results in CSV format (comma-separated values). This format
-can be imported easily into databases and spreadsheets, but
-read L</NOTE ABOUT CSV FORMAT> below.
-
-=cut
-
-my $format;
-
-=item B<--format> raw
-
-Specify the format of disk images given on the command line. If this
-is omitted then the format is autodetected from the content of the
-disk image.
-
-If disk images are requested from libvirt, then this program asks
-libvirt for this information. In this case, the value of the format
-parameter is ignored.
-
-If working with untrusted raw-format guest disk images, you should
-ensure the format is always specified.
-
-=cut
-
-my $human;
-
-=item B<--human-readable> | B<-h>
-
-Print sizes in human-readable format.
-
-You are not allowed to use I<-h> and I<--csv> at the same time.
-
-=cut
-
-my $inodes;
-
-=item B<--inodes> | B<-i>
-
-Print inodes instead of blocks.
-
-=cut
-
-my $one_per_guest;
-
-=item B<--one-per-guest>
-
-Run one libguestfs appliance per guest. Normally C<virt-df> will
-add the disks from several guests to a single libguestfs appliance.
-
-You might use this option in the following circumstances:
-
-=over 4
-
-=item *
-
-If you think an untrusted guest might actively try to exploit the
-libguestfs appliance kernel, then this prevents one guest from
-interfering with the stats printed for another guest.
-
-=item *
-
-If the kernel has a bug which stops it from accessing a
-filesystem in one guest (see for example RHBZ#635373) then
-this allows libguestfs to continue and report stats for further
-guests.
-
-=back
-
-=cut
-
-my $uuid;
-
-=item B<--uuid>
-
-Print UUIDs instead of names. This is useful for following
-a guest even when the guest is migrated or renamed, or when
-two guests happen to have the same name.
-
-Note that only domains that we fetch from libvirt come with UUIDs.
-For disk images, we still print the disk image name even when
-this option is specified.
-
-=back
-
-=cut
-
-GetOptions ("help|?" => \$help,
- "version" => \$version,
- "connect|c=s" => \$uri,
- "csv" => \$csv,
- "format=s" => \$format,
- "human-readable|human|h" => \$human,
- "inodes|i" => \$inodes,
- "one-per-guest" => \$one_per_guest,
- "uuid" => \$uuid,
- ) or pod2usage (2);
-pod2usage (1) if $help;
-if ($version) {
- my $g = Sys::Guestfs->new ();
- my %h = $g->version ();
- print "$h{major}.$h{minor}.$h{release}$h{extra}\n";
- exit
-}
-
-# RHBZ#600977
-die __"virt-df: cannot use -h and --csv options together\n" if $human && $csv;
-
-# RHBZ#635373
-#
-# Limit the number of devices we will ever add to the appliance. The
-# overall limit in current libguestfs is 25: 26 = number of letters in
-# the English alphabet since we are only confident that /dev/sd[a-z]
-# will work because of various limits, minus 1 because that may be
-# used by the ext2 initial filesystem.
-my $max_disks = 25;
-
-# Get the list of domains and block devices.
-#
-# We can't use Sys::Guestfs::Lib::open_guest here because we want to
-# create the libguestfs handle/appliance as few times as possible.
-#
-# If virt-df is called with no parameters, then run the libvirt
-# equivalent of "virsh list --all", get the XML for each domain, and
-# get the disk devices.
-#
-# If virt-df is called with parameters, assume it must either be a
-# single disk image filename, a list of disk image filenames, or a
-# single libvirt guest name. Construct disk devices accordingly.
-
-my @domains = ();
-
-if (@ARGV == 0) { # No params, use libvirt.
- my $conn;
-
- if ($uri) {
- $conn = Sys::Virt->new (readonly => 1, address => $uri);
- } else {
- $conn = Sys::Virt->new (readonly => 1);
- }
-
- my @doms = $conn->list_defined_domains ();
- push @doms, $conn->list_domains ();
-
- # https://bugzilla.redhat.com/show_bug.cgi?id=538041
- @doms = grep { $_->get_id () != 0 } @doms;
-
- exit 0 unless @doms;
-
- foreach my $dom (@doms) {
- my @disks = get_disks_from_libvirt ($dom);
- push @domains, { dom => $dom,
- name => $dom->get_name (),
- uuid => $dom->get_uuid_string (),
- disks => \@disks }
- }
-} elsif (@ARGV == 1) { # One param, could be disk image or domname.
- if (-e $ARGV[0]) {
- push @domains, { name => basename ($ARGV[0]),
- disks => [ [ $ARGV[0], $format ] ] }
- } else {
- my $conn;
-
- if ($uri) {
- $conn = Sys::Virt->new (readonly => 1, address => $uri);
- } else {
- $conn = Sys::Virt->new (readonly => 1);
- }
-
- my $dom = $conn->get_domain_by_name ($ARGV[0])
- or die __x("{name} is not the name of a libvirt domain\n",
- name => $ARGV[0]);
- my @disks = get_disks_from_libvirt ($dom);
- push @domains, { dom => $dom,
- name => $dom->get_name (),
- uuid => $dom->get_uuid_string (),
- disks => \@disks }
- }
-} else { # >= 2 params, all disk images.
- my @disks = map { [ $_, $format ] } @ARGV;
- push @domains, { name => basename ($ARGV[0]),
- disks => \@disks }
-}
-
-sub get_disks_from_libvirt
-{
- my $dom = shift;
- my $xml = $dom->get_xml_description ();
-
- my $p = XML::XPath->new (xml => $xml);
- my $nodes = $p->find ('//devices/disk');
-
- my @disks;
- my $node;
- foreach $node ($nodes->get_nodelist) {
- # The filename can be in dev or file attribute, hence:
- my $filename = $p->find ('./source/@dev', $node);
- unless ($filename) {
- $filename = $p->find ('./source/@file', $node);
- next unless $filename;
- }
- $filename = $filename->to_literal;
-
- # Get the disk format (may not be set).
- my $format = $p->find ('./driver/@type', $node);
- $format = $format->to_literal if $format;
-
- push @disks, [ $filename, $format ];
- }
-
- # Code in Sys::Guestfs::Lib dies here if there are no disks at all.
-
- return @disks;
-}
-
-# Sort the domains by name for display.
-@domains = sort { $a->{name} cmp $b->{name} } @domains;
-
-# Since we got this far, we're somewhat sure we're going to
-# get to print the result, so display the title.
-print_title ();
-
-# To minimize the number of times we have to launch the appliance,
-# shuffle as many domains together as we can, but not exceeding
-# MAX_DISKS per request. If --one-per-guest was requested then only
-# request disks from a single guest each time.
-if ($one_per_guest) {
- foreach (@domains) {
- my @request = ( $_ );
- multi_df (@request);
- }
-} else {
- while (@domains) {
- my $n = 0; # number of disks added so far
- my @request = ();
- while (@domains) {
- my $c = @{$domains[0]->{disks}};
- if ($c > $max_disks) {
- warn __x("virt-df: ignoring {name}, it has too many disks ({c} > {max})",
- name => $domains[0]->{name},
- c => $c, max => $max_disks);
- next;
- }
- last if $n + $c > $max_disks;
- $n += $c;
- push @request, shift (@domains);
- }
- multi_df (@request);
- }
-}
-
-sub multi_df
-{
- local $_;
- eval {
- my $g = Sys::Guestfs->new ();
-
- my ($d, $disk);
-
- foreach $d (@_) {
- foreach $disk (@{$d->{disks}}) {
- my $filename = $disk->[0];
- my $format = $disk->[1];
- my @args = ($filename);
- push @args, readonly => 1;
- push @args, format => $format if defined $format;
- $g->add_drive_opts (@args);
- }
- }
-
- $g->launch ();
- my $has_lvm2 = feature_available ($g, "lvm2");
-
- my @devices = $g->list_devices ();
- my @partitions = $g->list_partitions ();
-
- my $n = 0;
- foreach $d (@_) {
- my $name = $d->{name};
- my $uuid = $d->{uuid};
- my $nr_disks = @{$d->{disks}};
-
- # Filter LVM to only the devices applying to the original domain.
- my @devs = @devices[$n .. $n+$nr_disks-1];
- $g->lvm_set_filter (\@devs) if $has_lvm2;
-
- # Find which whole devices (RHBZ#590167), partitions and LVs
- # contain mountable filesystems. Stat those which are
- # mountable, and ignore the others.
- foreach (@devs) {
- try_df ($name, $uuid, $g, $_, canonical_dev ($_, $n));
- }
- foreach (filter_partitions (\@devs, @partitions)) {
- try_df ($name, $uuid, $g, $_, canonical_dev ($_, $n));
- }
- if ($has_lvm2) {
- foreach ($g->lvs ()) {
- try_df ($name, $uuid, $g, $_);
- }
- }
-
- $n += $nr_disks;
- }
- };
- warn if $@;
-}
-
-sub filter_partitions
-{
- my $devs = shift;
- my @devs = @$devs;
- my @r;
-
- foreach my $p (@_) {
- foreach my $d (@devs) {
- if ($p =~ /^$d\d/) {
- push @r, $p;
- last;
- }
- }
- }
-
- return @r;
-}
-
-# Calculate the canonical name for a device.
-# eg: /dev/vdb1 when offset = 1
-# => canonical name is /dev/sda1
-sub canonical_dev
-{
- local $_;
- my $dev = shift;
- my $offset = shift;
-
- return $dev unless $dev =~ m{^/dev/.d([a-z])(\d*)$};
- my $disk = $1;
- my $partnum = $2;
-
- $disk = chr (ord ($disk) - $offset);
-
- return "/dev/sd$disk$partnum"
-}
-
-sub try_df
-{
- local $_;
- my $domname = shift;
- my $domuuid = shift;
- my $g = shift;
- my $dev = shift;
- my $display = shift || $dev;
-
- my %stat;
- eval {
- $g->mount_ro ($dev, "/");
- %stat = $g->statvfs ("/");
- };
- if (!$@) {
- print_stat ($domname, $domuuid, $display, \%stat);
- }
- $g->umount_all ();
-}
-
-sub print_stat
-{
- my $domname = shift;
- my $domuuid = shift;
- my $dev = shift;
- my $stat = shift;
-
- my @cols;
- if (!$uuid || !defined $domuuid) {
- push @cols, $domname;
- } else {
- push @cols, $domuuid;
- }
- push @cols, $dev;
-
- if (!$inodes) {
- my $bsize = $stat->{bsize}; # block size
- my $blocks = $stat->{blocks}; # total number of blocks
- my $bfree = $stat->{bfree}; # blocks free (total)
- my $bavail = $stat->{bavail}; # blocks free (for non-root users)
-
- my $factor = $bsize / 1024;
-
- push @cols, $blocks*$factor; # total 1K blocks
- push @cols, ($blocks-$bfree)*$factor; # total 1K blocks used
- push @cols, $bavail*$factor; # total 1K blocks available
-
- push @cols, 100.0 - 100.0 * $bfree / $blocks;
-
- if ($human) {
- $cols[2] = human_size ($cols[2]);
- $cols[3] = human_size ($cols[3]);
- $cols[4] = human_size ($cols[4]);
- }
- } else {
- my $files = $stat->{files}; # total number of inodes
- my $ffree = $stat->{ffree}; # inodes free (total)
- my $favail = $stat->{favail}; # inodes free (for non-root users)
-
- push @cols, $files;
- push @cols, $files-$ffree;
- push @cols, $ffree;
-
- push @cols, 100.0 - 100.0 * $ffree / $files;
- }
-
- print_cols (@cols);
-}
-
-sub print_title
-{
- my @cols = (__"Virtual Machine", __"Filesystem");
- if (!$inodes) {
- if (!$human) {
- push @cols, __"1K-blocks";
- } else {
- push @cols, __"Size";
- }
- push @cols, __"Used";
- push @cols, __"Available";
- push @cols, __"Use%";
- } else {
- push @cols, __"Inodes";
- push @cols, __"IUsed";
- push @cols, __"IFree";
- push @cols, __"IUse%";
- }
-
- if (!$csv) {
- # ignore $cols[0] in this mode
- printf "%-36s%10s %10s %10s %5s\n",
- $cols[1], $cols[2], $cols[3], $cols[4], $cols[5];
- } else {
- # Columns don't need special CSV quoting.
- print (join (",", @cols), "\n");
- }
-}
-
-sub print_cols
-{
- if (!$csv) {
- my $label = sprintf "%s:%s", $_[0], $_[1];
-
- printf ("%-36s", $label);
- print "\n"," "x36 if length ($label) > 36;
-
- # Use 'ceil' on the percentage in order to emulate
- # what df itself does.
- my $percent = sprintf "%3d%%", ceil($_[5]);
-
- printf ("%10s %10s %10s %5s\n", $_[2], $_[3], $_[4], $percent);
- } else {
- # Need to quote libvirt domain and filesystem.
- my $dom = shift;
- my $fs = shift;
- print csv_quote($dom), ",", csv_quote($fs), ",";
- printf ("%d,%d,%d,%.1f%%\n", @_);
- }
-}
-
-# Convert a number of 1K blocks to a human-readable number.
-sub human_size
-{
- local $_ = shift;
-
- if ($_ < 1024) {
- sprintf "%dK", $_;
- } elsif ($_ < 1024 * 1024) {
- sprintf "%.1fM", ($_ / 1024);
- } else {
- sprintf "%.1fG", ($_ / 1024 / 1024);
- }
-}
-
-# Quote field for CSV without using an external module.
-sub csv_quote
-{
- local $_ = shift;
-
- my $needs_quoting = /[ ",\n\0]/;
- return $_ unless $needs_quoting;
-
- my $i;
- my $out = '"';
- for ($i = 0; $i < length; ++$i) {
- my $c = substr $_, $i, 1;
- if ($c eq '"') {
- $out .= '""';
- } elsif ($c eq '\0') {
- $out .= '"0';
- } else {
- $out .= $c;
- }
- }
- $out .= '"';
-
- return $out;
-}
-
-=head1 NOTE ABOUT CSV FORMAT
-
-Comma-separated values (CSV) is a deceptive format. It I<seems> like
-it should be easy to parse, but it is definitely not easy to parse.
-
-Myth: Just split fields at commas. Reality: This does I<not> work
-reliably. This example has two columns:
-
- "foo,bar",baz
-
-Myth: Read the file one line at a time. Reality: This does I<not>
-work reliably. This example has one row:
-
- "foo
- bar",baz
-
-For shell scripts, use C<csvtool> (L<http://merjis.com/developers/csv>
-also packaged in major Linux distributions).
-
-For other languages, use a CSV processing library (eg. C<Text::CSV>
-for Perl or Python's built-in csv library).
-
-Most spreadsheets and databases can import CSV directly.
-
-=head1 SHELL QUOTING
-
-Libvirt guest names can contain arbitrary characters, some of which
-have meaning to the shell such as C<#> and space. You may need to
-quote or escape these characters on the command line. See the shell
-manual page L<sh(1)> for details.
-
-=head1 SEE ALSO
-
-L<guestfs(3)>,
-L<guestfish(1)>,
-L<Sys::Guestfs(3)>,
-L<Sys::Guestfs::Lib(3)>,
-L<Sys::Virt(3)>,
-L<http://libguestfs.org/>.
-
-=head1 AUTHOR
-
-Richard W.M. Jones L<http://people.redhat.com/~rjones/>
-
-=head1 COPYRIGHT
-
-Copyright (C) 2009-2010 Red Hat Inc.
-
-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-This program is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
git.annexia.org / libguestfs.git / blobdiff