#!perl -w
# (C) 2003-2007 Willem Jan Hengeveld <itsme@xs4all.nl>
# Web: http://www.xs4all.nl/~itsme/
#      http://wiki.xda-developers.com/
#
# $Id: $
#
# this script can extract data from .hv and .vol files
# these files are used to store registry and databases under windows mobile 2005.
#
# Hive -> consists of several HiveSection's -> consists of a list of Entry's
# 
# Hive
# HiveSection
# Entry
#    Database
#    Record
#    RecordMore
#    Volume
#    Index
#    Hive
#    Key
#    Value
#       String
#       Binary
#       Dword
#       StringList
#       MUI
#    Unknown

use strict;
use IO::File;

# these 2 files have problems, i think they are just corrupt, rgucomp also has problems.
# m:/local/phones/atom/devices/files/default.hv
# m:/local/phones/treo700/devices/files/default.hv
$|=1;
binmode(STDOUT, ":utf8");

sub guidstring {
    my @w= unpack("VvvnNn", $_[0]);
    return sprintf("{%08lx-%04x-%04x-%04x-%08x%04x}", @w);
}
sub bin2utf8 {
    return pack("U*", unpack('v*', $_[0]));
}
sub qescape {
    my $q= shift;

    $q =~ s/[\\"]/\\$&/gs;
    $q =~ s/\r/\\r/gs;
    $q =~ s/\n/\\n/gs;
    $q =~ s/\t/\\t/gs;
    $q =~ s/./(ord($&)<0x20)?sprintf("\\x%02x", ord($&)):$&/ges;
    #$q =~ s/./(ord($&)>=0x100)?sprintf("\\u%02x", ord($&)):$&/ges;

    return $q;
}

package Entry;
use strict;
my %enttypehandler= (
    0x7000 => "Entry::Database",
    0x8000 => "Entry::Record",
    0x9000 => "Entry::RecordMore",
    0xa000 => "Entry::Volume",
    0xe000 => "Entry::Index",   # list or recids + hashvals

    0xb000 => "Entry::Hive",
    0xc000 => "Entry::Key",
    0xd000 => "Entry::Value",
);
sub read_header {
    my ($fh)= @_;
    my $data;
    $fh->read($data, 12) or die sprintf("read entryhdr @%08lx\n", $fh->tell());

    my %hdr;
    (
        $hdr{esize},   # ranges from 0x14 .. 0x31c
        $hdr{etype},   # 0xb000 = hive(fixedlen=0x20), 0xc000 = keyname,  0xd000 = value
        $hdr{eunknown},
        $hdr{eidx},
    )= unpack("vvVV", $data);
    return \%hdr;
}

sub read {
    my ($fh)= @_;
    my $ofs= $fh->tell();
    my $ehdr= read_header($fh);
    $ehdr->{eofs}= $ofs;

    my $edata;
    $fh->read($edata, $ehdr->{esize}) or die sprintf("read entry @%08lx\n", $fh->tell());

    if (exists $enttypehandler{$ehdr->{etype}}) {
        return $enttypehandler{$ehdr->{etype}}->parse($ehdr, $edata);
    }
    else {
        warn sprintf("%08lx: Unknown entry type %04x: %s\n", $ofs, $ehdr->{etype}, unpack("H*", $edata));
        return Entry::Unknown->parse($ehdr, $edata);
    }
}

package Entry::Value;
use strict;

my %valtypehandler= (
    1=>"Entry::Value::String",
    3=>"Entry::Value::Binary",
    4=>"Entry::Value::Dword",
    7=>"Entry::Value::StringList",
   21=>"Entry::Value::MUI",
);
# d000
sub parse {
    my ($cls, $hdr, $data)= @_;
    my $nameval;
    my %ent= %$hdr;
    (
        $ent{nextvalue},     # next value
        $ent{flag1},
        $ent{type},     # value type: 1(string), 3(binary), 4(dword), 7(multisz), 21(mui:resourceptr)
        $ent{valuelen},
        $ent{namelen},
        $ent{flag2},
        $nameval,
    ) = unpack("v4CCa*", $data);
    if (2*$ent{namelen} > length($nameval)) {
        printf("! %08lx WARNING: name(%d) larger than record(%d) @%08lx\n", $ent{eofs}, 2*$ent{namelen}, length($nameval));
    }
    $ent{name}= main::bin2utf8(substr($nameval, 0, 2*$ent{namelen}));
    if (2*$ent{namelen}+$ent{valuelen} > length($nameval)) {
        printf("! %08lx WARNING: value(%d) larger than record(%d) @%08lx\n", $ent{eofs}, 2*$ent{namelen}+$ent{valuelen}, length($nameval));
    }
    if (2*$ent{namelen}+$ent{valuelen} < length($nameval)) {
        $ent{extra}= substr($nameval, 2*$ent{namelen}+$ent{valuelen});
    }
    
    my $vdata=substr($nameval, 2*$ent{namelen}, $ent{valuelen});
    if (exists $valtypehandler{$ent{type}}) {
        $ent{value} = $valtypehandler{$ent{type}}->parse($vdata);
    }
    else {
        $ent{value} = Entry::Value::Binary->parse($vdata, $ent{type});
        #warn sprintf("! %08lx Unknown value type %04x: %s\n", $ent{eofs}, $ent{type}, unpack("H*", $vdata));
    }

    return bless \%ent, $cls;
}
sub as_string {
    my ($self)= @_;
    return sprintf("%08lx %04x: VALUE: %04x:%04x %02x e(%s)  \"%s\"=%s", 
        $self->{eofs}, $self->{eidx}, $self->{nextvalue}, $self->{flag1}, $self->{flag2},
        unpack("H*", $self->{extra}),
        main::qescape($self->{name}), $self->{value}->as_string());
}

sub regdump {
    my ($self)= @_;
    if (lc $self->{name} eq "default") {
        printf("  @=%s\n", $self->{value}->as_string());
    }
    else {
        printf("  \"%s\"=%s\n", main::qescape($self->{name}), $self->{value}->as_string());
    }
}

package Entry::Value::String;
use strict;
sub parse {
    my ($cls, $data)= @_;
    my $value = main::bin2utf8($data);
    $value =~ s/\x00.*//;
    return bless \$value, $cls;
}
sub as_string {
    my ($self)= @_;
    return sprintf("\"%s\"", main::qescape($$self));
}
package Entry::Value::Dword;
use strict;
sub parse {
    my ($cls, $data)= @_;
    my $value= unpack("V", $data);
    return bless \$value, $cls;
}
sub as_string {
    my ($self)= @_;
    return sprintf("dword:%x", $$self);
}
package Entry::Value::Binary;
use strict;
sub parse {
    my ($cls, $data, $type)= @_;
    return bless {
        type=>(defined $type?$type : 3),
        data=>$data
    }, $cls;
}
sub as_string {
    my ($self)= @_;
    my $hex= uc unpack("H*", $self->{data});
    $hex =~ s/..(?=.)/$&,/g;
    if ($self->{type}==3) {
        return sprintf("hex:%s", $hex);
    }
    else {
        return sprintf("hex(%x):%s", $self->{type}, $hex);
    }
}
package Entry::Value::StringList;
use strict;
#todo: "00 00 00 00 00 00 00 00"  should result in several empty strings.
sub parse {
    my ($cls, $data)= @_;
    my $value = main::bin2utf8($data);
    $value =~ s/\x00+$//;
    return bless [split /\x00/, $value], $cls;
}
sub as_string {
    my ($self)= @_;
    return sprintf("multi_sz:\"%s\"", join("\", \"", map { main::qescape($_) } @$self));
}
package Entry::Value::MUI;
use strict;
sub parse {
    my ($cls, $data)= @_;
    my $value = main::bin2utf8($data);
    $value =~ s/\x00.*//;
    return bless \$value, $cls;
}
sub as_string {
    my ($self)= @_;
    return sprintf("mui_sz:\"%s\"", main::qescape($$self));
}
package Entry::Hive;
use strict;
# b000
sub parse {
    my ($cls, $hdr, $data)= @_;
    my %ent = %$hdr;
    my $rest;
    (
        $ent{hkcr},     # ptr to hkcr hive
        $ent{flag1},
        $ent{hkcu},     # ptr to hkcu hive
        $ent{flag2},
        $ent{hklm},     # ptr to hklm hive
        $ent{flag3},
        $ent{hku},      # ptr to hku hive
        $ent{flag4},
        $ent{strnul},   # ??? hku is probably also possible.
        $rest,
    ) = unpack("v8a16a*", $data);
    printf("! %08lx hive  strnul= %s\n", $ent{eofs}, unpack 'H*', $ent{strnul}) if ($ent{strnul} !~ /^\x00+$/);

    if (length($rest)) {
        printf("! WARN: @%08lx:%04x - %d extra bytes in b000/hive record: %s\n", $ent{eofs}, $ent{eidx}, length($rest), unpack("H*", $rest));
    }
    return bless \%ent, $cls;
}
sub as_string {
    my ($self)= @_;
    return sprintf("%08lx %04x: HIVE: %04x:%04x  %04x:%04x  %04x:%04x",
        $self->{eofs}, $self->{eidx},
        $self->{hkcr}, $self->{flag1},
        $self->{hkcu}, $self->{flag2},
        $self->{hklm}, $self->{flag3},
        $self->{hku}, $self->{flag4});
}
sub dump_tree {
    my ($db, $idx, $path)= @_;
    while ($idx) {
        my $key= $db->get_entry($idx);
        if (!defined $key) {
            printf("ERROR: no key for %08lx\n", $idx);
            last;
        }
        $key->regdump($db, $path);
        $idx= $key->{nextkey}
    }
}
sub regdump {
    my ($self, $db)= @_;
    dump_tree($db, $self->{hkcr}, "HKEY_CLASSES_ROOT");
    dump_tree($db, $self->{hkcu}, "HKEY_CURRENT_USER");
    dump_tree($db, $self->{hklm}, "HKEY_LOCAL_MACHINE");
    dump_tree($db, $self->{hku},  "HKEY_USERS");
}
package Entry::Key;
use strict;
# c000
sub parse {
    my ($cls, $hdr, $data)= @_;
    my $nameval;
    my %ent= %$hdr;
    (
        $ent{nextkey},  # key index - next key
        $ent{flag1},    # 2000
        $ent{firstsubkey},     # key index - first subkey
        $ent{flag2},    # 2000
        $ent{firstvalue},     # key index - first value
        $ent{flag3},    # 2000
        $ent{namelen},
        $ent{unused},
        $nameval,
    ) = unpack("v6Ca3a*", $data);
    $ent{name}= main::bin2utf8(substr($nameval, 0, 2*$ent{namelen}));
    return bless \%ent, $cls;
}
sub as_string {
    my ($self)= @_;
    return sprintf("%08lx %04x: KEY: %04x:%04x  %04x:%04x  %04x:%04x unused=%s \"%s\"",
        $self->{eofs}, $self->{eidx}, $self->{nextkey}, $self->{flag1},
        $self->{firstsubkey}, $self->{flag2},
        $self->{firstvalue}, $self->{flag3}, unpack("H*",$self->{unused}), main::qescape($self->{name}));
}

sub regdump {
    my ($self, $db, $parent)= @_;
    my $fullpath= sprintf("%s\\%s", $parent, $self->{name});
    if ($self->{firstvalue} || !$self->{firstsubkey}) {
        printf("[%s]\n", $fullpath);
    }
    my $valueidx= $self->{firstvalue};
    while ($valueidx) {
        my $value= $db->get_entry($valueidx);
        if (!$value) {
            printf("!!!!! NUL value\n");
            last;
        }
        $value->regdump($db, $fullpath);
        $valueidx= $value->{nextvalue};
    }
    if ($self->{firstvalue} || !$self->{firstsubkey}) {
        printf("\n");
    }

    my $subkeyidx= $self->{firstsubkey};
    while ($subkeyidx) {
        my $subkey= $db->get_entry($subkeyidx);
        if (!$subkey) {
            printf("!!!! NUL key\n");
            last;
        }
        $subkey->regdump($db, $fullpath);
        $subkeyidx= $subkey->{nextkey};
    }

}
package Entry::Index;
use strict;
# e000
sub parse {
    my ($cls, $hdr, $data)= @_;
    my %ent= %$hdr;
    my $rest;
    my $reciddata;
    my $hashdata;
    (
        $ent{database}, # 0001 or 0050 or 01b0
        $ent{w1},
        $ent{reccount}, # 000a
        $ent{prev},
        $ent{next},
        $reciddata,
        $ent{w2},
        $hashdata,
        $rest,
    ) = unpack("VvvV2a504Va504a*", $data);
    if (length($rest)) {
        printf("WARN: @%08lx:%04x - %d extra bytes in e000/index record: %s\n", $ent{eofs}, $ent{eidx}, length($rest), unpack("H*", $rest));
    }
    $ent{recids}= [ unpack(sprintf("V%d", $ent{reccount}), $reciddata) ];
    $ent{hashes}= [ unpack(sprintf("V%d", $ent{reccount}), $hashdata) ];

    return bless \%ent, $cls;
}
sub as_string {
    my ($self)= @_;
    return sprintf("%08lx %04x: Index: %08x %04x nr=%04x p=%04x n=%04x",
        $self->{eofs}, $self->{eidx}, 
        $self->{database},
        $self->{w1},
        $self->{reccount},
        $self->{prev},
        $self->{next});
}

package Entry::Database;
use strict;
# 7000
sub parse {
    my ($cls, $hdr, $data)= @_;
    my $fielddata;
    my $dbname;
    my %ent= %$hdr;
    my @indexdata;
    (
        $ent{next},             # 00  next database
        $ent{w2},               # 02
        $ent{w3},               # 04
        $ent{w4},               # 06
        $dbname,                # 08
        $ent{totalrecords},     # 48
        $ent{dw1},              # 4c
        $ent{dw2},              # 50
        $ent{timestamp},        # 54
        $ent{dw3},              # 5c
        $ent{strnul1},          # 60
        @indexdata[0..3],       # 68, a8, e8, 128
    ) = unpack("v4a64VVVa8Va8a64a64a64a*", $data);
    $ent{indexdata}=\@indexdata;
    
    printf("! %08lx database strnul1= %s\n", $ent{eofs}, unpack 'H*', $ent{strnul1}) if ($ent{strnul1} !~ /^\x00+$/);
    $dbname =~ s/(\x00\x00)+$//;
    $ent{name}= main::bin2utf8($dbname);
    return bless \%ent, $cls;
}
sub as_string {
    my ($self)= @_;
    return sprintf("%08lx %04x: DATABASE %04x %04x %04x %04x  nr=%08lx  %08x %08x ts{%s} %08x %-30s  %s %s %s %s",
        $self->{eofs}, $self->{eidx}, 
        $self->{next},               # 00
        $self->{w2},               # 02
        $self->{w3},               # 04
        $self->{w4},               # 06
        $self->{totalrecords},     # 48
        $self->{dw1},              # 4c
        $self->{dw2},              # 50
        unpack("H*",$self->{timestamp}),        # 54
        $self->{dw3},              # 5c
        '"'.main::qescape($self->{name}).'"',
        unpack("H*", $self->{indexdata}[0]),
        unpack("H*", $self->{indexdata}[1]),
        unpack("H*", $self->{indexdata}[2]),
        unpack("H*", $self->{indexdata}[3]));
}

package Entry::Record;
use strict;
# 8000
sub parse {
    my ($cls, $hdr, $data)= @_;
    my %ent= %$hdr;
    my $recdata;
    (
        $ent{database},
        $ent{dw2},
        $ent{flags},
        $ent{rdlen},
        $recdata,
        # list of fieldids, last fieldid has bit24 = 1
        # totalsize
        # 80
        # fieldsize+field
        # fieldsize+field

    ) = unpack("VVvva*", $data);

    my $nfields=0;
    my $ofs= 0;

    while ($ofs<length($recdata)) {
        my $fieldid= unpack("V", substr($recdata, $ofs, 4));
        $ofs += 4;
        my $last = ($fieldid&0xff00);

        $fieldid &= ~0xff00;

        push @{$ent{fieldids}}, $fieldid;
        if ($last != 0 && $last != 0x100) {
            printf("! %08lx record fieldid with %08lx\n", $ent{eofs}, $last);
        }
        last if ($last);
    }
    my $datalen= unpack("v", substr($recdata, $ofs, 2));
    $ofs += 2;
    # ... i don't remember why i assumed 'compressed' .. but in several cases this was not compressed.
    #if ($datalen&0x8000)
    if (1)
    {
        $datalen &= 0x7fff;
        my $i= 0;
        while ($ofs<length($recdata) && $i<@{$ent{fieldids}}) {
            my $type= $ent{fieldids}[$i]&0xff;
            #printf("=%04x: T=%02x %02x\n", $ofs, $type, unpack("C", substr($recdata, $ofs, 1)));
            if ($type==0x1f) {      # CEVT_LPWSTR
                my $fieldlen= unpack("C", substr($recdata, $ofs, 1));
                $ofs++;
                if ($fieldlen/2+$ofs>length($recdata)) {
                    printf("! %08lx  invalid fieldlen: %x (o=%04x l=%04x)\n", $ent{eofs}, $fieldlen, $ofs, length($recdata));
                    last;
                }
                my $field= substr($recdata, $ofs, $fieldlen/2);
                $ofs += $fieldlen/2;
                if ($ofs&1) {
                    $ofs++;
                }
                push @{$ent{fields}}, $field;
            }
            elsif ($type==0x0b) {   # CEVT_R8
                push @{$ent{fields}}, unpack("a8", substr($recdata, $ofs, 8));
                $ofs += 8;
            }
            elsif ($type==0x05) {   # CEVT_BOOL
                push @{$ent{fields}}, unpack("C", substr($recdata, $ofs, 1));
                $ofs += 1;
            }
            elsif ($type==0x13) {   # CEVT_UI4
                #!!! it seems to not use 4 bytes, but 2??
                push @{$ent{fields}}, unpack("V", substr($recdata, $ofs, 2)."\x00\x00\x00");
                $ofs += 2;
            }
            elsif ($type==0x12) {   # CEVT_UI2
                push @{$ent{fields}}, unpack("v", substr($recdata, $ofs, 2)."\x00");
                $ofs += 2;
            }
            elsif ($type==0x02) {   # CEVT_I2
                push @{$ent{fields}}, unpack("v", substr($recdata, $ofs, 2)."\x00");
                $ofs += 2;
            }
            elsif ($type==0x03) {   # CEVT_I4
                push @{$ent{fields}}, unpack("V", substr($recdata, $ofs, 4)."\x00\x00\x00");
                $ofs += 4;
            }
            elsif ($type==0x40) {   # CEVT_FILETIME
                push @{$ent{fields}}, substr($recdata, $ofs, 8);
                $ofs += 8;
            }
            elsif ($type==0x41) {   # CEVT_BLOB
                printf("! %08lx: blob@%04x: %s\n", $ent{eofs}, $ofs, unpack("H*", substr($recdata, $ofs)));
            }
            else {
                printf("! unhandled field type: %02x\n", $type);
            }

            $i++;
        }
    }
    else {
        printf("compressed data @%08lx: dl=%04x  l=%04x : %s\n",
            $ent{eofs},
            $datalen,
            length($recdata)-$ofs, unpack("H*", substr($recdata, $ofs)));
    }

    return bless \%ent, $cls;
}
sub as_string {
    my ($self)= @_;
    return sprintf("%08lx %04x: RECORD: %08lx %08lx %04x %04x {%s} {%s}",
        $self->{eofs}, $self->{eidx}, $self->{database}, $self->{dw2}, $self->{rdlen}, $self->{flags},
    join(",", map { sprintf("%08lx", $self->{fieldids}[$_]) } 0..$#{$self->{fieldids}}),
    join(",", map { unpack("H*", $self->{fields}[$_]) } 0..$#{$self->{fields}}));
}

package Entry::RecordMore;
use strict;
# 9000
sub parse {
    my ($cls, $hdr, $data)= @_;
    my $recdata;
    my %ent= %$hdr;
    (
        $ent{next},
        $ent{data},
    ) = unpack("Va*", $data);
    return bless \%ent, $cls;
}
sub as_string {
    my ($self)= @_;
    return sprintf("%08lx %04x: RMORE: %08lx  ldata=%08lx  %s",
        $self->{eofs}, $self->{eidx}, $self->{next}, length($self->{data}), unpack("H*", $self->{data}));
}

package Entry::Volume;
use strict;
# a000
sub parse {
    my ($cls, $hdr, $data)= @_;
    my %ent= %$hdr;
    my $rest;
    (
        $ent{firstdb},
        $ent{dw2},
        $ent{dw3},
        $rest,
    ) = unpack("V3a*", $data);
    if (length($rest)) {
        printf("WARN: @%08lx:%04x - %d extra bytes in a000/volume record: %s\n", $ent{eofs}, $ent{eidx}, length($rest), unpack("H*", $rest));
    }
    return bless \%ent, $cls;
}
sub as_string {
    my ($self)= @_;
    return sprintf("%08lx %04x: Volume: %08lx %08lx %08lx",
        $self->{eofs}, $self->{eidx}, $self->{firstdb}, $self->{dw2}, $self->{dw3});
}

package Entry::Unknown;
use strict;

sub parse {
    my ($cls, $hdr, $data)= @_;
    my %ent = %$hdr;
    $ent{data}= $data;
    return bless \%ent, $cls;
}
sub as_string {
    my ($self)= @_;
    return sprintf("%08lx %04x: type %04x  length=%08lx  %s",
        $self->{eofs}, $self->{eidx}, $self->{etype}, length($self->{data}), unpack("H*", $self->{data}));
}
package Hive;
use strict;
sub read_hv_header {
    my ($fh)= @_;
    my $baseofs= $fh->tell();
    my $hdrdata;
    $fh->read($hdrdata, 0x1000) or die sprintf("read hive header @%08lx\n", $fh->tell());
    my $list1data;  # todo .. parse this
    my %hdr;
    (
        $hdr{hsize},    # 00 V		 - usually 0x400
        $hdr{nul1},     # 04 V always 0
        $hdr{mike},     # 08 a4 "EKIM"
        $hdr{guid1},    # 0c a16	 - random
        $hdr{nul2},     # 1c V always 0
        $hdr{filesize}, # 20 V
        $hdr{unknown},  # 24 V
        $hdr{guid2},    # 28 a16
        $hdr{strnul1},  # 38 a172 always nul
        $hdr{base},     # e4 v
        $hdr{base2},    # e6 v
        $hdr{nul3},     # e8 V always 0
        $hdr{fff1},     # ec V always -1
        $hdr{strnul2},  # f0 a28
        $list1data,     #10c a*
    )= unpack("VVa4a16VVVa16a172vvVVa28a*", $hdrdata);

#   for (my $i=0 ; $i+16<length($list1data) ; $i+=16) {
#       my $dv= substr($list1data, $i,16);
#       if ($dv ne "\x00" x 16) {
#           printf("%08lx: list1: %08lx %08lx %08lx %08lx\n", $baseofs+$i, unpack("V4", $dv));
#       }
#   }
    
    printf("! %08lx main nul1 = %08lx\n",    4, $hdr{nul1}) if ($hdr{nul1} != 0);
    printf("! %08lx main nul2 = %08lx\n", 0x1c, $hdr{nul2}) if ($hdr{nul2} != 0);
    printf("! %08lx main nul3 = %08lx\n", 0xe8, $hdr{nul3}) if ($hdr{nul3} != 0);
    printf("! %08lx main fff1 = %08lx\n", 0xec, $hdr{fff1}) if ($hdr{fff1} != 0xffffffff);
    printf("! %08lx main strnul1= %s\n", 0x38, unpack 'H*', $hdr{strnul1}) if ($hdr{strnul1} !~ /^\x00+$/);
    printf("! %08lx main strnul2= %s\n", 0xf0, unpack 'H*', $hdr{strnul2}) if ($hdr{strnul2} !~ /^\x00+$/);

    $fh->read($hdrdata, $hdr{base}-0x1000) or die sprintf("read section list @%08lx\n", $fh->tell());

    $hdrdata =~ s/(\x00\x00\x00\x00)+$//;

    if ($hdrdata =~ /^(?:....)+\x00\x00\x00\x00/) {
        printf("! NULLS in 1000 list\n");
    }

    my @ptrs= unpack("V*", $hdrdata);
    if (!@ptrs) {
        push @ptrs, 0;
    }
    $hdr{ptrs}= \@ptrs;

    return \%hdr;
}
sub read {
    my ($cls, $fh)= @_;
    my $hdr= read_hv_header($fh);

    for my $ptr (@{$hdr->{ptrs}}) {
        push @{$hdr->{sections}}, HiveSection->read($fh, $hdr, $ptr);
    }

    return bless $hdr, $cls;
}

sub dump {
    my ($self)= @_;
    printf("HIVE %08lx %s %s %08lx %s %04x %04x\n",
        $self->{hsize},
        $self->{mike},
        main::guidstring($self->{guid1}),
        $self->{filesize},
        main::guidstring($self->{guid2}),
        $self->{base},
        $self->{base2});
    for my $section (@{$self->{sections}}) {
        $section->dump();
    }
}
sub get_entry {
    my ($self, $idx)= @_;
    return if ($idx<0 || $idx>$#{$self->{byidx}});

    return $self->{byidx}[$idx];
}

sub regdump {
    my ($self)= @_;
    my $hive= $self->get_entry(0);
    $hive->regdump($self) if ($hive);
}
package HiveSection;
use strict;
use IO::File;
sub read_section_hdr {
    my ($fh)= @_;
    my $data;
    $fh->read($data, 12) or die sprintf("read section header @%08lx\n", $fh->tell());
    my %hdr;
    (
        $hdr{magic},    # V 0x20001004
        undef,          # V random
        $hdr{idx},      # V
    )= unpack("VVV", $data);
    $fh->read($data, 1024*4) or die sprintf("read entry ptrs @%08lx\n", $fh->tell());
    my @ptrs= unpack("V*", $data);
    $fh->read($data, 4) or die sprintf("read used ptrs @%08lx\n", $fh->tell());
    (
        $hdr{nptrs},
        undef
    )= unpack("vv", $data);

    #$hdr{nptrs} = 1024 if ($hdr{nptrs}==0);

    for (0..1023) {
        if ($ptrs[$_]&1) {
            push @{$hdr{ptrs}} , ($ptrs[$_]&0xfffffff)-1;
            push @{$hdr{flags}} , ($ptrs[$_]>>28);
        }
    }
    return \%hdr;
}
sub read {
    my ($cls, $fh, $hhdr, $ptr)= @_;
    $fh->seek($hhdr->{base}+$ptr, SEEK_SET);
    my $shdr= read_section_hdr($fh);
    for my $i (0..$#{$shdr->{ptrs}}) {
        $fh->seek($hhdr->{base}+$shdr->{ptrs}[$i], SEEK_SET);
        my $entry= Entry::read($fh);
        push @{$shdr->{entries}}, $entry;

        $hhdr->{byidx}[$entry->{eidx}]= $entry;
    }
    return bless $shdr, $cls;
}
sub dump {
    my ($self)= @_;
    printf("HIVESECTION  %08lx %d  %d  count=%d\n", $self->{magic}, $self->{idx}, $self->{nptrs}, $#{$self->{ptrs}}+1);

    for my $i (0..$#{$self->{entries}}) {
        printf("%04x: %d %s\n", $i, $self->{flags}[$i], $self->{entries}[$i]->as_string());
    }
}

package main;
use strict;
use IO::File;
use Dumpvalue;
$|=1;
my $d= new Dumpvalue;

my $fn= shift or die "need fn\n";

my $fh= IO::File->new($fn, "r") or die "$fn: $!\n";
binmode $fh;

my $hive= Hive->read($fh);

if ($fn =~ /\.hv/) {
    $hive->regdump();
}
else {
    $hive->dump();
}

#printf("fpos=%08lx fsiz=%08lx  hsize=%08lx\n", $fh->tell(), -s $fh, $hive->{filesize});
$fh->close();

exit(0);