+ # Get the ProductName, major and minor version, etc.
+ if (defined $software_hive) {
+ my $cv_node;
+ eval {
+ $cv_node = $software_hive->root;
+ $cv_node = $software_hive->node_get_child ($cv_node, $_)
+ foreach ("Microsoft", "Windows NT", "CurrentVersion");
+ };
+ warn "$@\n" if $@;
+
+ if ($cv_node) {
+ my @values = $software_hive->node_values ($cv_node);
+
+ foreach (@values) {
+ my $k = $software_hive->value_key ($_);
+ if ($k eq "ProductName") {
+ $_ = $software_hive->value_string ($_);
+ $r->{product_name} = $_ if defined $_;
+ } elsif ($k eq "CurrentVersion") {
+ $_ = $software_hive->value_string ($_);
+ if (defined $_ && m/^(\d+)\.(\d+)/) {
+ $r->{os_major_version} = $1;
+ $r->{os_minor_version} = $2;
+ }
+ } elsif ($k eq "CurrentBuild") {
+ $_ = $software_hive->value_string ($_);
+ $r->{windows_current_build} = $_ if defined $_;
+ } elsif ($k eq "SoftwareType") {
+ $_ = $software_hive->value_string ($_);
+ $r->{windows_software_type} = $_ if defined $_;
+ } elsif ($k eq "CurrentType") {
+ $_ = $software_hive->value_string ($_);
+ $r->{windows_current_type} = $_ if defined $_;
+ } elsif ($k eq "RegisteredOwner") {
+ $_ = $software_hive->value_string ($_);
+ $r->{windows_registered_owner} = $_ if defined $_;
+ } elsif ($k eq "RegisteredOrganization") {
+ $_ = $software_hive->value_string ($_);
+ $r->{windows_registered_organization} = $_ if defined $_;
+ } elsif ($k eq "InstallationType") {
+ $_ = $software_hive->value_string ($_);
+ $r->{windows_installation_type} = $_ if defined $_;
+ } elsif ($k eq "EditionID") {
+ $_ = $software_hive->value_string ($_);
+ $r->{windows_edition_id} = $_ if defined $_;
+ } elsif ($k eq "ProductID") {
+ $_ = $software_hive->value_string ($_);
+ $r->{windows_product_id} = $_ if defined $_;
+ }
+ }
+ }
+ }
+}
+
+sub _check_grub
+{
+ local $_;
+ my $g = shift;
+ my $r = shift;
+
+ # Grub version, if we care.
+}
+
+=head2 inspect_operating_systems
+
+ \%oses = inspect_operating_systems ($g, \%fses);
+
+This function works out how partitions are related to each other. In
+the case of a single-boot VM, we work out how the partitions are
+mounted in respect of each other (eg. C</dev/sda1> is mounted as
+C</boot>). In the case of a multi-boot VM where there are several
+roots, we may identify several operating system roots, and mountpoints
+can even be shared.
+
+This function returns a hashref C<\%oses> which at the top level looks
+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):
+
+=over 4
+
+=item os
+
+Operating system type, eg. "linux", "windows".
+
+=item arch
+
+Operating system userspace architecture, eg. "i386", "x86_64".
+
+=item distro
+
+Operating system distribution, eg. "debian".
+
+=item product_name
+
+Free text product name.
+
+=item major_version
+
+Operating system major version, eg. "4".
+
+=item minor_version
+
+Operating system minor version, eg "3".
+
+=item root
+
+The value is a reference to the root partition C<%fs> hash.
+
+=item root_device
+
+The value is the name of the root partition (as a string).
+
+=item mounts
+
+Mountpoints.
+The value is a hashref like this:
+
+ mounts => {
+ '/' => '/dev/VG/Root',
+ '/boot' => '/dev/sda1',
+ }
+
+=item filesystems
+
+Filesystems (including swap devices and unmounted partitions).
+The value is a hashref like this:
+
+ filesystems => {
+ '/dev/sda1' => \%fs,
+ '/dev/VG/Root' => \%fs,
+ '/dev/VG/Swap' => \%fs,
+ }
+
+=back
+
+=cut
+
+sub inspect_operating_systems
+{
+ local $_;
+ my $g = shift;
+ my $fses = shift;
+
+ my %oses = ();
+
+ foreach (sort keys %$fses) {
+ if ($fses->{$_}->{is_root}) {
+ my %r = (
+ root => $fses->{$_},
+ root_device => $_
+ );
+ _get_os_version ($g, \%r);
+ _assign_mount_points ($g, $fses, \%r);
+ $oses{$_} = \%r;
+ }
+ }
+
+ return \%oses;
+}
+
+sub _get_os_version
+{
+ local $_;
+ my $g = shift;
+ my $r = shift;
+
+ $r->{os} = $r->{root}->{fsos} if exists $r->{root}->{fsos};
+ $r->{product_name} = $r->{root}->{product_name}
+ if exists $r->{root}->{product_name};
+ $r->{distro} = $r->{root}->{osdistro} if exists $r->{root}->{osdistro};
+ $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
+{
+ local $_;
+ my $g = shift;
+ my $fses = shift;
+ my $r = shift;
+
+ $r->{mounts} = { "/" => $r->{root_device} };
+ $r->{filesystems} = { $r->{root_device} => $r->{root} };
+
+ # Use /etc/fstab if we have it to mount the rest.
+ if (exists $r->{root}->{fstab}) {
+ my @fstab = @{$r->{root}->{fstab}};
+ foreach (@fstab) {
+ my ($spec, $file) = @$_;
+
+ my ($dev, $fs) = _find_filesystem ($g, $fses, $spec);
+ if ($dev) {
+ $r->{mounts}->{$file} = $dev;
+ $r->{filesystems}->{$dev} = $fs;
+ if (exists $fs->{used}) {
+ $fs->{used}++
+ } else {
+ $fs->{used} = 1
+ }
+ $fs->{spec} = $spec;
+ }
+ }
+ }
+}
+
+# Find filesystem by device name, LABEL=.. or UUID=..
+sub _find_filesystem
+{
+ my $g = shift;
+ my $fses = shift;
+ local $_ = shift;
+
+ if (/^LABEL=(.*)/) {
+ my $label = $1;
+ foreach (sort keys %$fses) {
+ if (exists $fses->{$_}->{label} &&
+ $fses->{$_}->{label} eq $label) {
+ return ($_, $fses->{$_});
+ }
+ }
+ warn __x("unknown filesystem label {label}\n", label => $label);
+ return ();
+ } elsif (/^UUID=(.*)/) {
+ my $uuid = $1;
+ foreach (sort keys %$fses) {
+ if (exists $fses->{$_}->{uuid} &&
+ $fses->{$_}->{uuid} eq $uuid) {
+ return ($_, $fses->{$_});
+ }
+ }
+ warn __x("unknown filesystem UUID {uuid}\n", uuid => $uuid);
+ return ();
+ } else {
+ return ($_, $fses->{$_}) if exists $fses->{$_};
+
+ # The following is to handle the case where an fstab entry specifies a
+ # specific device rather than its label or uuid, and the libguestfs
+ # appliance has named the device differently due to the use of a
+ # different driver.
+ # This will work as long as the underlying drivers recognise devices in
+ # the same order.
+ if (m{^/dev/hd(.*)} && exists $fses->{"/dev/sd$1"}) {
+ return ("/dev/sd$1", $fses->{"/dev/sd$1"});
+ }
+ if (m{^/dev/xvd(.*)} && exists $fses->{"/dev/sd$1"}) {
+ return ("/dev/sd$1", $fses->{"/dev/sd$1"});
+ }
+ if (m{^/dev/mapper/(.*)-(.*)$} && exists $fses->{"/dev/$1/$2"}) {
+ return ("/dev/$1/$2", $fses->{"/dev/$1/$2"});
+ }
+
+ return () if m{/dev/cdrom};
+
+ warn __x("unknown filesystem {fs}\n", fs => $_);
+ return ();
+ }
+}
+
+=head2 mount_operating_system
+
+ 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 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 ()>.
+
+=cut
+
+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) {
+ if($_ ne "swap" && $_ ne "none" && ($_ eq '/' || $g->is_dir ($_))) {
+ if($ro) {
+ $g->mount_ro ($mounts->{$_}, $_)
+ } else {
+ $g->mount_options ("", $mounts->{$_}, $_)
+ }
+ }
+ }
+}
+
+=head2 inspect_in_detail
+
+ mount_operating_system ($g, \%os);
+ inspect_in_detail ($g, \%os);
+ $g->umount_all ();
+
+The C<inspect_in_detail> function inspects the mounted operating
+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:
+
+=over 4
+
+=item apps
+
+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.
+
+=item grub_fs
+
+The path of the filesystem containing the grub partition.
+
+=back
+
+=item kernels
+
+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.
+
+=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
+
+(For Linux VMs).
+The contents of the modprobe configuration.
+
+=item initrd_modules
+
+(For Linux VMs).
+The kernel modules installed in the initrd. The value is
+a hashref of kernel version to list of modules.
+
+=back
+
+=cut
+
+sub inspect_in_detail
+{
+ local $_;
+ my $g = shift;
+ my $os = shift;
+
+ _check_for_applications ($g, $os);
+ _check_for_kernels ($g, $os);
+ if ($os->{os} eq "linux") {
+ _find_modprobe_aliases ($g, $os);
+ }
+}
+
+sub _check_for_applications
+{
+ local $_;
+ my $g = shift;
+ my $os = shift;
+
+ my @apps;
+
+ my $osn = $os->{os};
+ if ($osn eq "linux") {
+ my $package_format = $os->{package_format};
+ if (defined $package_format && $package_format eq "rpm") {
+ my @lines = ();
+ eval {
+ @lines = $g->command_lines
+ (["rpm",
+ "-q", "-a", "--qf",
+ "%{name} %{epoch} %{version} %{release} %{arch}\n"]);
+ };
+
+ warn(__x("Error running rpm -qa: {error}", error => $@)) if ($@);
+
+ @lines = sort @lines;
+ foreach (@lines) {
+ if (m/^(.*) (.*) (.*) (.*) (.*)$/) {
+ my $epoch = $2;
+ undef $epoch if $epoch eq "(none)";
+ my $app = {
+ name => $1,
+ epoch => $epoch,
+ version => $3,
+ release => $4,
+ arch => $5
+ };
+ push @apps, $app
+ }
+ }
+ } elsif (defined $package_format && $package_format eq "deb") {
+ my @lines = ();
+ eval {
+ @lines = $g->command_lines
+ (["dpkg-query",
+ "-f", '${Package} ${Version} ${Architecture} ${Status}\n',
+ "-W"]);
+ };
+
+ warn(__x("Error running dpkg-query: {error}", error => $@)) if ($@);
+
+ @lines = sort @lines;
+ foreach (@lines) {
+ if (m/^(.*) (.*) (.*) (.*) (.*) (.*)$/) {
+ if ( $6 eq "installed" ) {
+ my $app = {
+ name => $1,
+ version => $2,
+ arch => $3
+ };
+ push @apps, $app
+ }
+ }
+ }
+ }
+ } elsif ($osn eq "windows") {
+ # XXX
+ # I worked out a general plan for this, but haven't
+ # implemented it yet. We can iterate over /Program Files
+ # looking for *.EXE files, which we download, then use
+ # i686-pc-mingw32-windres on, to find the VERSIONINFO
+ # section, which has a lot of useful information.
+ }
+
+ $os->{apps} = \@apps;
+}
+
+# Find the path which needs to be prepended to paths in grub.conf to make them
+# absolute
+sub _find_grub_prefix
+{
+ my ($g, $os) = @_;
+
+ my $fses = $os->{filesystems};
+ die("filesystems undefined") unless(defined($fses));
+
+ # Look for the filesystem which contains grub
+ my $grubdev;
+ foreach my $dev (keys(%$fses)) {
+ my $fsinfo = $fses->{$dev};
+ if(exists($fsinfo->{content}) && $fsinfo->{content} eq "linux-grub") {
+ $grubdev = $dev;
+ last;
+ }
+ }
+
+ my $mounts = $os->{mounts};
+ die("mounts undefined") unless(defined($mounts));
+
+ # Find where the filesystem is mounted
+ if(defined($grubdev)) {
+ foreach my $mount (keys(%$mounts)) {
+ if($mounts->{$mount} eq $grubdev) {
+ return "" if($mount eq '/');
+ return $mount;
+ }
+ }
+
+ die("$grubdev defined in filesystems, but not in mounts");
+ }
+
+ # If we didn't find it, look for /boot/grub/menu.lst, then try to work out
+ # what filesystem it's on. We use menu.lst rather than grub.conf because
+ # debian only uses menu.lst, and anaconda creates a symlink for it.
+ die(__"Can't find grub on guest") unless($g->exists('/boot/grub/menu.lst'));
+
+ # Look for the most specific mount point in mounts
+ foreach my $path qw(/boot/grub /boot /) {
+ if(exists($mounts->{$path})) {
+ return "" if($path eq '/');
+ return $path;
+ }
+ }
+
+ die("Couldn't determine which filesystem holds /boot/grub/menu.lst");
+}
+
+sub _check_for_kernels
+{
+ my ($g, $os) = @_;
+
+ if ($os->{os} eq "linux" && feature_available ($g, "augeas")) {
+ # Iterate over entries in grub.conf, populating $os->{boot}
+ # For every kernel we find, inspect it and add to $os->{kernels}
+
+ my $grub = _find_grub_prefix($g, $os);
+ my $grub_conf = "/etc/grub.conf";
+
+ # Debian and other's have no /etc/grub.conf:
+ if ( ! -f "$grub_conf" ) {
+ $grub_conf = "$grub/grub/menu.lst";
+ }
+
+ 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
+ # ->{grub_fs} = "/boot"
+ # Initialise augeas
+ $g->aug_init("/", 16);
+
+ my @configs = ();
+ # Get all configurations from grub
+ foreach my $bootable
+ ($g->aug_match("/files/$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});
+ }
+
+ # Check we've got a kernel entry
+ if(defined($grub_kernel)) {
+ my $path = "$grub$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;
+ if ($g->exists($path)) {
+ $kernel =
+ inspect_linux_kernel($g, $path, $os->{package_format});
+ } else {
+ warn __x("grub refers to {path}, which doesn't exist\n",
+ path => $path);
+ }
+
+ # Check the kernel was recognised
+ if(defined($kernel)) {
+ # Put this kernel on the top level kernel list
+ $os->{kernels} ||= [];
+ push(@{$os->{kernels}}, $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, "$grub$initrd",
+ $kernel->{version});
+ } else {
+ warn __x("Grub entry {title} does not specify an ".
+ "initrd", title => $config{title});
+ }
+ }
+ }
+
+ push(@configs, \%config);
+ }
+
+
+ # Create the top level boot entry
+ my %boot;
+ $boot{configs} = \@configs;
+ $boot{grub_fs} = $grub;
+
+ # Add the default configuration
+ eval {
+ $boot{default} = $g->aug_get("/files/$grub_conf/default");
+ };
+
+ $os->{boot} = \%boot;
+ }
+
+ elsif ($os->{os} eq "windows") {
+ # XXX
+ }
+}
+
+=head2 inspect_linux_kernel
+
+ my $kernel_hash = inspect_linux_kernel($g, $vmlinuz_path, $package_format);
+
+inspect_linux_kernel returns a hash describing the target linux kernel. For the
+contents of the hash, see the I<kernels> structure described under
+L</inspect_in_detail>.
+
+=cut
+
+sub inspect_linux_kernel
+{
+ my ($g, $path, $package_format) = @_;
+
+ 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($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);
+
+ return \%kernel;
+}
+
+# Find all modprobe aliases. Specifically, this looks in the following
+# locations:
+# * /etc/conf.modules
+# * /etc/modules.conf
+# * /etc/modprobe.conf
+# * /etc/modprobe.d/*
+
+sub _find_modprobe_aliases
+{
+ local $_;
+ my $g = shift;
+ my $os = shift;
+
+ # Initialise augeas
+ $g->aug_init("/", 16);
+
+ # 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
+ $g->aug_load();
+
+ my %modprobe_aliases;
+
+ for my $pattern qw(/files/etc/conf.modules/alias
+ /files/etc/modules.conf/alias
+ /files/etc/modprobe.conf/alias
+ /files/etc/modprobe.d/*/alias) {
+ for my $path ( $g->aug_match($pattern) ) {
+ $path =~ m{^/files(.*)/alias(?:\[\d*\])?$}
+ or die __x("{path} doesn't match augeas pattern",
+ path => $path);
+ my $file = $1;
+
+ my $alias;
+ $alias = $g->aug_get($path);
+
+ my $modulename;
+ $modulename = $g->aug_get($path.'/modulename');
+
+ my %aliasinfo;
+ $aliasinfo{modulename} = $modulename;
+ $aliasinfo{augeas} = $path;
+ $aliasinfo{file} = $file;
+
+ $modprobe_aliases{$alias} = \%aliasinfo;
+ }
+ }
+
+ $os->{modprobe_aliases} = \%modprobe_aliases;
+}
+
+# Get a listing of device drivers from an initrd
+sub _inspect_initrd
+{
+ 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->exists($path) && $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");
+ }
+ }
+
+ # Add to the top level initrd_modules entry
+ $os->{initrd_modules} ||= {};
+ $os->{initrd_modules}->{$version} = \@modules;
+
+ return \@modules;