-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/<version>
- # 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 = <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";
- }
- }
- }
-
- $oses{$root_dev}->{initrd_modules} = \%initrd_modules;
-}
-