- OUT:
- $g->umount_all ();
- return \%r;
-}
-
-sub check_linux_root
-{
- local $_;
- my $r = shift;
-
- # Look into /etc to see if we recognise the operating system.
- if ($g->is_file ("/etc/redhat-release")) {
- $_ = $g->cat ("/etc/redhat-release");
- 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";
- }
- } elsif ($g->is_file ("/etc/debian_version")) {
- $_ = $g->cat ("/etc/debian_version");
- if (/(\d+\.\d+)/) {
- $r->{osdistro} = "debian";
- $r->{osversion} = "$1";
- } else {
- $r->{osdistro} = "debian";
- }
- }
-
- # Parse the contents of /etc/fstab. This is pretty vital so
- # we can determine where filesystems are supposed to be mounted.
- eval "\$_ = \$g->cat ('/etc/fstab');";
- if (!$@ && $_) {
- my @lines = split /\n/;
- my @fstab;
- foreach (@lines) {
- my @fields = split /[ \t]+/;
- if (@fields >= 2) {
- my $spec = $fields[0]; # first column (dev/label/uuid)
- my $file = $fields[1]; # second column (mountpoint)
- if ($spec =~ m{^/} ||
- $spec =~ m{^LABEL=} ||
- $spec =~ m{^UUID=} ||
- $file eq "swap") {
- push @fstab, [$spec, $file]
- }
- }
- }
- $r->{fstab} = \@fstab if @fstab;
- }
-}
-
-# 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 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
-{
- local $_;
- my $r = shift;
-
- my $boot_ini = resolve_windows_path ("/", "boot.ini");
- $r->{boot_ini} = $boot_ini;
-
- if (defined $r->{boot_ini}) {
- $_ = $g->cat ($boot_ini);
- my @lines = split /\n/;
- my $section;
- my $systemroot;
- foreach (@lines) {
- if (m/\[.*\]/) {
- $section = $1;
- } elsif (m/^default=.*?\\(\w+)$/i) {
- $systemroot = $1;
- last;
- } elsif (m/\\(\w+)=/) {
- $systemroot = $1;
- last;
- }
- }
-
- if (defined $systemroot) {
- $r->{systemroot} = resolve_windows_path ("/", $systemroot);
- if (defined $r->{systemroot} && $windows_registry) {
- check_windows_registry ($r, $r->{systemroot});
- }
- }
- }
-}
-
-sub check_windows_registry
-{
- local $_;
- my $r = shift;
- my $systemroot = shift;
-
- # Download the system registry files. Only download the
- # interesting ones, and we don't bother with user profiles at all.
- my $system32 = resolve_windows_path ($systemroot, "system32");
- if (defined $system32) {
- my $config = resolve_windows_path ($system32, "config");
- if (defined $config) {
- my $software = resolve_windows_path ($config, "software");
- if (defined $software) {
- load_windows_registry ($r, $software,
- "HKEY_LOCAL_MACHINE\\SOFTWARE");
- }
- my $system = resolve_windows_path ($config, "system");
- if (defined $system) {
- load_windows_registry ($r, $system,
- "HKEY_LOCAL_MACHINE\\System");
- }
- }
- }
-}
-
-sub load_windows_registry
-{
- local $_;
- my $r = shift;
- my $regfile = shift;
- my $prefix = shift;
-
- my $dir = tempdir (CLEANUP => 1);
-
- $g->download ($regfile, "$dir/reg");
-
- # 'reged' command is particularly noisy. Redirect stdout and
- # stderr to /dev/null temporarily.
- open SAVEOUT, ">&STDOUT";
- open SAVEERR, ">&STDERR";
- open STDOUT, ">/dev/null";
- open STDERR, ">/dev/null";
-
- my @cmd = ("reged", "-x", "$dir/reg", "$prefix", "\\", "$dir/out");
- my $res = system (@cmd);
-
- close STDOUT;
- close STDERR;
- open STDOUT, ">&SAVEOUT";
- open STDERR, ">&SAVEERR";
- close SAVEOUT;
- close SAVEERR;
-
- unless ($res == 0) {
- warn "reged command failed: $?";
- return;
- }
-
- # Some versions of reged segfault on inputs. If that happens we
- # may get no / partial output file. Anyway, if it exists, load
- # it.
- my $content;
- unless (open F, "$dir/out") {
- warn "no output from reged command: $!";
- return;
- }
- { local $/ = undef; $content = <F>; }
- close F;
-
- my @registry = ();
- @registry = @{$r->{registry}} if exists $r->{registry};
- push @registry, $content;
- $r->{registry} = \@registry;
-}
-
-# Because of case sensitivity, the actual path might have a different
-# name, and ntfs-3g is always case sensitive. Find out what the real
-# path is. Returns the correct full path, or undef.
-sub resolve_windows_path
-{
- local $_;
- my $parent = shift; # Must exist, with correct case.
- my $dir = shift;
-
- foreach ($g->ls ($parent)) {
- if (lc ($_) eq lc ($dir)) {
- if ($parent eq "/") {
- return "/$_"
- } else {
- return "$parent/$_"
- }
- }
- }
-
- undef;
-}
-
-sub check_grub
-{
- local $_;
- my $r = shift;
-
- # Grub version, if we care.
-}
-
-#print Dumper (\%fses);
-
-#----------------------------------------------------------------------
-# Now find out how many operating systems we've got. Usually just one.
-
-my %oses = ();
-
-foreach (sort keys %fses) {
- if ($fses{$_}->{is_root}) {
- my %r = (
- root => $fses{$_},
- root_device => $_
- );
- get_os_version (\%r);
- assign_mount_points (\%r);
- $oses{$_} = \%r;
- }
-}
-
-sub get_os_version
-{
- local $_;
- my $r = 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};
-}
-
-sub assign_mount_points
-{
- local $_;
- 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 ($spec);
- if ($dev) {
- $r->{mounts}->{$file} = $dev;
- $r->{filesystems}->{$dev} = $fs;
- if (exists $fs->{used}) {
- $fs->{used}++
- } else {
- $fs->{used} = 1
- }
- }
- }
- }
-}
-
-# Find filesystem by device name, LABEL=.. or UUID=..
-sub find_filesystem
-{
- local $_ = shift;
-
- if (/^LABEL=(.*)/) {
- my $label = $1;
- foreach (sort keys %fses) {
- if (exists $fses{$_}->{label} &&
- $fses{$_}->{label} eq $label) {
- return ($_, $fses{$_});
- }
- }
- warn "unknown filesystem label $label\n";
- return ();
- } elsif (/^UUID=(.*)/) {
- my $uuid = $1;
- foreach (sort keys %fses) {
- if (exists $fses{$_}->{uuid} &&
- $fses{$_}->{uuid} eq $uuid) {
- return ($_, $fses{$_});
- }
- }
- warn "unknown filesystem UUID $uuid\n";
- return ();
- } else {
- return ($_, $fses{$_}) if exists $fses{$_};
-
- 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"});
- }
-
- return () if m{/dev/cdrom};
-
- warn "unknown filesystem $_\n";
- return ();
- }
-}
-
-#print Dumper(\%oses);
-
-#----------------------------------------------------------------------