+ # 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
+# Windows installations and their %systemroot%s in a simple text
+# format.
+#
+# XXX We don't handle the case where /boot.ini is on a different
+# partition very well (Windows Vista and later).
+
+sub _check_windows_root
+{
+ local $_;
+ my $g = shift;
+ my $r = shift;
+
+ my $boot_ini = resolve_windows_path ($g, "/boot.ini");
+ $r->{boot_ini} = $boot_ini;
+
+ my $systemroot;
+ if (defined $r->{boot_ini}) {
+ $_ = $g->cat ($boot_ini);
+ my @lines = split /\n/;
+ my $section;
+ foreach (@lines) {
+ if (m/\[.*\]/) {
+ $section = $1;
+ } elsif (m/^default=.*?\\(\w+)$/i) {
+ $systemroot = $1;
+ last;
+ } elsif (m/\\(\w+)=/) {
+ $systemroot = $1;
+ last;
+ }
+ }
+ }
+
+ if (!defined $systemroot) {
+ # Last ditch ... try to guess %systemroot% location.
+ foreach ("windows", "winnt") {
+ my $dir = resolve_windows_path ($g, "/$_/system32");
+ if (defined $dir) {
+ $systemroot = $_;
+ last;
+ }
+ }
+ }
+
+ if (defined $systemroot) {
+ $r->{systemroot} = resolve_windows_path ($g, "/$systemroot");
+ if (defined $r->{systemroot}) {
+ _check_windows_arch ($g, $r, $r->{systemroot});
+ _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 $_;
+ my $g = shift;
+ my $r = shift;
+ my $systemroot = shift;
+
+ # Download the system registry files. Only download the
+ # interesting ones (SOFTWARE and SYSTEM). We don't bother with
+ # the user ones.
+
+ return unless exists $INC{"Win/Hivex.pm"};
+
+ my $configdir = resolve_windows_path ($g, "$systemroot/system32/config");
+ return unless defined $configdir;
+
+ my $tmpdir = tempdir (CLEANUP => 1);
+
+ my $software = resolve_windows_path ($g, "$configdir/software");
+ my $software_hive;
+ if (defined $software) {
+ eval {
+ $g->download ($software, "$tmpdir/software");
+ $software_hive = Win::Hivex->open ("$tmpdir/software");
+ };
+ warn "$@\n" if $@;
+ $r->{windows_software_hive} = $software;
+ }
+
+ my $system = resolve_windows_path ($g, "$configdir/system");
+ my $system_hive;
+ if (defined $system) {
+ eval {
+ $g->download ($system, "$tmpdir/system");
+ $system_hive = Win::Hivex->open ("$tmpdir/system");
+ };
+ warn "$@\n" if $@;
+ $r->{windows_system_hive} = $system;
+ }
+
+ # 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
+
+This function is deprecated. It will not be updated in future
+versions of libguestfs. New code should not use this function. Use
+the core API functions instead, see L<guestfs(3)/INSPECTION>.
+
+=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;
+ }
+ }
+
+ # If we didn't find any operating systems then it's an error (RHBZ#591142).
+ if (0 == keys %oses) {
+ die __"No operating system could be detected inside this disk image.\n\nThis may be because the file is not a disk image, or is not a virtual machine\nimage, or because the OS type is not understood by virt-inspector.\n\nIf you feel this is an error, please file a bug report including as much\ninformation about the disk image as possible.\n";
+ }
+
+ 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, $file);
+ 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;
+ my $file = 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/vd(.*)} && 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 $file =~ (/media\/cdrom/);
+ return () if m{/dev/cdrom};
+ return () if m{/dev/fd0};
+
+ warn __x("unknown filesystem {fs}\n", fs => $_);
+ return ();
+ }
+}
+
+=head2 mount_operating_system
+
+This function is deprecated. It will not be updated in future
+versions of libguestfs. New code should not use this function. Use
+the core API functions instead, see L<guestfs(3)/INSPECTION>.
+
+=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
+
+This function is deprecated. It will not be updated in future
+versions of libguestfs. New code should not use this function. Use
+the core API functions instead, see L<guestfs(3)/INSPECTION>.
+
+=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
+
+This function is deprecated. It will not be updated in future
+versions of libguestfs. New code should not use this function. Use
+the core API functions instead, see L<guestfs(3)/INSPECTION>.
+
+=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);
+
+ 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;