X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=inspector%2Fvirt-inspector.pl;h=7ab808b8c6d163bdf8bcfa402a29e62405180dee;hp=bd8de7034ed2d53c38738c6e7bc04fc0797868ff;hb=22528e9bc486cbb6357192bd758c417c61bba955;hpb=66f728d4f84306cef689a6150c5a1aec3c765508 diff --git a/inspector/virt-inspector.pl b/inspector/virt-inspector.pl index bd8de70..7ab808b 100755 --- a/inspector/virt-inspector.pl +++ b/inspector/virt-inspector.pl @@ -20,6 +20,9 @@ use warnings; use strict; use Sys::Guestfs; +use Sys::Guestfs::Lib qw(open_guest get_partitions resolve_windows_path + inspect_all_partitions inspect_partition + inspect_operating_systems mount_operating_system inspect_in_detail); use Pod::Usage; use Getopt::Long; use Data::Dumper; @@ -27,9 +30,6 @@ 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 @@ -202,79 +202,18 @@ GetOptions ("help|?" => \$help, 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 (); -# We want to get the list of LVs and partitions (ie. anything that -# could contain a filesystem). Discard any partitions which are PVs. -my @partitions = $g->list_partitions (); -my @pvs = $g->pvs (); -sub is_pv { - my $t = shift; - foreach (@pvs) { - return 1 if $_ eq $t; - } - 0; -} -@partitions = grep { ! is_pv ($_) } @partitions; - -my @lvs = $g->lvs (); - =head1 OUTPUT FORMAT Operating system(s) @@ -318,634 +257,40 @@ right place. For example: =cut # List of possible filesystems. -my @devices = sort (@lvs, @partitions); +my @partitions = get_partitions ($g); # Now query each one to build up a picture of what's in it. -my %fses = map { $_ => check_fs ($_) } @devices; - -# Now the complex checking code itself. -# check_fs takes a device name (LV or partition name) and returns -# a hashref containing everything we can find out about the device. -sub check_fs { - local $_; - my $dev = shift; # LV or partition name. - - my %r; # Result hash. - - # First try 'file(1)' on it. - my $file = $g->file ($dev); - if ($file =~ /ext2 filesystem data/) { - $r{fstype} = "ext2"; - $r{fsos} = "linux"; - } elsif ($file =~ /ext3 filesystem data/) { - $r{fstype} = "ext3"; - $r{fsos} = "linux"; - } elsif ($file =~ /ext4 filesystem data/) { - $r{fstype} = "ext4"; - $r{fsos} = "linux"; - } elsif ($file =~ m{Linux/i386 swap file}) { - $r{fstype} = "swap"; - $r{fsos} = "linux"; - $r{is_swap} = 1; - } - - # If it's ext2/3/4, then we want the UUID and label. - if (exists $r{fstype} && $r{fstype} =~ /^ext/) { - $r{uuid} = $g->get_e2uuid ($dev); - $r{label} = $g->get_e2label ($dev); - } +my %fses = + inspect_all_partitions ($g, \@partitions, + use_windows_registry => $windows_registry); - # Try mounting it, fnarrr. - if (!$r{is_swap}) { - $r{is_mountable} = 1; - eval { $g->mount_ro ($dev, "/") }; - if ($@) { - # It's not mountable, probably empty or some format - # we don't understand. - $r{is_mountable} = 0; - goto OUT; - } +#print "fses -----------\n"; +#print Dumper(\%fses); - # Grub /boot? - if ($g->is_file ("/grub/menu.lst") || - $g->is_file ("/grub/grub.conf")) { - $r{content} = "linux-grub"; - check_grub (\%r); - goto OUT; - } - - # Linux root? - if ($g->is_dir ("/etc") && $g->is_dir ("/bin") && - $g->is_file ("/etc/fstab")) { - $r{content} = "linux-root"; - $r{is_root} = 1; - check_linux_root (\%r); - goto OUT; - } - - # Linux /usr/local. - if ($g->is_dir ("/etc") && $g->is_dir ("/bin") && - $g->is_dir ("/share") && !$g->exists ("/local") && - !$g->is_file ("/etc/fstab")) { - $r{content} = "linux-usrlocal"; - goto OUT; - } - - # Linux /usr. - if ($g->is_dir ("/etc") && $g->is_dir ("/bin") && - $g->is_dir ("/share") && $g->exists ("/local") && - !$g->is_file ("/etc/fstab")) { - $r{content} = "linux-usr"; - goto OUT; - } - - # Windows root? - if ($g->is_file ("/AUTOEXEC.BAT") || - $g->is_file ("/autoexec.bat") || - $g->is_dir ("/Program Files") || - $g->is_dir ("/WINDOWS") || - $g->is_file ("/boot.ini") || - $g->is_file ("/ntldr")) { - $r{fstype} = "ntfs"; # XXX this is a guess - $r{fsos} = "windows"; - $r{content} = "windows-root"; - $r{is_root} = 1; - check_windows_root (\%r); - goto OUT; - } - } - - OUT: - $g->umount_all (); - return \%r; -} - -sub check_linux_root -{ - local $_; - my $r = shift; - - # Look into /etc to see if we recognise the operating system. - if ($g->is_file ("/etc/redhat-release")) { - $_ = $g->cat ("/etc/redhat-release"); - if (/Fedora release (\d+\.\d+)/) { - $r->{osdistro} = "fedora"; - $r->{osversion} = "$1" - } elsif (/(Red Hat Enterprise Linux|CentOS|Scientific Linux).*release (\d+).*Update (\d+)/) { - $r->{osdistro} = "redhat"; - $r->{osversion} = "$2.$3"; - } elsif (/(Red Hat Enterprise Linux|CentOS|Scientific Linux).*release (\d+(?:\.(\d+))?)/) { - $r->{osdistro} = "redhat"; - $r->{osversion} = "$2"; - } else { - $r->{osdistro} = "redhat"; - } - } elsif ($g->is_file ("/etc/debian_version")) { - $_ = $g->cat ("/etc/debian_version"); - if (/(\d+\.\d+)/) { - $r->{osdistro} = "debian"; - $r->{osversion} = "$1"; - } else { - $r->{osdistro} = "debian"; - } - } - - # Parse the contents of /etc/fstab. This is pretty vital so - # we can determine where filesystems are supposed to be mounted. - eval "\$_ = \$g->cat ('/etc/fstab');"; - if (!$@ && $_) { - my @lines = split /\n/; - my @fstab; - foreach (@lines) { - my @fields = split /[ \t]+/; - if (@fields >= 2) { - my $spec = $fields[0]; # first column (dev/label/uuid) - my $file = $fields[1]; # second column (mountpoint) - if ($spec =~ m{^/} || - $spec =~ m{^LABEL=} || - $spec =~ m{^UUID=} || - $file eq "swap") { - push @fstab, [$spec, $file] - } - } - } - $r->{fstab} = \@fstab if @fstab; - } -} +my $oses = inspect_operating_systems ($g, \%fses); -# We only support NT. The control file /boot.ini contains a list of -# Windows installations and their %systemroot%s in a simple text -# format. -# -# XXX We could parse this better. This won't work if /boot.ini is on -# a different drive from the %systemroot%, and in other unusual cases. - -sub check_windows_root -{ - local $_; - my $r = shift; - - my $boot_ini = resolve_windows_path ("/", "boot.ini"); - $r->{boot_ini} = $boot_ini; - - if (defined $r->{boot_ini}) { - $_ = $g->cat ($boot_ini); - my @lines = split /\n/; - my $section; - my $systemroot; - foreach (@lines) { - if (m/\[.*\]/) { - $section = $1; - } elsif (m/^default=.*?\\(\w+)$/i) { - $systemroot = $1; - last; - } elsif (m/\\(\w+)=/) { - $systemroot = $1; - last; - } - } - - if (defined $systemroot) { - $r->{systemroot} = resolve_windows_path ("/", $systemroot); - if (defined $r->{systemroot} && $windows_registry) { - check_windows_registry ($r, $r->{systemroot}); - } - } - } -} - -sub check_windows_registry -{ - local $_; - my $r = shift; - my $systemroot = shift; - - # Download the system registry files. Only download the - # interesting ones, and we don't bother with user profiles at all. - my $system32 = resolve_windows_path ($systemroot, "system32"); - if (defined $system32) { - my $config = resolve_windows_path ($system32, "config"); - if (defined $config) { - my $software = resolve_windows_path ($config, "software"); - if (defined $software) { - load_windows_registry ($r, $software, - "HKEY_LOCAL_MACHINE\\SOFTWARE"); - } - my $system = resolve_windows_path ($config, "system"); - if (defined $system) { - load_windows_registry ($r, $system, - "HKEY_LOCAL_MACHINE\\System"); - } - } - } -} - -sub load_windows_registry -{ - local $_; - my $r = shift; - my $regfile = shift; - my $prefix = shift; - - my $dir = tempdir (CLEANUP => 1); - - $g->download ($regfile, "$dir/reg"); - - # 'reged' command is particularly noisy. Redirect stdout and - # stderr to /dev/null temporarily. - open SAVEOUT, ">&STDOUT"; - open SAVEERR, ">&STDERR"; - open STDOUT, ">/dev/null"; - open STDERR, ">/dev/null"; - - my @cmd = ("reged", "-x", "$dir/reg", "$prefix", "\\", "$dir/out"); - my $res = system (@cmd); - - close STDOUT; - close STDERR; - open STDOUT, ">&SAVEOUT"; - open STDERR, ">&SAVEERR"; - close SAVEOUT; - close SAVEERR; - - unless ($res == 0) { - warn "reged command failed: $?"; - return; - } - - # Some versions of reged segfault on inputs. If that happens we - # may get no / partial output file. Anyway, if it exists, load - # it. - my $content; - unless (open F, "$dir/out") { - warn "no output from reged command: $!"; - return; - } - { local $/ = undef; $content = ; } - close F; - - my @registry = (); - @registry = @{$r->{registry}} if exists $r->{registry}; - push @registry, $content; - $r->{registry} = \@registry; -} - -# Because of case sensitivity, the actual path might have a different -# name, and ntfs-3g is always case sensitive. Find out what the real -# path is. Returns the correct full path, or undef. -sub resolve_windows_path -{ - local $_; - my $parent = shift; # Must exist, with correct case. - my $dir = shift; - - foreach ($g->ls ($parent)) { - if (lc ($_) eq lc ($dir)) { - if ($parent eq "/") { - return "/$_" - } else { - return "$parent/$_" - } - } - } - - undef; -} - -sub check_grub -{ - local $_; - my $r = shift; - - # Grub version, if we care. -} - -#print Dumper (\%fses); - -#---------------------------------------------------------------------- -# Now find out how many operating systems we've got. Usually just one. - -my %oses = (); - -foreach (sort keys %fses) { - if ($fses{$_}->{is_root}) { - my %r = ( - root => $fses{$_}, - root_device => $_ - ); - get_os_version (\%r); - assign_mount_points (\%r); - $oses{$_} = \%r; - } -} +#print "oses -----------\n"; +#print Dumper($oses); -sub get_os_version -{ - local $_; - my $r = shift; - - $r->{os} = $r->{root}->{fsos} if exists $r->{root}->{fsos}; - $r->{distro} = $r->{root}->{osdistro} if exists $r->{root}->{osdistro}; - $r->{version} = $r->{root}->{osversion} if exists $r->{root}->{osversion}; -} - -sub assign_mount_points -{ - local $_; - my $r = shift; - - $r->{mounts} = { "/" => $r->{root_device} }; - $r->{filesystems} = { $r->{root_device} => $r->{root} }; - - # Use /etc/fstab if we have it to mount the rest. - if (exists $r->{root}->{fstab}) { - my @fstab = @{$r->{root}->{fstab}}; - foreach (@fstab) { - my ($spec, $file) = @$_; - - my ($dev, $fs) = find_filesystem ($spec); - if ($dev) { - $r->{mounts}->{$file} = $dev; - $r->{filesystems}->{$dev} = $fs; - if (exists $fs->{used}) { - $fs->{used}++ - } else { - $fs->{used} = 1 - } - } - } - } -} - -# Find filesystem by device name, LABEL=.. or UUID=.. -sub find_filesystem -{ - local $_ = shift; - - if (/^LABEL=(.*)/) { - my $label = $1; - foreach (sort keys %fses) { - if (exists $fses{$_}->{label} && - $fses{$_}->{label} eq $label) { - return ($_, $fses{$_}); - } - } - warn "unknown filesystem label $label\n"; - return (); - } elsif (/^UUID=(.*)/) { - my $uuid = $1; - foreach (sort keys %fses) { - if (exists $fses{$_}->{uuid} && - $fses{$_}->{uuid} eq $uuid) { - return ($_, $fses{$_}); - } - } - warn "unknown filesystem UUID $uuid\n"; - return (); - } else { - return ($_, $fses{$_}) if exists $fses{$_}; - - if (m{^/dev/hd(.*)} && exists $fses{"/dev/sd$1"}) { - return ("/dev/sd$1", $fses{"/dev/sd$1"}); - } - if (m{^/dev/xvd(.*)} && exists $fses{"/dev/sd$1"}) { - return ("/dev/sd$1", $fses{"/dev/sd$1"}); - } - - return () if m{/dev/cdrom}; - - warn "unknown filesystem $_\n"; - return (); - } -} - -#print Dumper(\%oses); - -#---------------------------------------------------------------------- # Mount up the disks so we can check for applications # and kernels. Skip this if the output is "*fish" because # 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}; - # Have to mount / first. Luckily '/' is early in the ASCII - # character set, so this should be OK. - foreach (sort keys %$mounts) { - $g->mount_ro ($mounts->{$_}, $_) - if $_ ne "swap" && ($_ eq '/' || $g->is_dir ($_)); - } - - check_for_applications ($root_dev); - check_for_kernels ($root_dev); - if ($oses{$root_dev}->{os} eq "linux") { - check_for_modprobe_aliases ($root_dev); - check_for_initrd ($root_dev, $dir); - } - + foreach $root_dev (sort keys %$oses) { + my $os = $oses->{$root_dev}; + mount_operating_system ($g, $os); + inspect_in_detail ($g, $os); $g->umount_all (); } } -sub check_for_applications -{ - local $_; - my $root_dev = shift; - - my @apps; - - my $os = $oses{$root_dev}->{os}; - if ($os eq "linux") { - my $distro = $oses{$root_dev}->{distro}; - if (defined $distro && ($distro eq "redhat" || $distro eq "fedora")) { - my @lines = $g->command_lines - (["rpm", - "-q", "-a", - "--qf", "%{name} %{epoch} %{version} %{release} %{arch}\n"]); - foreach (@lines) { - if (m/^(.*) (.*) (.*) (.*) (.*)$/) { - my $epoch = $2; - $epoch = "" if $epoch eq "(none)"; - my $app = { - name => $1, - epoch => $epoch, - version => $3, - release => $4, - arch => $5 - }; - push @apps, $app - } - } - } - } elsif ($os eq "windows") { - # XXX - # I worked out a general plan for this, but haven't - # implemented it yet. We can iterate over /Program Files - # looking for *.EXE files, which we download, then use - # i686-pc-mingw32-windres on, to find the VERSIONINFO - # section, which has a lot of useful information. - } - - $oses{$root_dev}->{apps} = \@apps; -} - -sub check_for_kernels -{ - local $_; - my $root_dev = shift; - - my @kernels; - - my $os = $oses{$root_dev}->{os}; - if ($os eq "linux") { - # Installed kernels will have a corresponding /lib/modules/ - # directory, which is the easiest way to find out what kernels - # are installed, and what modules are available. - foreach ($g->ls ("/lib/modules")) { - if ($g->is_dir ("/lib/modules/$_")) { - my %kernel; - $kernel{version} = $_; - - # List modules. - my @modules; - foreach ($g->find ("/lib/modules/$_")) { - if (m,/([^/]+)\.ko$, || m,([^/]+)\.o$,) { - push @modules, $1; - } - } - - $kernel{modules} = \@modules; - - push @kernels, \%kernel; - } - } - - } elsif ($os eq "windows") { - # XXX - } - - $oses{$root_dev}->{kernels} = \@kernels; -} - -# Check /etc/modprobe.conf to see if there are any specified -# drivers associated with network (ethX) or hard drives. Normally -# one might find something like: -# -# alias eth0 xennet -# alias scsi_hostadapter xenblk -# -# XXX This doesn't look beyond /etc/modprobe.conf, eg. in /etc/modprobe.d/ - -sub check_for_modprobe_aliases -{ - local $_; - my $root_dev = shift; - - # 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; - - 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; -} - -# Get a listing of device drivers in any initrd corresponding to a -# kernel. This is an indication of what can possibly be booted. - -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"; - } - } - } - - $oses{$root_dev}->{initrd_modules} = \%initrd_modules; -} - #---------------------------------------------------------------------- # Output. if ($output eq "fish" || $output eq "ro-fish") { - my @osdevs = keys %oses; + my @osdevs = keys %$oses; # This only works if there is a single OS. die "--fish output is only possible with a single OS\n" if @osdevs != 1; @@ -955,9 +300,9 @@ if ($output eq "fish" || $output eq "ro-fish") { print "--ro "; } - print "-a $_ " foreach @images; + print "-a $_ " foreach @ARGV; - my $mounts = $oses{$root_dev}->{mounts}; + my $mounts = $oses->{$root_dev}->{mounts}; # Have to mount / first. Luckily '/' is early in the ASCII # character set, so this should be OK. foreach (sort keys %$mounts) { @@ -968,15 +313,15 @@ if ($output eq "fish" || $output eq "ro-fish") { # Perl output. elsif ($output eq "perl") { - print Dumper(\%oses); + 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); + + print Dump(%$oses); } # Plain text output (the default). @@ -996,7 +341,7 @@ elsif ($output eq "query") { sub output_text { - output_text_os ($oses{$_}) foreach sort keys %oses; + output_text_os ($oses->{$_}) foreach sort keys %$oses; } sub output_text_os @@ -1034,7 +379,7 @@ sub output_text_os if (@keys) { print " Modprobe aliases:\n"; foreach (@keys) { - printf " %-30s %s\n", $_, $aliases{$_} + printf " %-30s %s\n", $_, $aliases{$_}->{modulename} } } } @@ -1082,7 +427,7 @@ sub output_xml my $xml = new XML::Writer(DATA_MODE => 1, DATA_INDENT => 2); $xml->startTag("operatingsystems"); - output_xml_os ($oses{$_}, $xml) foreach sort keys %oses; + output_xml_os ($oses->{$_}, $xml) foreach sort keys %$oses; $xml->endTag("operatingsystems"); $xml->end(); @@ -1116,7 +461,8 @@ sub output_xml_os 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]}; } @@ -1131,7 +477,15 @@ sub output_xml_os 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"); } @@ -1236,8 +590,8 @@ Answer C if Microsoft Windows is installed in the guest. sub output_query_windows { my $windows = "no"; - foreach my $os (keys %oses) { - $windows="yes" if $oses{$os}->{os} eq "windows"; + foreach my $os (keys %$oses) { + $windows="yes" if $oses->{$os}->{os} eq "windows"; } print "windows=$windows\n"; } @@ -1251,8 +605,8 @@ Answer C if a Linux kernel is installed in the guest. sub output_query_linux { my $linux = "no"; - foreach my $os (keys %oses) { - $linux="yes" if $oses{$os}->{os} eq "linux"; + foreach my $os (keys %$oses) { + $linux="yes" if $oses->{$os}->{os} eq "linux"; } print "linux=$linux\n"; } @@ -1266,8 +620,8 @@ Answer C if the guest contains Red Hat Enterprise Linux. sub output_query_rhel { my $rhel = "no"; - foreach my $os (keys %oses) { - $rhel="yes" if $oses{$os}->{os} eq "linux" && $oses{$os}->{distro} eq "redhat"; + foreach my $os (keys %$oses) { + $rhel="yes" if $oses->{$os}->{os} eq "linux" && $oses->{$os}->{distro} eq "redhat"; } print "rhel=$rhel\n"; } @@ -1281,8 +635,8 @@ Answer C if the guest contains the Fedora Linux distribution. sub output_query_fedora { my $fedora = "no"; - foreach my $os (keys %oses) { - $fedora="yes" if $oses{$os}->{os} eq "linux" && $oses{$os}->{distro} eq "fedora"; + foreach my $os (keys %$oses) { + $fedora="yes" if $oses->{$os}->{os} eq "linux" && $oses->{$os}->{distro} eq "fedora"; } print "fedora=$fedora\n"; } @@ -1296,8 +650,8 @@ Answer C if the guest contains the Debian Linux distribution. sub output_query_debian { my $debian = "no"; - foreach my $os (keys %oses) { - $debian="yes" if $oses{$os}->{os} eq "linux" && $oses{$os}->{distro} eq "debian"; + foreach my $os (keys %$oses) { + $debian="yes" if $oses->{$os}->{os} eq "linux" && $oses->{$os}->{distro} eq "debian"; } print "debian=$debian\n"; } @@ -1315,8 +669,8 @@ sub output_query_fullvirt # The assumption is full-virt, unless all installed kernels # are identified as paravirt. # XXX Fails on Windows guests. - foreach my $os (keys %oses) { - foreach my $kernel (@{$oses{$os}->{kernels}}) { + foreach my $os (keys %$oses) { + foreach my $kernel (@{$oses->{$os}->{kernels}}) { my $is_pv = $kernel->{version} =~ m/xen/; unless ($is_pv) { print "fullvirt=yes\n"; @@ -1337,8 +691,8 @@ guest). sub output_query_xen_domU_kernel { - foreach my $os (keys %oses) { - foreach my $kernel (@{$oses{$os}->{kernels}}) { + foreach my $os (keys %$oses) { + foreach my $kernel (@{$oses->{$os}->{kernels}}) { my $is_xen = $kernel->{version} =~ m/xen/; if ($is_xen) { print "xen_domU_kernel=yes\n"; @@ -1360,8 +714,8 @@ reasons). sub output_query_xen_pv_drivers { - foreach my $os (keys %oses) { - foreach my $kernel (@{$oses{$os}->{kernels}}) { + foreach my $os (keys %$oses) { + foreach my $kernel (@{$oses->{$os}->{kernels}}) { foreach my $module (@{$kernel->{modules}}) { if ($module =~ m/xen-/) { print "xen_pv_drivers=yes\n"; @@ -1383,8 +737,8 @@ performance of KVM. sub output_query_virtio_drivers { - foreach my $os (keys %oses) { - foreach my $kernel (@{$oses{$os}->{kernels}}) { + foreach my $os (keys %$oses) { + foreach my $kernel (@{$oses->{$os}->{kernels}}) { foreach my $module (@{$kernel->{modules}}) { if ($module =~ m/virtio_/) { print "virtio_drivers=yes\n"; @@ -1403,6 +757,7 @@ sub output_query_virtio_drivers L, L, L, +L, L, L.