+ 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;