use strict;
use Sys::Guestfs;
+use Sys::Guestfs::Lib qw(open_guest);
use Pod::Usage;
use Getopt::Long;
use Data::Dumper;
use XML::Writer;
# Optional:
-eval "use Sys::Virt;";
-eval "use XML::XPath;";
-eval "use XML::XPath::XMLParser;";
eval "use YAML::Any;";
=encoding utf8
pod2usage (1) if $help;
pod2usage ("$0: no image or VM names given") if @ARGV == 0;
-# Domain name or guest image(s)?
-
-my @images;
-if (-e $ARGV[0]) {
- @images = @ARGV;
-
- foreach (@images) {
- if (! -r $_) {
- die "guest image $_ does not exist or is not readable\n"
- }
- }
+my $rw = 0;
+$rw = 1 if $output eq "fish";
+my $g;
+if ($uri) {
+ $g = open_guest (\@ARGV, rw => $rw, address => $uri);
} else {
- die "virt-inspector: no libvirt support (install Sys::Virt, XML::XPath and XML::XPath::XMLParser)\n"
- unless exists $INC{"Sys/Virt.pm"} &&
- exists $INC{"XML/XPath.pm"} &&
- exists $INC{"XML/XPath/XMLParser.pm"};
-
- pod2usage ("$0: too many domains listed on command line") if @ARGV > 1;
-
- my $vmm;
- if (defined $uri) {
- $vmm = Sys::Virt->new (uri => $uri, readonly => 1);
- } else {
- $vmm = Sys::Virt->new (readonly => 1);
- }
- die "cannot connect to libvirt $uri\n" unless $vmm;
-
- my @doms = $vmm->list_defined_domains ();
- my $isitinactive = "an inactive libvirt domain";
- if ($output ne "fish") {
- # In the special case where we want read-only access to
- # a domain, allow the user to specify an active domain too.
- push @doms, $vmm->list_domains ();
- $isitinactive = "a libvirt domain";
- }
- my $dom;
- foreach (@doms) {
- if ($_->get_name () eq $ARGV[0]) {
- $dom = $_;
- last;
- }
- }
- die "$ARGV[0] is not the name of $isitinactive\n" unless $dom;
-
- # Get the names of the image(s).
- my $xml = $dom->get_xml_description ();
-
- my $p = XML::XPath->new (xml => $xml);
- my @disks = $p->findnodes ('//devices/disk/source/@dev');
- @images = map { $_->getData } @disks;
+ $g = open_guest (\@ARGV, rw => $rw);
}
-# We've now got the list of @images, so feed them to libguestfs.
-my $g = Sys::Guestfs->new ();
-$g->add_drive_ro ($_) foreach @images;
$g->launch ();
$g->wait_ready ();
} else {
$fs->{used} = 1
}
+ $fs->{spec} = $spec;
}
}
}
} else {
return ($_, $fses{$_}) if exists $fses{$_};
+ # The following is to handle the case where an fstab entry specifies a
+ # specific device rather than its label or uuid, and the libguestfs
+ # appliance has named the device differently due to the use of a
+ # different driver.
+ # This will work as long as the underlying drivers recognise devices in
+ # the same order.
if (m{^/dev/hd(.*)} && exists $fses{"/dev/sd$1"}) {
return ("/dev/sd$1", $fses{"/dev/sd$1"});
}
# we don't need to know.
if ($output !~ /.*fish$/) {
- # Temporary directory for use by check_for_initrd.
- my $dir = tempdir (CLEANUP => 1);
-
my $root_dev;
foreach $root_dev (sort keys %oses) {
my $mounts = $oses{$root_dev}->{mounts};
check_for_kernels ($root_dev);
if ($oses{$root_dev}->{os} eq "linux") {
check_for_modprobe_aliases ($root_dev);
- check_for_initrd ($root_dev, $dir);
+ check_for_initrd ($root_dev);
}
$g->umount_all ();
@results = $g->aug_match($pattern);
for my $path ( @results ) {
+ $path =~ m{^/files(.*)/alias(?:\[\d*\])?$}
+ or die("$path doesn't match augeas pattern");
+ my $file = $1;
+
my $alias;
$alias = $g->aug_get($path);
my $modulename;
$modulename = $g->aug_get($path.'/modulename');
- $modprobe_aliases{$alias} = $modulename;
+ my %aliasinfo;
+ $aliasinfo{modulename} = $modulename;
+ $aliasinfo{augeas} = $path;
+ $aliasinfo{file} = $file;
+
+ $modprobe_aliases{$alias} = \%aliasinfo;
}
}
{
local $_;
my $root_dev = shift;
- my $dir = shift;
my %initrd_modules;
foreach my $initrd ($g->ls ("/boot")) {
if ($initrd =~ m/^initrd-(.*)\.img$/ && $g->is_file ("/boot/$initrd")) {
my $version = $1;
- my @modules = ();
- # We have to download these to a temporary file.
- $g->download ("/boot/$initrd", "$dir/initrd");
-
- my $cmd = "zcat $dir/initrd | file -";
- open P, "$cmd |" or die "$cmd: $!";
- my $lines;
- { local $/ = undef; $lines = <P>; }
- close P;
- if ($lines =~ /ext\d filesystem data/) {
- # Before initramfs came along, these were compressed
- # ext2 filesystems. We could run another libguestfs
- # instance to unpack these, but punt on them for now. (XXX)
- warn "initrd image is unsupported ext2/3/4 filesystem\n";
- }
- elsif ($lines =~ /cpio/) {
- my $cmd = "zcat $dir/initrd | cpio --quiet -it";
- open P, "$cmd |" or die "$cmd: $!";
- while (<P>) {
- push @modules, $1
- if m,([^/]+)\.ko$, || m,([^/]+)\.o$,;
- }
- close P;
- unlink "$dir/initrd";
- $initrd_modules{$version} = \@modules;
- }
- else {
- # What?
- warn "unrecognized initrd image: $lines\n";
+ my @modules;
+
+ eval {
+ @modules = $g->initrd_list ("/boot/$initrd");
+ };
+ unless ($@) {
+ @modules = grep { m,([^/]+)\.ko$, || m,([^/]+)\.o$, } @modules;
+ $initrd_modules{$version} = \@modules
+ } else {
+ warn "/boot/$initrd: could not read initrd format"
}
}
}
print "--ro ";
}
- print "-a $_ " foreach @images;
+ print "-a $_ " foreach @ARGV;
my $mounts = $oses{$root_dev}->{mounts};
# Have to mount / first. Luckily '/' is early in the ASCII
elsif ($output eq "yaml") {
die "virt-inspector: no YAML support\n"
unless exists $INC{"YAML/Any.pm"};
-
+
print Dump(\%oses);
}
if (@keys) {
print " Modprobe aliases:\n";
foreach (@keys) {
- printf " %-30s %s\n", $_, $aliases{$_}
+ printf " %-30s %s\n", $_, $aliases{$_}->{modulename}
}
}
}
foreach my $field ( [ "label" => "label" ],
[ "uuid" => "uuid" ],
[ "type" => "fstype" ],
- [ "content" => "content" ] ) {
+ [ "content" => "content" ],
+ [ "spec" => "spec" ] ) {
$xml->dataElement($field->[0], $filesystems->{$_}{$field->[1]})
if exists $filesystems->{$_}{$field->[1]};
}
if (@keys) {
$xml->startTag("modprobealiases");
foreach (@keys) {
- $xml->dataElement("alias", $aliases{$_}, "device" => $_);
+ $xml->startTag("alias", "device" => $_);
+
+ foreach my $field ( [ "modulename" => "modulename" ],
+ [ "augeas" => "augeas" ],
+ [ "file" => "file" ] ) {
+ $xml->dataElement($field->[0], $aliases{$_}->{$field->[1]});
+ }
+
+ $xml->endTag("alias");
}
$xml->endTag("modprobealiases");
}
L<guestfs(3)>,
L<guestfish(1)>,
L<Sys::Guestfs(3)>,
+L<Sys::Guestfs::Lib(3)>,
L<Sys::Virt(3)>,
L<http://libguestfs.org/>.
git.annexia.org / libguestfs.git / blobdiff