use warnings;
use Sys::Guestfs;
+use File::Temp qw/tempdir/;
+use Locale::TextDomain 'libguestfs';
# Optional:
eval "use Sys::Virt;";
=head1 SYNOPSIS
- use Sys::Guestfs::Lib qw(#any symbols you want to use);
+ use Sys::Guestfs::Lib qw(open_guest inspect_all_partitions ...);
$g = open_guest ($name);
+ %fses = inspect_all_partitions ($g, \@partitions);
+
+(and many more calls - see the rest of this manpage)
+
=head1 DESCRIPTION
C<Sys::Guestfs::Lib> is an extra library of useful functions for using
$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
The implicit libvirt handle is closed after this function, I<unless>
you call the function in C<wantarray> 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<undef>.
+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<undef>.
If the C<Sys::Virt> module is not available, then libvirt is bypassed,
and this function can only open disk images.
sub open_guest
{
+ local $_;
my $first = shift;
my %params = @_;
} elsif (ref ($first) eq "SCALAR") {
@images = ($first);
} else {
- die "open_guest: first parameter must be a string or an arrayref"
+ die __"open_guest: first parameter must be a string or an arrayref"
}
my ($conn, $dom);
if (-e $images[0]) {
foreach (@images) {
- die "guest image $_ does not exist or is not readable"
+ die __x("guest image {imagename} does not exist or is not readable",
+ imagename => $_)
unless -r $_;
}
} else {
- die "open_guest: no libvirt support (install Sys::Virt, XML::XPath and XML::XPath::XMLParser)"
+ die __"open_guest: no libvirt support (install Sys::Virt, XML::XPath and XML::XPath::XMLParser)"
unless exists $INC{"Sys/Virt.pm"} &&
exists $INC{"XML/XPath.pm"} &&
exists $INC{"XML/XPath/XMLParser.pm"};
- die "open_guest: too many domains listed on command line"
+ die __"open_guest: too many domains listed on command line"
if @images > 1;
$conn = Sys::Virt->new (readonly => 1, @_);
- die "open_guest: cannot connect to libvirt" unless $conn;
+ die __"open_guest: cannot connect to libvirt" unless $conn;
my @doms = $conn->list_defined_domains ();
- my $isitinactive = "an inactive libvirt domain";
+ my $isitinactive = 1;
unless ($readwrite) {
# In the case where we want read-only access to a domain,
# allow the user to specify an active domain too.
push @doms, $conn->list_domains ();
- $isitinactive = "a libvirt domain";
+ $isitinactive = 0;
}
foreach (@doms) {
if ($_->get_name () eq $images[0]) {
last;
}
}
- die "$images[0] is not the name of $isitinactive\n" unless $dom;
+
+ unless ($dom) {
+ if ($isitinactive) {
+ die __x("{imagename} is not the name of an inactive libvirt domain\n",
+ imagename => $images[0]);
+ } else {
+ die __x("{imagename} is not the name of a libvirt domain\n",
+ imagename => $images[0]);
+ }
+ }
# Get the names of the image(s).
my $xml = $dom->get_xml_description ();
my $p = XML::XPath->new (xml => $xml);
my @disks = $p->findnodes ('//devices/disk/source/@dev');
+ push (@disks, $p->findnodes ('//devices/disk/source/@file'));
+
+ die __x("{imagename} seems to have no disk devices\n",
+ imagename => $images[0])
+ unless @disks;
+
@images = map { $_->getData } @disks;
}
}
}
- return wantarray ? ($g, $conn, $dom) : $g
+ return wantarray ? ($g, $conn, $dom, @images) : $g
}
=head2 get_partitions
my @partitions = $g->list_partitions ();
my @pvs = $g->pvs ();
- @partitions = grep { ! is_pv ($_, @pvs) } @partitions;
+ @partitions = grep { ! _is_pv ($_, @pvs) } @partitions;
my @lvs = $g->lvs ();
return sort (@lvs, @partitions);
}
-sub is_pv {
+sub _is_pv {
local $_;
my $t = shift;
my $path = shift;
if (substr ($path, 0, 1) ne "/") {
- warn "resolve_windows_path: path must start with a / character";
+ warn __"resolve_windows_path: path must start with a / character";
return undef;
}
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
=item osdistro
(For Linux root partitions only).
-Operating system distribution. One of: "fedora", "redhat",
-"debian".
+Operating system distribution. One of: "fedora", "rhel", "centos",
+"scientific", "debian".
+
+=item package_format
-=item osversion
+(For Linux root partitions only)
+The package format used by the guest distribution. One of: "rpm", "dpkg".
+
+=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
if ($g->is_file ("/grub/menu.lst") ||
$g->is_file ("/grub/grub.conf")) {
$r{content} = "linux-grub";
- check_grub ($g, \%r);
+ _check_grub ($g, \%r);
goto OUT;
}
$g->is_file ("/etc/fstab")) {
$r{content} = "linux-root";
$r{is_root} = 1;
- check_linux_root ($g, \%r);
+ _check_linux_root ($g, \%r);
goto OUT;
}
$r{fsos} = "windows";
$r{content} = "windows-root";
$r{is_root} = 1;
- check_windows_root ($g, \%r, $use_windows_registry);
+ _check_windows_root ($g, \%r, $use_windows_registry);
goto OUT;
}
}
return \%r;
}
-sub check_linux_root
+sub _check_linux_root
{
local $_;
my $g = shift;
my $r = shift;
# Look into /etc to see if we recognise the operating system.
- if ($g->is_file ("/etc/redhat-release")) {
+ # 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"
- } elsif (/(Red Hat Enterprise Linux|CentOS|Scientific Linux).*release (\d+).*Update (\d+)/) {
- $r->{osdistro} = "redhat";
- $r->{osversion} = "$2.$3";
- } elsif (/(Red Hat Enterprise Linux|CentOS|Scientific Linux).*release (\d+(?:\.(\d+))?)/) {
- $r->{osdistro} = "redhat";
- $r->{osversion} = "$2";
- } else {
- $r->{osdistro} = "redhat";
+ $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)/) {
+ my $distro = $1;
+
+ if($distro eq "Red Hat Enterprise Linux") {
+ $r->{osdistro} = "rhel";
+ }
+
+ 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->{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";
+ }
+ }
+
+ # 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";
+ }
+ }
+ }
+
+ else {
+ $r->{osdistro} = "redhat-based";
}
} elsif ($g->is_file ("/etc/debian_version")) {
+ $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";
}
}
$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
# XXX We could parse this better. This won't work if /boot.ini is on
# a different drive from the %systemroot%, and in other unusual cases.
-sub check_windows_root
+sub _check_windows_root
{
local $_;
my $g = shift;
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});
+ }
}
}
}
}
-sub check_windows_registry
+# 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 $_;
my $g = shift;
if (defined $configdir) {
my $softwaredir = resolve_windows_path ($g, "$configdir/software");
if (defined $softwaredir) {
- load_windows_registry ($g, $r, $softwaredir,
- "HKEY_LOCAL_MACHINE\\SOFTWARE");
+ _load_windows_registry ($g, $r, $softwaredir,
+ "HKEY_LOCAL_MACHINE\\SOFTWARE");
}
my $systemdir = resolve_windows_path ($g, "$configdir/system");
if (defined $systemdir) {
- load_windows_registry ($g, $r, $systemdir,
- "HKEY_LOCAL_MACHINE\\System");
+ _load_windows_registry ($g, $r, $systemdir,
+ "HKEY_LOCAL_MACHINE\\System");
}
}
}
-sub load_windows_registry
+sub _load_windows_registry
{
local $_;
my $g = shift;
close SAVEERR;
unless ($res == 0) {
- warn "reged command failed: $?";
+ warn __x("reged command failed: {errormsg}", errormsg => $?);
return;
}
# it.
my $content;
unless (open F, "$dir/out") {
- warn "no output from reged command: $!";
+ warn __x("no output from reged command: {errormsg}", errormsg => $!);
return;
}
{ local $/ = undef; $content = <F>; }
$r->{registry} = \@registry;
}
-sub check_grub
+sub _check_grub
{
local $_;
my $g = shift;
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".
+
+=item minor_version
-Operating system version, eg. "4.0".
+Operating system minor version, eg "3".
=item root
root => $fses->{$_},
root_device => $_
);
- get_os_version ($g, \%r);
- assign_mount_points ($g, $fses, \%r);
+ _get_os_version ($g, \%r);
+ _assign_mount_points ($g, $fses, \%r);
$oses{$_} = \%r;
}
}
return \%oses;
}
-sub get_os_version
+sub _get_os_version
{
local $_;
my $g = shift;
$r->{os} = $r->{root}->{fsos} if exists $r->{root}->{fsos};
$r->{distro} = $r->{root}->{osdistro} if exists $r->{root}->{osdistro};
- $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
+sub _assign_mount_points
{
local $_;
my $g = shift;
foreach (@fstab) {
my ($spec, $file) = @$_;
- my ($dev, $fs) = find_filesystem ($g, $fses, $spec);
+ my ($dev, $fs) = _find_filesystem ($g, $fses, $spec);
if ($dev) {
$r->{mounts}->{$file} = $dev;
$r->{filesystems}->{$dev} = $fs;
}
# Find filesystem by device name, LABEL=.. or UUID=..
-sub find_filesystem
+sub _find_filesystem
{
my $g = shift;
my $fses = shift;
return ($_, $fses->{$_});
}
}
- warn "unknown filesystem label $label\n";
+ warn __x("unknown filesystem label {label}\n", label => $label);
return ();
} elsif (/^UUID=(.*)/) {
my $uuid = $1;
return ($_, $fses->{$_});
}
}
- warn "unknown filesystem UUID $uuid\n";
+ warn __x("unknown filesystem UUID {uuid}\n", uuid => $uuid);
return ();
} else {
return ($_, $fses->{$_}) if exists $fses->{$_};
return () if m{/dev/cdrom};
- warn "unknown filesystem $_\n";
+ warn __x("unknown filesystem {fs}\n", fs => $_);
return ();
}
}
=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 ()>.
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->{$_}, $_)
+ }
+ }
}
}
$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:
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).
my $g = shift;
my $os = shift;
- check_for_applications ($g, $os);
- check_for_kernels ($g, $os);
+ _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);
+ _check_for_modprobe_aliases ($g, $os);
+ _check_for_initrd ($g, $os);
}
}
-sub check_for_applications
+sub _check_for_applications
{
local $_;
my $g = shift;
my $osn = $os->{os};
if ($osn eq "linux") {
- my $distro = $os->{distro};
- if (defined $distro && ($distro eq "redhat" || $distro eq "fedora")) {
+ my $package_format = $os->{package_format};
+ if (defined $package_format && $package_format eq "rpm") {
my @lines = $g->command_lines
(["rpm",
"-q", "-a",
$os->{apps} = \@apps;
}
-sub check_for_kernels
+sub _check_for_kernels
{
local $_;
my $g = shift;
# 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;
}
}
#
# XXX This doesn't look beyond /etc/modprobe.conf, eg. in /etc/modprobe.d/
-sub check_for_modprobe_aliases
+sub _check_for_modprobe_aliases
{
local $_;
my $g = shift;
for my $path ( @results ) {
$path =~ m{^/files(.*)/alias(?:\[\d*\])?$}
- or die("$path doesn't match augeas pattern");
+ or die __x("{path} doesn't match augeas pattern",
+ path => $path);
my $file = $1;
my $alias;
# 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
+sub _check_for_initrd
{
local $_;
my $g = shift;
my $version = $1;
my @modules;
- eval {
- @modules = $g->initrd_list ("/boot/$initrd");
- };
- unless ($@) {
- @modules = grep { m,([^/]+)\.ko$, || m,([^/]+)\.o$, } @modules;
- $initrd_modules{$version} = \@modules
- } else {
- warn "/boot/$initrd: could not read initrd format"
+ # 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");
+ }
}
}
}
git.annexia.org / libguestfs.git / blobdiff