On RHEL 5, 'file' command prints 'AMD x86-64' for 'x86-64' arch.
[libguestfs.git] / perl / lib / Sys / Guestfs / Lib.pm
index 00a9bdb..be17a30 100644 (file)
@@ -300,6 +300,163 @@ sub resolve_windows_path
     return $path;
 }
 
+=head2 file_architecture
+
+ $arch = file_architecture ($g, $path)
+
+The C<file_architecture> function lets you get the architecture for a
+particular binary or library in the guest.  By "architecture" we mean
+what processor it is compiled for (eg. C<i586> or C<x86_64>).
+
+The function works on at least the following types of files:
+
+=over 4
+
+=item *
+
+many types of Un*x binary
+
+=item *
+
+many types of Un*x shared library
+
+=item *
+
+Windows Win32 and Win64 binaries
+
+=item *
+
+Windows Win32 and Win64 DLLs
+
+Win32 binaries and DLLs return C<i386>.
+
+Win64 binaries and DLLs return C<x86_64>.
+
+=item *
+
+Linux kernel modules
+
+=item *
+
+Linux new-style initrd images
+
+=item *
+
+some non-x86 Linux vmlinuz kernels
+
+=back
+
+What it can't do currently:
+
+=over 4
+
+=item *
+
+static libraries (libfoo.a)
+
+=item *
+
+Linux old-style initrd as compressed ext2 filesystem (RHEL 3)
+
+=item *
+
+x86 Linux vmlinuz kernels
+
+x86 vmlinuz images (bzImage format) consist of a mix of 16-, 32- and
+compressed code, and are horribly hard to unpack.  If you want to find
+the architecture of a kernel, use the architecture of the associated
+initrd or kernel module(s) instead.
+
+=back
+
+=cut
+
+sub _elf_arch_to_canonical
+{
+    local $_ = shift;
+
+    if ($_ eq "Intel 80386") {
+       return "i386";
+    } elsif ($_ eq "Intel 80486") {
+       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/) {
+       return "sparc64";
+    } elsif ($_ eq "IA-64") {
+       return "ia64";
+    } elsif (/64.*PowerPC/) {
+       return "ppc64";
+    } elsif (/PowerPC/) {
+       return "ppc";
+    } else {
+       warn __x("returning non-canonical architecture type '{arch}'",
+                arch => $_);
+       return $_;
+    }
+}
+
+my @_initrd_binaries = ("nash", "modprobe", "sh", "bash");
+
+sub file_architecture
+{
+    local $_;
+    my $g = shift;
+    my $path = shift;
+
+    # Our basic tool is 'file' ...
+    my $file = $g->file ($path);
+
+    if ($file =~ /ELF.*(?:executable|shared object|relocatable), (.+?),/) {
+       # ELF executable or shared object.  We need to convert
+       # what file(1) prints into the canonical form.
+       return _elf_arch_to_canonical ($1);
+    } elsif ($file =~ /PE32 executable/) {
+       return "i386";          # Win32 executable or DLL
+    } elsif ($file =~ /PE32\+ executable/) {
+       return "x86_64";        # Win64 executable or DLL
+    }
+
+    elsif ($file =~ /cpio archive/) {
+       # Probably an initrd.
+       my $zcat = "cat";
+       if ($file =~ /gzip/) {
+           $zcat = "zcat";
+       } elsif ($file =~ /bzip2/) {
+           $zcat = "bzcat";
+       }
+
+       # Download and unpack it to find a binary file.
+       my $dir = tempdir (CLEANUP => 1);
+       $g->download ($path, "$dir/initrd");
+
+       my $bins = join " ", map { "bin/$_" } @_initrd_binaries;
+       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") {
+               $_ = `file $dir/bin/$bin`;
+               if (/ELF.*executable, (.+?),/) {
+                   return _elf_arch_to_canonical ($1);
+               }
+           }
+       }
+
+       die __x("file_architecture: no known binaries found in initrd image: {path}",
+               path => $path);
+    }
+
+    die __x("file_architecture: unknown architecture: {path}",
+           path => $path);
+}
+
 =head1 OPERATING SYSTEM INSPECTION FUNCTIONS
 
 The functions in this section can be used to inspect the operating
@@ -719,6 +876,17 @@ sub _check_linux_root
        }
        $r->{fstab} = \@fstab if @fstab;
     }
+
+    # Determine the architecture of this root.
+    my $arch;
+    foreach ("/bin/bash", "/bin/ls", "/bin/echo", "/bin/rm", "/bin/sh") {
+       if ($g->is_file ($_)) {
+           $arch = file_architecture ($g, $_);
+           last;
+       }
+    }
+
+    $r->{arch} = $arch if defined $arch;
 }
 
 # We only support NT.  The control file /boot.ini contains a list of
@@ -757,13 +925,30 @@ sub _check_windows_root
 
        if (defined $systemroot) {
            $r->{systemroot} = resolve_windows_path ($g, "/$systemroot");
-           if (defined $r->{systemroot} && $use_windows_registry) {
-               _check_windows_registry ($g, $r, $r->{systemroot});
+           if (defined $r->{systemroot}) {
+               _check_windows_arch ($g, $r, $r->{systemroot});
+               if ($use_windows_registry) {
+                   _check_windows_registry ($g, $r, $r->{systemroot});
+               }
            }
        }
     }
 }
 
+# Find Windows userspace arch.
+
+sub _check_windows_arch
+{
+    local $_;
+    my $g = shift;
+    my $r = shift;
+    my $systemroot = shift;
+
+    my $cmd_exe =
+       resolve_windows_path ($g, $r->{systemroot} . "/system32/cmd.exe");
+    $r->{arch} = file_architecture ($g, $cmd_exe) if $cmd_exe;
+}
+
 sub _check_windows_registry
 {
     local $_;
@@ -877,6 +1062,10 @@ The C<\%os> hash contains the following keys (any can be omitted):
 
 Operating system type, eg. "linux", "windows".
 
+=item arch
+
+Operating system userspace architecture, eg. "i386", "x86_64".
+
 =item distro
 
 Operating system distribution, eg. "debian".
@@ -961,6 +1150,7 @@ sub _get_os_version
         if exists $r->{root}->{package_format};
     $r->{package_management} = $r->{root}->{package_management}
         if exists $r->{root}->{package_management};
+    $r->{arch} = $r->{root}->{arch} if exists $r->{root}->{arch};
 }
 
 sub _assign_mount_points
@@ -1049,13 +1239,14 @@ sub _find_filesystem
 
 =head2 mount_operating_system
 
- mount_operating_system ($g, \%os);
+ mount_operating_system ($g, \%os, [$ro]);
 
 This function mounts the operating system described in the
 C<%os> hash according to the C<mounts> table in that hash (see
 C<inspect_operating_systems>).
 
-The partitions are mounted read-only.
+The partitions are mounted read-only unless the third parameter
+is specified as zero explicitly.
 
 To reverse the effect of this call, use the standard
 libguestfs API call C<$g-E<gt>umount_all ()>.
@@ -1067,9 +1258,9 @@ sub mount_operating_system
     local $_;
     my $g = shift;
     my $os = shift;
-    my $ro = shift; # Read-only?
+    my $ro = shift;            # Read-only?
 
-    $ro = 1 unless(defined($ro)); # ro defaults to 1 if unspecified
+    $ro = 1 unless defined $ro; # ro defaults to 1 if unspecified
 
     my $mounts = $os->{mounts};
 
@@ -1093,8 +1284,8 @@ sub mount_operating_system
  $g->umount_all ();
 
 The C<inspect_in_detail> function inspects the mounted operating
-system for installed applications, installed kernels, kernel modules
-and more.
+system for installed applications, installed kernels, kernel modules,
+system architecture, and more.
 
 It adds extra keys to the existing C<%os> hash reflecting what it
 finds.  These extra keys are:
@@ -1109,6 +1300,24 @@ List of applications.
 
 List of kernels.
 
+This is a hash of kernel version =E<gt> a hash with the following keys:
+
+=over 4
+
+=item version
+
+Kernel version.
+
+=item arch
+
+Kernel architecture (eg. C<x86-64>).
+
+=item modules
+
+List of modules.
+
+=back
+
 =item modprobe_aliases
 
 (For Linux VMs).
@@ -1201,14 +1410,21 @@ sub _check_for_kernels
 
                # List modules.
                my @modules;
-               foreach ($g->find ("/lib/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;
                    }
                }
 
                $kernel{modules} = \@modules;
 
+               # Determine kernel architecture by looking at the arch
+               # of any kernel module.
+               $kernel{arch} = file_architecture ($g, $any_module);
+
                push @kernels, \%kernel;
            }
        }
@@ -1307,10 +1523,10 @@ sub _check_for_initrd
            my $version = $1;
            my @modules;
 
-           # Disregard old-style compressed ext2 files, since cpio
-           # takes ages to (fail to) process these.
-           if ($g->file ("/boot/$initrd") !~ /gzip compressed/ ||
-               $g->zfile ("gzip", "/boot/$initrd") !~ /ext2 filesystem/) {
+           # 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");
                };