X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=perl%2Flib%2FSys%2FGuestfs%2FLib.pm;h=7a734aa06a484b4905e4dad93b630f988f5fb8fd;hp=df3bbe1922373999ab1535fa13ce167bbda7aa6c;hb=8b854734bd13b7f68b72422932de3bf24c84ca15;hpb=9e90b24c7d76489f93830377e3d7d3c37f36c30c diff --git a/perl/lib/Sys/Guestfs/Lib.pm b/perl/lib/Sys/Guestfs/Lib.pm index df3bbe1..7a734aa 100644 --- a/perl/lib/Sys/Guestfs/Lib.pm +++ b/perl/lib/Sys/Guestfs/Lib.pm @@ -78,7 +78,7 @@ use vars qw(@EXPORT_OK @ISA); $g = open_guest ([$img1, $img2, ...], address => $uri, ...); - ($g, $conn, $dom) = open_guest ($name); + ($g, $conn, $dom, @images) = open_guest ($name); This function opens a libguestfs handle for either the libvirt domain called C<$name>, or the disk image called C<$name>. Any disk images @@ -108,10 +108,10 @@ passed through to Cnew> unchanged. The implicit libvirt handle is closed after this function, I you call the function in C context, in which case the function returns a tuple of: the open libguestfs handle, the open -libvirt handle, and the open libvirt domain handle. (This is useful -if you want to do other things like pulling the XML description of the -guest). Note that if this is a straight disk image, then C<$conn> and -C<$dom> will be C. +libvirt handle, and the open libvirt domain handle, and a list of +images. (This is useful if you want to do other things like pulling +the XML description of the guest). Note that if this is a straight +disk image, then C<$conn> and C<$dom> will be C. If the C module is not available, then libvirt is bypassed, and this function can only open disk images. @@ -204,7 +204,7 @@ sub open_guest } } - return wantarray ? ($g, $conn, $dom) : $g + return wantarray ? ($g, $conn, $dom, @images) : $g } =head2 get_partitions @@ -300,6 +300,161 @@ sub resolve_windows_path return $path; } +=head2 file_architecture + + $arch = file_architecture ($g, $path) + +The C 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 or C). + +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. + +Win64 binaries and DLLs return C. + +=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") { + $_ = `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 @@ -478,15 +633,26 @@ Filesystem content, if we could determine it. One of: "linux-grub", Operating system distribution. One of: "fedora", "rhel", "centos", "scientific", "debian". -=item osdistrofamily +=item package_format (For Linux root partitions only) -Operating system distribution family. One of: "redhat", "debian". +The package format used by the guest distribution. One of: "rpm", "dpkg". -=item osversion +=item package_management + +(For Linux root partitions only) +The package management tool used by the guest distribution. One of: "rhn", +"yum", "apt". + +=item os_major_version (For root partitions only). -Operating system version. +Operating system major version number. + +=item os_minor_version + +(For root partitions only). +Operating system minor version number. =item fstab @@ -613,13 +779,16 @@ sub _check_linux_root my $r = shift; # Look into /etc to see if we recognise the operating system. - if ($g->is_file ("/etc/redhat-release")) { - $r->{osdistrofamily} = "redhat"; + # N.B. don't use $g->is_file here, because it might be a symlink + if ($g->exists ("/etc/redhat-release")) { + $r->{package_format} = "rpm"; $_ = $g->cat ("/etc/redhat-release"); - if (/Fedora release (\d+\.\d+)/) { + if (/Fedora release (\d+)(?:\.(\d+))?/) { $r->{osdistro} = "fedora"; - $r->{osversion} = "$1" + $r->{os_major_version} = "$1"; + $r->{os_minor_version} = "$2" if(defined($2)); + $r->{package_management} = "yum"; } elsif (/(Red Hat Enterprise Linux|CentOS|Scientific Linux)/) { @@ -631,21 +800,39 @@ sub _check_linux_root elsif($distro eq "CentOS") { $r->{osdistro} = "centos"; + $r->{package_management} = "yum"; } elsif($distro eq "Scientific Linux") { $r->{osdistro} = "scientific"; + $r->{package_management} = "yum"; } # Shouldn't be possible else { die }; if (/$distro.*release (\d+).*Update (\d+)/) { - $r->{osversion} = "$1.$2"; + $r->{os_major_version} = "$1"; + $r->{os_minor_version} = "$2"; + } + + elsif (/$distro.*release (\d+)(?:\.(\d+))?/) { + $r->{os_major_version} = "$1"; + + if(defined($2)) { + $r->{os_minor_version} = "$2"; + } else { + $r->{os_minor_version} = "0"; + } } - elsif (/$distro.*release (\d+(?:\.(?:\d+))?)/) { - $r->{osversion} = "$1"; + # Package management in RHEL changed in version 5 + if ($r->{osdistro} eq "rhel") { + if ($r->{os_major_version} >= 5) { + $r->{package_management} = "yum"; + } else { + $r->{package_management} = "rhn"; + } } } @@ -653,12 +840,14 @@ sub _check_linux_root $r->{osdistro} = "redhat-based"; } } elsif ($g->is_file ("/etc/debian_version")) { - $r->{osdistrofamily} = "debian"; + $r->{package_format} = "dpkg"; + $r->{package_management} = "apt"; $_ = $g->cat ("/etc/debian_version"); - if (/(\d+\.\d+)/) { + if (/(\d+)\.(\d+)/) { $r->{osdistro} = "debian"; - $r->{osversion} = "$1"; + $r->{os_major_version} = "$1"; + $r->{os_minor_version} = "$2"; } else { $r->{osdistro} = "debian"; } @@ -685,6 +874,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 @@ -723,13 +923,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 $_; @@ -843,13 +1060,21 @@ 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". -=item version +=item major_version + +Operating system major version, eg. "4". -Operating system version, eg. "4.0". +=item minor_version + +Operating system minor version, eg "3". =item root @@ -915,9 +1140,15 @@ sub _get_os_version $r->{os} = $r->{root}->{fsos} if exists $r->{root}->{fsos}; $r->{distro} = $r->{root}->{osdistro} if exists $r->{root}->{osdistro}; - $r->{distrofamily} = $r->{root}->{osdistrofamily} - if exists $r->{root}->{osdistrofamily}; - $r->{version} = $r->{root}->{osversion} if exists $r->{root}->{osversion}; + $r->{major_version} = $r->{root}->{os_major_version} + if exists $r->{root}->{os_major_version}; + $r->{minor_version} = $r->{root}->{os_minor_version} + if exists $r->{root}->{os_minor_version}; + $r->{package_format} = $r->{root}->{package_format} + 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 @@ -1006,13 +1237,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 table in that hash (see C). -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-Eumount_all ()>. @@ -1024,14 +1256,22 @@ sub mount_operating_system local $_; my $g = shift; my $os = shift; + my $ro = shift; # Read-only? + + $ro = 1 unless defined $ro; # ro defaults to 1 if unspecified my $mounts = $os->{mounts}; # Have to mount / first. Luckily '/' is early in the ASCII # character set, so this should be OK. foreach (sort keys %$mounts) { - $g->mount_ro ($mounts->{$_}, $_) - if $_ ne "swap" && $_ ne "none" && ($_ eq '/' || $g->is_dir ($_)); + if($_ ne "swap" && $_ ne "none" && ($_ eq '/' || $g->is_dir ($_))) { + if($ro) { + $g->mount_ro ($mounts->{$_}, $_) + } else { + $g->mount ($mounts->{$_}, $_) + } + } } } @@ -1042,8 +1282,8 @@ sub mount_operating_system $g->umount_all (); The C 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: @@ -1058,6 +1298,24 @@ List of applications. List of kernels. +This is a hash of kernel version =E a hash with the following keys: + +=over 4 + +=item version + +Kernel version. + +=item arch + +Kernel architecture (eg. C). + +=item modules + +List of modules. + +=back + =item modprobe_aliases (For Linux VMs). @@ -1097,8 +1355,8 @@ sub _check_for_applications my $osn = $os->{os}; if ($osn eq "linux") { - my $family = $os->{distrofamily}; - if (defined $family && $family eq "redhat") { + my $package_format = $os->{package_format}; + if (defined $package_format && $package_format eq "rpm") { my @lines = $g->command_lines (["rpm", "-q", "-a", @@ -1150,14 +1408,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; } } @@ -1256,10 +1521,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"); };