diff options
Diffstat (limited to 'perl')
| -rw-r--r-- | perl/lib/Sys/Guestfs/Lib.pm | 161 | ||||
| -rw-r--r-- | perl/t/500-lib-load.t | 26 | ||||
| -rw-r--r-- | perl/t/510-lib-file-arch.t | 62 |
3 files changed, 247 insertions, 2 deletions
diff --git a/perl/lib/Sys/Guestfs/Lib.pm b/perl/lib/Sys/Guestfs/Lib.pm index bc8be9db..081b4b9b 100644 --- a/perl/lib/Sys/Guestfs/Lib.pm +++ b/perl/lib/Sys/Guestfs/Lib.pm @@ -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 (/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 -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>; + 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 @@ -1094,8 +1251,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: diff --git a/perl/t/500-lib-load.t b/perl/t/500-lib-load.t new file mode 100644 index 00000000..14071695 --- /dev/null +++ b/perl/t/500-lib-load.t @@ -0,0 +1,26 @@ +# libguestfs Perl bindings -*- perl -*- +# Copyright (C) 2009 Red Hat Inc. +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +use strict; +use warnings; +use Test::More tests => 1; + +use Sys::Guestfs; +use Sys::Guestfs::Lib; + +# Just check Lib can be loaded. +ok (1); diff --git a/perl/t/510-lib-file-arch.t b/perl/t/510-lib-file-arch.t new file mode 100644 index 00000000..14392e89 --- /dev/null +++ b/perl/t/510-lib-file-arch.t @@ -0,0 +1,62 @@ +# libguestfs Perl bindings -*- perl -*- +# Copyright (C) 2009 Red Hat Inc. +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +use strict; +use warnings; +use Test::More tests => 17; + +use Sys::Guestfs; +use Sys::Guestfs::Lib; + +my $h = Sys::Guestfs->new (); +ok ($h); + +$h->add_drive_ro ("../images/test.sqsh"); +ok (1); + +$h->launch (); +ok (1); +$h->wait_ready (); +ok (1); + +$h->mount_vfs ("ro", "squashfs", "/dev/sda", "/"); +ok (1); + +is (Sys::Guestfs::Lib::file_architecture ($h, "/bin-i586-dynamic"), + "i386"); +is (Sys::Guestfs::Lib::file_architecture ($h, "/bin-sparc-dynamic"), + "sparc"); +is (Sys::Guestfs::Lib::file_architecture ($h, "/bin-win32.exe"), + "i386"); +is (Sys::Guestfs::Lib::file_architecture ($h, "/bin-win64.exe"), + "x86_64"); +is (Sys::Guestfs::Lib::file_architecture ($h, "/bin-x86_64-dynamic"), + "x86_64"); +is (Sys::Guestfs::Lib::file_architecture ($h, "/lib-i586.so"), + "i386"); +is (Sys::Guestfs::Lib::file_architecture ($h, "/lib-sparc.so"), + "sparc"); +is (Sys::Guestfs::Lib::file_architecture ($h, "/lib-win32.dll"), + "i386"); +is (Sys::Guestfs::Lib::file_architecture ($h, "/lib-win64.dll"), + "x86_64"); +is (Sys::Guestfs::Lib::file_architecture ($h, "/lib-x86_64.so"), + "x86_64"); +is (Sys::Guestfs::Lib::file_architecture ($h, "/initrd-x86_64.img"), + "x86_64"); +is (Sys::Guestfs::Lib::file_architecture ($h, "/initrd-x86_64.img.gz"), + "x86_64"); |