X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=inspector%2Fvirt-inspector.pl;h=5f8c8928725259bc8ef03be352691f3c6548545f;hp=66b1553e5d583d3b2442b6ef6f92c9bb081259b4;hb=2105fabddfdcecca68e20285808b4d8bbe133227;hpb=128f822e16bb96677c75b88125e18f48d7ccedaf diff --git a/inspector/virt-inspector.pl b/inspector/virt-inspector.pl index 66b1553..5f8c892 100755 --- a/inspector/virt-inspector.pl +++ b/inspector/virt-inspector.pl @@ -20,16 +20,15 @@ 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; -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 @@ -102,18 +101,6 @@ then libvirt is not used at all. =cut -my $force; - -=item B<--force> - -Force reading a particular guest even if it appears to be active. In -earlier versions of virt-inspector, this could be dangerous (for -example, corrupting the guest's disk image). However in more recent -versions, it should not cause corruption, but might cause -virt-inspector to crash or produce incorrect results. - -=cut - my $output = "text"; =back @@ -186,7 +173,6 @@ default. GetOptions ("help|?" => \$help, "connect|c=s" => \$uri, - "force" => \$force, "text" => sub { $output = "text" }, "none" => sub { $output = "none" }, "xml" => sub { $output = "xml" }, @@ -202,79 +188,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,627 +243,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; - } +my %fses = + inspect_all_partitions ($g, \@partitions, + use_windows_registry => $windows_registry); - # 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); - } +#print "fses -----------\n"; +#print Dumper(\%fses); - # 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; - } - - # 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"; - } - } +my $oses = inspect_operating_systems ($g, \%fses); - # 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; - } -} - -# 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 "oses -----------\n"; +#print Dumper($oses); -#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; - } -} - -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 - } - $fs->{spec} = $spec; - } - } - } -} - -# 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{$_}; - - # 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"}); - } - 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$/) { 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); - } - + 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 ) { - $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'); - - my %aliasinfo; - $aliasinfo{modulename} = $modulename; - $aliasinfo{augeas} = $path; - $aliasinfo{file} = $file; - - $modprobe_aliases{$alias} = \%aliasinfo; - } - } - - $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 %initrd_modules; - - foreach my $initrd ($g->ls ("/boot")) { - if ($initrd =~ m/^initrd-(.*)\.img$/ && $g->is_file ("/boot/$initrd")) { - my $version = $1; - 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" - } - } - } - - $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; @@ -948,9 +286,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) { @@ -961,15 +299,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). @@ -989,7 +327,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 @@ -1075,7 +413,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(); @@ -1238,8 +576,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"; } @@ -1253,8 +591,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"; } @@ -1268,8 +606,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"; } @@ -1283,8 +621,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"; } @@ -1298,8 +636,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"; } @@ -1317,8 +655,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"; @@ -1339,8 +677,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"; @@ -1362,8 +700,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"; @@ -1385,8 +723,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"; @@ -1405,6 +743,7 @@ sub output_query_virtio_drivers L, L, L, +L, L, L.