check_for_applications ($root_dev);
check_for_kernels ($root_dev);
- # umount_all in libguestfs is buggy - it doesn't unmount
- # filesystems in the correct order. So let's unmount them
- # in reverse first before calling umount_all as a last resort.
- foreach (sort { $b cmp $a } keys %$mounts) {
- eval "\$g->umount ('$_')";
- }
$g->umount_all ();
}
}
local $_;
my $root_dev = shift;
- # XXX rpm -qa, look in Program Files, or whatever
+ my @apps;
+
+ my $os = $oses{$root_dev}->{os};
+ if ($os eq "linux") {
+ my $distro = $oses{$root_dev}->{distro};
+ if ($distro eq "redhat") {
+ 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
if exists $filesystems->{$_}{content};
}
- # XXX Applications.
+ print " Applications:\n";
+ my @apps = @{$os->{apps}};
+ foreach (@apps) {
+ print " $_->{name} $_->{version}\n"
+ }
+
# XXX Kernel.
}
}
print "</filesystems>\n";
- # XXX Applications.
+ print "<applications>\n";
+ my @apps = @{$os->{apps}};
+ foreach (@apps) {
+ print "<application>\n";
+ print "<name>$_->{name}</name><version>$_->{version}</version>\n";
+ print "</application>\n";
+ }
+ print "</applications>\n";
+
# XXX Kernel.
+
print "</operatingsystem>\n";
}