Cleanup whitespace warnings in Lib.pm
[libguestfs.git] / perl / lib / Sys / Guestfs / Lib.pm
index 1e5638e..8e20593 100644 (file)
@@ -381,6 +381,8 @@ sub _elf_arch_to_canonical
        return "i486";  # probably not in the wild
     } elsif ($_ eq "x86-64") {
        return "x86_64";
+    } elsif ($_ eq "AMD x86-64") {
+       return "x86_64";
     } elsif (/SPARC32/) {
        return "sparc";
     } elsif (/SPARC V9/) {
@@ -433,16 +435,14 @@ sub file_architecture
        $g->download ($path, "$dir/initrd");
 
        my $bins = join " ", map { "bin/$_" } @_initrd_binaries;
-       my $cmd = "cd $dir && $zcat initrd | cpio -id $bins";
+       my $cmd = "cd $dir && $zcat initrd | cpio --quiet -id $bins";
        my $r = system ($cmd);
        die __x("cpio command failed: {error}", error => $?)
            unless $r == 0;
 
        foreach my $bin (@_initrd_binaries) {
            if (-f "$dir/bin/$bin") {
-               open PIPE, "file $dir/bin/$bin |";
-               local $/ = undef;
-               $_ = <PIPE>;
+               $_ = `file $dir/bin/$bin`;
                if (/ELF.*executable, (.+?),/) {
                    return _elf_arch_to_canonical ($1);
                }
@@ -506,7 +506,7 @@ described in more detail below, but at the top level looks like:
    '/dev/VG/Root1' => \%os1,
    '/dev/VG/Root2' => \%os2,
  }
+
  %os1 = {
    os => 'linux',
    mounts => {
@@ -792,7 +792,7 @@ sub _check_linux_root
            $r->{os_minor_version} = "$2" if(defined($2));
            $r->{package_management} = "yum";
        }
-        
+
         elsif (/(Red Hat Enterprise Linux|CentOS|Scientific Linux)/) {
             my $distro = $1;
 
@@ -1051,7 +1051,7 @@ like:
  %oses = {
    '/dev/VG/Root' => \%os,
  }
+
 (There can be multiple roots for a multi-boot VM).
 
 The C<\%os> hash contains the following keys (any can be omitted):
@@ -1296,6 +1296,44 @@ finds.  These extra keys are:
 
 List of applications.
 
+=item boot
+
+Boot configurations. A hash containing:
+
+=over 4
+
+=item configs
+
+An array of boot configurations. Each array entry is a hash containing:
+
+=over 4
+
+=item initrd
+
+A reference to the expanded initrd structure (see below) for the initrd used by
+this boot configuration.
+
+=item kernel
+
+A reference to the expanded kernel structure (see below) for the kernel used by
+this boot configuration.
+
+=item title
+
+The human readable name of the configuration.
+
+=item cmdline
+
+The kernel command line.
+
+=back
+
+=item default
+
+The index of the default configuration in the configs array
+
+=back
+
 =item kernels
 
 List of kernels.
@@ -1316,6 +1354,14 @@ Kernel architecture (eg. C<x86-64>).
 
 List of modules.
 
+=item path
+
+The path to the kernel's vmlinuz file.
+
+=item package
+
+If the kernel was installed in a package, the name of that package.
+
 =back
 
 =item modprobe_aliases
@@ -1342,8 +1388,7 @@ sub inspect_in_detail
     _check_for_applications ($g, $os);
     _check_for_kernels ($g, $os);
     if ($os->{os} eq "linux") {
-       _check_for_modprobe_aliases ($g, $os);
-       _check_for_initrd ($g, $os);
+       _find_modprobe_aliases ($g, $os);
     }
 }
 
@@ -1392,88 +1437,211 @@ sub _check_for_applications
 
 sub _check_for_kernels
 {
-    local $_;
-    my $g = shift;
-    my $os = shift;
+    my ($g, $os) = @_;
 
-    my @kernels;
+    if ($os->{os} eq "linux") {
+        # Iterate over entries in grub.conf, populating $os->{boot}
+        # For every kernel we find, inspect it and add to $os->{kernels}
+
+        my @boot_configs;
+
+        # We want
+        #  $os->{boot}
+        #       ->{configs}
+        #         ->[0]
+        #           ->{title}   = "Fedora (2.6.29.6-213.fc11.i686.PAE)"
+        #           ->{kernel}  = \kernel
+        #           ->{cmdline} = "ro root=/dev/mapper/vg_mbooth-lv_root rhgb"
+        #           ->{initrd}  = \initrd
+        #       ->{default} = \config
+        # Initialise augeas
+        $g->aug_init("/", 16);
+
+        my @configs = ();
+        # Get all configurations from grub
+        foreach my $bootable
+            ($g->aug_match("/files/etc/grub.conf/title"))
+        {
+            my %config = ();
+            $config{title} = $g->aug_get($bootable);
+
+            my $grub_kernel;
+            eval { $grub_kernel = $g->aug_get("$bootable/kernel"); };
+            if($@) {
+                warn __x("Grub entry {title} has no kernel",
+                         title => $config{title});
+            }
 
-    my $osn = $os->{os};
-    if ($osn 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;
-               my $any_module;
-               my $prefix = "/lib/modules/$_";
-               foreach ($g->find ($prefix)) {
-                   if (m,/([^/]+)\.ko$, || m,([^/]+)\.o$,) {
-                       $any_module = "$prefix$_" unless defined $any_module;
-                       push @modules, $1;
-                   }
-               }
+            # Check we've got a kernel entry
+            if(defined($grub_kernel)) {
+                my $path = "/boot$grub_kernel";
+
+                # Reconstruct the kernel command line
+                my @args = ();
+                foreach my $arg ($g->aug_match("$bootable/kernel/*")) {
+                    $arg =~ m{/kernel/([^/]*)$}
+                        or die("Unexpected return from aug_match: $arg");
+
+                    my $name = $1;
+                    my $value;
+                    eval { $value = $g->aug_get($arg); };
+
+                    if(defined($value)) {
+                        push(@args, "$name=$value");
+                    } else {
+                        push(@args, $name);
+                    }
+                }
+                $config{cmdline} = join(' ', @args) if(scalar(@args) > 0);
+
+                my $kernel = _inspect_linux_kernel($g, $os, "$path");
+
+                # Check the kernel was recognised
+                if(defined($kernel)) {
+                    $config{kernel} = $kernel;
+
+                    # Look for an initrd entry
+                    my $initrd;
+                    eval {
+                        $initrd = $g->aug_get("$bootable/initrd");
+                    };
+
+                    unless($@) {
+                        $config{initrd} =
+                            _inspect_initrd($g, $os, "/boot$initrd",
+                                            $kernel->{version});
+                    } else {
+                        warn __x("Grub entry {title} does not specify an ".
+                                 "initrd", title => $config{title});
+                    }
+                }
+            }
 
-               $kernel{modules} = \@modules;
+            push(@configs, \%config);
+        }
 
-               # Determine kernel architecture by looking at the arch
-               # of any kernel module.
-               $kernel{arch} = file_architecture ($g, $any_module);
 
-               push @kernels, \%kernel;
-           }
-       }
+        # Create the top level boot entry
+        my %boot;
+        $boot{configs} = \@configs;
 
-    } elsif ($osn eq "windows") {
+        # Add the default configuration
+        eval {
+            $boot{default} = $g->aug_get("/files/etc/grub.conf/default");
+        };
+        if($@) {
+            warn __"No grub default specified";
+        }
+
+        $os->{boot} = \%boot;
+    }
+
+    elsif ($os->{os} eq "windows") {
        # XXX
     }
+}
+
+sub _inspect_linux_kernel
+{
+    my ($g, $os, $path) = @_;
+
+    my %kernel = ();
+
+    $kernel{path} = $path;
+
+    # If this is a packaged kernel, try to work out the name of the package
+    # which installed it. This lets us know what to install to replace it with,
+    # e.g. kernel, kernel-smp, kernel-hugemem, kernel-PAE
+    if($os->{package_format} eq "rpm") {
+        my $package;
+        eval { $package = $g->command(['rpm', '-qf', '--qf',
+                                       '%{NAME}', $path]); };
+        $kernel{package} = $package if defined($package);;
+    }
+
+    # Try to get the kernel version by running file against it
+    my $version;
+    my $filedesc = $g->file($path);
+    if($filedesc =~ /^$path: Linux kernel .*\bversion\s+(\S+)\b/) {
+        $version = $1;
+    }
+
+    # Sometimes file can't work out the kernel version, for example because it's
+    # a Xen PV kernel. In this case try to guess the version from the filename
+    else {
+        if($path =~ m{/boot/vmlinuz-(.*)}) {
+            $version = $1;
+
+            # Check /lib/modules/$version exists
+            if(!$g->is_dir("/lib/modules/$version")) {
+                warn __x("Didn't find modules directory {modules} for kernel ".
+                         "{path}", modules => "/lib/modules/$version",
+                         path => $path);
+
+                # Give up
+                return undef;
+            }
+        } else {
+            warn __x("Couldn't guess kernel version number from path for ".
+                     "kernel {path}", path => $path);
+
+            # Give up
+            return undef;
+        }
+    }
+
+    $kernel{version} = $version;
+
+    # List modules.
+    my @modules;
+    my $any_module;
+    my $prefix = "/lib/modules/$version";
+    foreach my $module ($g->find ($prefix)) {
+        if ($module =~ m{/([^/]+)\.(?:ko|o)$}) {
+            $any_module = "$prefix$module" unless defined $any_module;
+            push @modules, $1;
+        }
+    }
+
+    $kernel{modules} = \@modules;
+
+    # Determine kernel architecture by looking at the arch
+    # of any kernel module.
+    $kernel{arch} = file_architecture ($g, $any_module);
+
+    # Put this kernel on the top level kernel list
+    my $kernels = $os->{kernels};
+    if(!defined($kernels)) {
+        $kernels = [];
+        $os->{kernels} = $kernels;
+    }
+    push(@$kernels, \%kernel);
 
-    $os->{kernels} = \@kernels;
+    return \%kernel;
 }
 
-# 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/
+# Find all modprobe aliases. Specifically, this looks in the following
+# locations:
+#  * /etc/conf.modules
+#  * /etc/modules.conf
+#  * /etc/modprobe.conf
+#  * /etc/modprobe.d/*
 
-sub _check_for_modprobe_aliases
+sub _find_modprobe_aliases
 {
     local $_;
     my $g = shift;
     my $os = 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);
-    }
+    $g->aug_init("/", 16);
 
-    $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");
+    # Register additional paths to the Modprobe lens
+    $g->aug_set("/augeas/load/Modprobe/incl[last()+1]", "/etc/modules.conf");
+    $g->aug_set("/augeas/load/Modprobe/incl[last()+1]", "/etc/conf.modules");
 
     # Make augeas reload
-    $success = $g->aug_load();
+    $g->aug_load();
 
     my %modprobe_aliases;
 
@@ -1481,9 +1649,7 @@ sub _check_for_modprobe_aliases
                        /files/etc/modules.conf/alias
                        /files/etc/modprobe.conf/alias
                        /files/etc/modprobe.d/*/alias) {
-        @results = $g->aug_match($pattern);
-
-        for my $path ( @results ) {
+        for my $path ( $g->aug_match($pattern) ) {
             $path =~ m{^/files(.*)/alias(?:\[\d*\])?$}
                 or die __x("{path} doesn't match augeas pattern",
                           path => $path);
@@ -1507,44 +1673,39 @@ sub _check_for_modprobe_aliases
     $os->{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
+# Get a listing of device drivers from an initrd
+sub _inspect_initrd
 {
-    local $_;
-    my $g = shift;
-    my $os = shift;
+    my ($g, $os, $path, $version) = @_;
+
+    my @modules;
+
+    # Disregard old-style compressed ext2 files and only work with real
+    # compressed cpio files, since cpio takes ages to (fail to) process anything
+    # else.
+    if ($g->file ($path) =~ /cpio/) {
+        eval {
+            @modules = $g->initrd_list ($path);
+        };
+        unless ($@) {
+            @modules = grep { m{([^/]+)\.(?:ko|o)$} } @modules;
+        } else {
+            warn __x("{filename}: could not read initrd format",
+                     filename => "$path");
+        }
+    }
 
-    my %initrd_modules;
-
-    foreach my $initrd ($g->ls ("/boot")) {
-       if ($initrd =~ m/^initrd-(.*)\.img$/ && $g->is_file ("/boot/$initrd")) {
-           my $version = $1;
-           my @modules;
-
-           # Disregard old-style compressed ext2 files and only
-           # work with real compressed cpio files, since cpio
-           # takes ages to (fail to) process anything else.
-           if ($g->file ("/boot/$initrd") =~ /cpio/) {
-               eval {
-                   @modules = $g->initrd_list ("/boot/$initrd");
-               };
-               unless ($@) {
-                   @modules = grep { m,([^/]+)\.ko$, || m,([^/]+)\.o$, }
-                   @modules;
-                   $initrd_modules{$version} = \@modules
-               } else {
-                   warn __x("{filename}: could not read initrd format",
-                            filename => "/boot/$initrd");
-               }
-           }
-       }
+    # Add to the top level initrd_modules entry
+    my $initrd_modules = $os->{initrd_modules};
+    if(!defined($initrd_modules)) {
+        $initrd_modules = {};
+        $os->{initrd_modules} = $initrd_modules;
     }
 
-    $os->{initrd_modules} = \%initrd_modules;
-}
+    $initrd_modules->{$version} = \@modules;
 
+    return \@modules;
+}
 
 1;