X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=tools%2Fvirt-df;fp=tools%2Fvirt-df;h=0000000000000000000000000000000000000000;hb=18374b5b7d3154e0b8b8a07e3590f6eee762b58e;hp=6ec1c1a723cb07bee1ee1f8b9785def9db16e338;hpb=4838ec3326d2970e6afe3cde6b368aeae840b969;p=libguestfs.git diff --git a/tools/virt-df b/tools/virt-df deleted file mode 100755 index 6ec1c1a..0000000 --- a/tools/virt-df +++ /dev/null @@ -1,669 +0,0 @@ -#!/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 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 command, but for virtual machines, except that -it also works for Windows virtual machines. - -If used without any arguments, C checks with libvirt to get a -list of all active and inactive guests, and performs a C-type -operation on each one in turn, printing out the results. - -If used with any argument(s), C performs a C-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 will I. If you want to run on multiple guests, then you have -to invoke C 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 -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. 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 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 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 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 work -reliably. This example has two columns: - - "foo,bar",baz - -Myth: Read the file one line at a time. Reality: This does I -work reliably. This example has one row: - - "foo - bar",baz - -For shell scripts, use C (L -also packaged in major Linux distributions). - -For other languages, use a CSV processing library (eg. C -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 for details. - -=head1 SEE ALSO - -L, -L, -L, -L, -L, -L. - -=head1 AUTHOR - -Richard W.M. Jones L - -=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.