#!/usr/bin/perl

# Parses Windows Mozilla registry.dat file

use strict;
use English;
use Getopt::Std;
use IO::Handle;
use Fcntl qw/SEEK_SET/;
use XML::Simple;
use Data::Dumper;

use vars qw/$opt_f/;

getopts('f:');

sub usage {
  my ($msg) = @_;
  print STDERR "$msg\n";
  die "Usage: $0 -f file\n";
}

my $fd;
if(defined $opt_f) {
  open(MOZ, "<$opt_f") || die "Cannot open $opt_f ($ERRNO)\n";
  $fd = \*MOZ;
} else {
  $fd = \*STDIN;
}

my $buffer;
binmode($fd, ":raw");
my $n = sysread($fd, $buffer, 16);
if($n < 16) {
  die "Short read for header\n";
}

my ($magic, $ver_major, $ver_minor, $avail, $root) = unpack("LSSLL", $buffer);
#printf("Header: %8x %4x %4x %8x root=%-8x\n", $magic, $ver_major, $ver_minor, $avail, $root);

sub readString {
  my($offset, $len) = @_;

  my $buffer;
  sysseek $fd, $offset, SEEK_SET;
  $n = sysread $fd, $buffer, $len;
  if($n < $len) {
    die "Short read for string\n";
  }
  return $buffer;
}

sub strip {
  my ($v) = @_;
  if($v =~ /(.*)\0/) {
    return $1;
  } else {
    return $v;
  }
}

sub readEntry {
  my ($offset, $indent, $realParent) = @_;
  my $entry=();

  my $buffer;
  sysseek $fd, $offset, SEEK_SET;
  $n = sysread $fd, $buffer, 32;
  if($n < 32) {
    die sprintf("Short read %d for entry at %x\n", $n, $offset);
  }

  my ($location, $namePtr, $nameLen, $type, $left, $down,
      $valuePtr, $valueLen, $parent) =
	unpack("LLSSLLLLL", $buffer);

  if($location != $offset) {
    die sprintf("Location mismatch at %x: %x != %x\n", $offset,
		$offset, $location);
  }

  if($parent != $realParent) {
    die "Parent mismatch at $offset: $parent != $realParent\n";
  }

  my $name = readString($namePtr, $nameLen);

  $entry->{name} = [ strip($name) ];
  $entry->{type} = [ $type ];
#  $entry->{offset} = [ sprintf("0x%04x-0x%04x entry", $offset, $offset+32) ];
#  $entry->{next} = [ sprintf("0x%x", $left) ];
  $entry->{down} = [ sprintf("0x%x", $down) ];

#  push(@{$entry->{offset}}, sprintf("0x%04x-0x%04x name %s", $namePtr, $namePtr+$nameLen, strip($name)));


#  my $value;
#  $value = readString($namePtr, $nameLen);

#  printf("%s[%x]: %x:\"%s\" type=%x vptr=%x vl=%x\n",
#	 $indent, $location, $namePtr, $name, $type,
#	 $valuePtr, $valueLen);
  if(($type & 0x10) == 0) {
    if($valuePtr != 0) {
#      printf "Descending from $name into value %x\n", $valuePtr;
      $entry->{atom} = readEntry($valuePtr, $indent . '  ', $location);
    }
    if($down != 0) {
#      printf "Descending from $name down into %x\n", $valuePtr;
      $entry->{dir} = readEntry($down, $indent . '  ', $location);
    }
  } else {
#    printf("%sDown=%x Value=%x:\"%s\"\n", $indent, $down, $valuePtr,
#	   readString($valuePtr, $valueLen));

#    push(@{$entry->{offset}}, sprintf("0x%04x-0x%04x value",
#				      $valuePtr, $valuePtr+$valueLen));
    my $value = readString($valuePtr, $valueLen);
    if($type eq 0x13) {
      $value =~ s/(.)/sprintf("%02x",ord($1))/ge;
      $value = '0x'.$value;
    }
    $entry->{value} = [ strip($value) ];
  }

  if($left != 0) {
    return [$entry, @{readEntry($left, $indent, $realParent)}];
  }

  return [ $entry ];
}

my $entry=readEntry($root,'  ',0);

#print Dumper($entry->[0]);
print XMLout($entry->[0]);