X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;ds=sidebyside;f=inspector%2Fvirt-inspector.pl;h=f12af42f529211ef93d02855fd732ceec3cf9761;hb=c6d6f5ae1b76ec9aa5c540906aeed73d25d13eb9;hp=717ccb6107b6e20a54e46bcb5d695703e99e5b40;hpb=e1c62f6332ae07cb6f95130dcc9852701d085e2b;p=libguestfs.git diff --git a/inspector/virt-inspector.pl b/inspector/virt-inspector.pl index 717ccb6..f12af42 100755 --- a/inspector/virt-inspector.pl +++ b/inspector/virt-inspector.pl @@ -24,9 +24,13 @@ use Pod::Usage; use Getopt::Long; use Data::Dumper; use File::Temp qw/tempdir/; +use XML::Writer; # Optional: eval "use Sys::Virt;"; +eval "use XML::XPath;"; +eval "use XML::XPath::XMLParser;"; +eval "use YAML::Any;"; =encoding utf8 @@ -132,6 +136,11 @@ Produce no output at all. If you select I<--xml> then you get XML output which can be fed to other programs. +=item B<--yaml> + +If you select I<--yaml> then you get YAML output which can be fed +to other programs. + =item B<--perl> If you select I<--perl> then you get Perl structures output which @@ -181,6 +190,7 @@ GetOptions ("help|?" => \$help, "text" => sub { $output = "text" }, "none" => sub { $output = "none" }, "xml" => sub { $output = "xml" }, + "yaml" => sub { $output = "yaml" }, "perl" => sub { $output = "perl" }, "fish" => sub { $output = "fish" }, "guestfish" => sub { $output = "fish" }, @@ -204,8 +214,10 @@ if (-e $ARGV[0]) { } } } else { - die "no libvirt support (install Sys::Virt)" - unless exists $INC{"Sys/Virt.pm"}; + 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; @@ -218,6 +230,13 @@ if (-e $ARGV[0]) { 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]) { @@ -225,20 +244,14 @@ if (-e $ARGV[0]) { last; } } - die "$ARGV[0] is not the name of an inactive libvirt domain\n" - unless $dom; + 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 = new XML::XPath::XMLParser (xml => $xml); - my $disks = $p->find ("//devices/disk"); - print "disks:\n"; - foreach ($disks->get_nodelist) { - print XML::XPath::XMLParser::as_string($_); - } - - die "XXX" + my $p = XML::XPath->new (xml => $xml); + my @disks = $p->findnodes ('//devices/disk/source/@dev'); + @images = map { $_->getData } @disks; } # We've now got the list of @images, so feed them to libguestfs. @@ -714,9 +727,6 @@ sub find_filesystem # 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}; @@ -731,7 +741,7 @@ if ($output !~ /.*fish$/) { 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 (); @@ -832,14 +842,47 @@ sub check_for_modprobe_aliases local $_; my $root_dev = shift; - my @lines; - eval { @lines = $g->read_lines ("/etc/modprobe.conf"); }; - return if $@ || !@lines; + # Initialise augeas + my $success = 0; + $success = $g->aug_init("/", 16); + + # Register /etc/modules.conf and /etc/conf.modules to the Modprobe lens + my @results; + @results = $g->aug_match("/augeas/load/Modprobe/incl"); + + # Calculate the next index of /augeas/load/Modprobe/incl + my $i = 1; + foreach ( @results ) { + next unless m{/augeas/load/Modprobe/incl\[(\d*)]}; + $i = $1 + 1 if ($1 == $i); + } + + $success = $g->aug_set("/augeas/load/Modprobe/incl[$i]", + "/etc/modules.conf"); + $i++; + $success = $g->aug_set("/augeas/load/Modprobe/incl[$i]", + "/etc/conf.modules"); + + # Make augeas reload + $success = $g->aug_load(); my %modprobe_aliases; - foreach (@lines) { - $modprobe_aliases{$1} = $2 if /^\s*alias\s+(\S+)\s+(\S+)/; + for my $pattern qw(/files/etc/conf.modules/alias + /files/etc/modules.conf/alias + /files/etc/modprobe.conf/alias + /files/etc/modprobe.d/*/alias) { + @results = $g->aug_match($pattern); + + for my $path ( @results ) { + my $alias; + $alias = $g->aug_get($path); + + my $modulename; + $modulename = $g->aug_get($path.'/modulename'); + + $modprobe_aliases{$alias} = $modulename; + } } $oses{$root_dev}->{modprobe_aliases} = \%modprobe_aliases; @@ -852,42 +895,22 @@ sub check_for_initrd { 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 =
; } - 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 (
) {
- 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"
}
}
}
@@ -925,6 +948,14 @@ elsif ($output eq "perl") {
print Dumper(\%oses);
}
+# YAML output
+elsif ($output eq "yaml") {
+ die "virt-inspector: no YAML support\n"
+ unless exists $INC{"YAML/Any.pm"};
+
+ print Dump(\%oses);
+}
+
# Plain text output (the default).
elsif ($output eq "text") {
output_text ();
@@ -1025,55 +1056,61 @@ sub output_text_os
sub output_xml
{
- print "