#!perl -w
# (C) 2003-2007 Willem Jan Hengeveld <itsme@xs4all.nl>
# Web: http://www.xs4all.nl/~itsme/
#      http://wiki.xda-developers.com/
#
# $Id$
#
# in the output numbers prefixed with '_' are offsets from the start of the MZ header
# with 'v' are absolute virtual addresses
# with 'r' are numbers relative to the virtual base address
#
# problems:
#    nk.exe pdata segment is not handled correctly.... problem is probably with dumprom
#
#    - look at c:\windows\system32\systray.exe
#         GetModuleHandleW  is listed with a different ordinal than it actually has.
#    - look at c:\windows\system32\user32.dll
#             many ntdll.dll imports seem to be by 'hint' iso ordinal.

# todo: add options to list used dll's only
#
use strict;
$|=1;
use IO::File;
use Getopt::Long;
use Data::Dumper;
use Carp;
my $bRecursive = 0;

my $verbose;
my %symbolsbyname;
my %symbolsbyord;
my @symbollist;

sub usage {
return <<__EOF__
Usage: peinfo [-r] [files]
      -r   recurse into directories
__EOF__
}
GetOptions(
    "r" => \$bRecursive,
    "v" => \$verbose,
) or die usage();


if (@ARGV==0) {
    die usage();
}
for (@ARGV) {
    if (-f $_) {
        eval { ProcessFile($_); }; if ($@) { warn "$@\n"; }
    }
    elsif (-d $_) {
        ProcessDirectory($_);
    }
    else {
        for (glob($_)) {
            if (-f $_) {
                eval { ProcessFile($_); }; if ($@) { warn "$@\n"; }
            }
            elsif (-d $_) {
                ProcessDirectory($_);
            }
        }
    }
}
# note discrepancies between imp-hint, and symbol-hint
for (my $i=0 ; $i<@symbollist ; $i++) {
    my $symbol= $symbollist[$i];
    for my $imp (@{$symbol->{imports}}) {
        if (exists $imp->{hint} && $symbol->{hint}
                && $imp->{hint}!=$symbol->{hint}) {
            printf("%s:%s  %s   %s != %s\n",
                $symbol->{dllname}, $symbol->{name}||"ordinal $symbol->{ordinal}",
                $imp->{dllname}, $imp->{hint}, $symbol->{hint});
        }
    }
}
#$Data::Dumper::Useqq = 1;
#$Data::Dumper::Purity = 1;
#$Data::Dumper::Terse= 1;
#print Dumper(\@symbollist);

# dump symbol usage xref
printf("-----------\n");
for (my $i=0 ; $i<@symbollist ; $i++) {
    my $sym= $symbollist[$i];
    printf("%s:ord%04d %s\n", 
        $sym->{dllname}, 
        exists $sym->{ordinal} ? $sym->{ordinal} : 0xffff, 
        exists $sym->{name} ? $sym->{name}:"");
    for (my $j=0 ; $j<@{$sym->{imports}} ; $j++) {
        my $use= $sym->{imports}[$j];
        printf("* %s  %s:ord%04d %s\n", 
            $use->{dllname}, 
            $sym->{dllname}, 
            exists $sym->{ordinal} ? $sym->{ordinal} : 0xffff, 
            exists $sym->{name} ? $sym->{name}:"");
    }

}
exit(0);

sub ProcessDirectory {
    my ($path)= @_;
    #print "search $bRecursive path '$path' for '$pattern'\n";

    opendir(DIR, $path) or warn "$!: reading $path\n";
    my @files= readdir DIR;
    closedir DIR;

    for (@files) {
        next if ($_ eq "." || $_ eq "..");
        my $file= makeFullPath($path, $_);
        if (-f $file) {
            eval { ProcessFile($file); }; if ($@) { warn "$@\n"; }
        }
        elsif ($bRecursive && -d $file)
        {
            ProcessDirectory($file);
        }
    }
}
sub makeFullPath {
    my ($full, @parts)= @_;

    $full ||="";
    for my $path (@parts) {
        next if (!defined $path);
        $path =~ s{^/}{};         # remove leading slash
        $full =~ s{/?$}{/$path};  # remove trailing slash, append path
    }

    return $full;
}

sub ProcessFile {
    my ($fn)= @_;
    my $file= {
        filepath=>$fn,
    };
    ($file->{realname}= $fn) =~ s/.*[\/\\]//;
    my $fh= IO::File->new($file->{filepath},"r") or croak "open $file->{filepath}: $!\n";
    binmode $fh;

    printf("DUMP of %s\n", $file->{filepath}) if $verbose;

    eval {
        $file->{mz}= ReadMZHeader($fh, 0);
    }; if ($@) { warn "$@\n"; return; }

    DumpMZHeader($file->{mz}, 0) if ($verbose);

    my $mzofs= $file->{mz}{cp}*0x200 - ($file->{mz}{cblp}?0x200-$file->{mz}{cblp}:0);
    if ($mzofs>= -s $fh) {
        warn sprintf("%s: MZ code offset too large: %08lx\n", $fn, $mzofs);
    }
    else {
        eval {
            $file->{mzcode}= ReadMZCode($fh, $file->{mz}{cparhdr}*16, $mzofs);
            $file->{dansrich}= GetDanSRich($file->{mzcode}, $file->{mz}{cparhdr}*16);
            DumpDanSRich($file->{dansrich}) if ($file->{dansrich} && $verbose);
        };  if ($@) { warn "$@\n"; }
    }
    #used by rva function to convert rva->fileofs.
    $file->{pe}= ReadPEHeader($fh, $file->{mz}{lfanew});

    DumpPEHeader($file, $file->{pe}, $file->{mz}{lfanew}) if $verbose;

    CheckPESanity($file);

    if ($file->{pe}{EXP}{rva}) {
        eval {
            $file->{exports}= ReadExportTable($file, $fh, $file->{pe}{EXP}{rva}, $file->{pe}{EXP}{size}) if $file->{pe}{EXP}{rva};
        };  if ($@) { warn "$@\n"; }
	# NOTE: design bug: dumpexporttable also calcs symbollist.
        DumpExportTable($file, $file->{exports}, $file->{pe}{EXP}{rva});
    }

    if ($file->{pe}{IMP}{rva}) {
        eval {
            $file->{imports}= ReadImportTable($file, $fh, $file->{pe}{IMP}{rva}, $file->{pe}{IMP}{size}) if $file->{pe}{IMP}{rva};
        };  if ($@) { warn "$@\n"; }
	# NOTE: design bug: dumpimporttable also calcs symbollist.
        DumpImportTable($file, $file->{imports}, $file->{pe}{IMP}{rva});
    }

    if ($file->{pe}{SEC}{rva}) {
        $file->{security}= ReadSecurityTable($fh, $file->{pe}{SEC}{rva}, $file->{pe}{SEC}{size});
    }

    # EXP EXPORT          0   // Export Directory
    # IMP IMPORT          1   // Import Directory
    # RES RESOURCE        2   // Resource Directory
    # EXC EXCEPTION       3   // Exception Directory
    # SEC SECURITY        4   // Security Directory
    # FIX BASERELOC       5   // Base Relocation Table
    # DEB DEBUG           6   // Debug Directory
    # IMD COPYRIGHT       7   // (X86 usage)
    # MSP ARCHITECTURE    7   // Architecture Specific Data
    # TLS GLOBALPTR       8   // RVA of GP
    # CBK TLS             9   // TLS Directory
    # RS1 LOAD_CONFIG    10   // Load Configuration Directory
    # RS2 BOUND_IMPORT   11   // Bound Import Directory in headers
    # RS3 IAT            12   // Import Address Table
    # RS4 DELAY_IMPORT   13   // Delay Load Import Descriptors
    # RS5 COM_DESCRIPTOR 14   // COM Runtime descriptor

    if ($file->{pe}{RES}{rva}) {
        $file->{resources}= ReadResourceTable($file, $fh, $file->{pe}{RES}{rva}, $file->{pe}{RES}{size});
    }

    for (qw(EXC FIX DEB IMD MSP TLS CBK RS3 RS4 RS5)) {
        if ($file->{pe}{$_}{rva}) {
            $file->{"table_$_"}= ReadRvaData($file, $fh, $file->{pe}{$_}{rva}, $file->{pe}{$_}{size}, $_);
        }
    }
    for (qw(RS1)) {
        if ($file->{pe}{$_}{rva}) {
            $file->{"table_$_"}= ReadFileData($fh, $file->{pe}{$_}{rva}, $file->{pe}{$_}{size}, $_);
        }
    }

    printf("_%08lx~~~~~ end of file\n", -s $fh) if $verbose;


    print "\n" if $verbose;
    #$Data::Dumper::Useqq = 1;
    #$Data::Dumper::Purity = 1;
    #$Data::Dumper::Terse= 1;
    #print Dumper($file);
}

sub rva2file {
    my ($file, $rva)= @_;
    my $minrva;
    for (@{$file->{pe}{o32}}) {
        if ($_->{rva} <= $rva && $rva < $_->{rva}+$_->{vsize}) {
            return $rva-$_->{rva}+$_->{dataptr};
        }
        if (!defined $minrva || $minrva->{rva}>$_->{rva}) {
            $minrva= $_;
        }
    }
    if ($rva < $minrva->{rva}) {
        # use filebase
        return $rva;
    }
    return
}
sub rva2vbase {
    my ($file, $rva)= @_;
    if ($rva&0x80000000) {
        return $file->{pe}{vbase} - ~$rva - 1;
    }
    else {
        return $file->{pe}{vbase} + $rva;
    }
}
sub DumpMZHeader {
    my ($mz, $fileofs)= @_;
    my %fmt= (
        magic=>    { ofs=>0x00, fmt=>"%s" },
        cblp=>     { ofs=>0x02, fmt=>"%04x" },
        cp=>       { ofs=>0x04, fmt=>"%04x" },
        crlc=>     { ofs=>0x06, fmt=>"%04x" },
        cparhdr=>  { ofs=>0x08, fmt=>"%04x" },
        minalloc=> { ofs=>0x0a, fmt=>"%04x" },
        maxalloc=> { ofs=>0x0c, fmt=>"%04x" },
        ss=>       { ofs=>0x0e, fmt=>"%04x" },
        sp=>       { ofs=>0x10, fmt=>"%04x" },
        csum=>     { ofs=>0x12, fmt=>"%04x" },
        ip=>       { ofs=>0x14, fmt=>"%04x" },
        cs=>       { ofs=>0x16, fmt=>"%04x" },
        lfarlc=>   { ofs=>0x18, fmt=>"%04x" },
        ovno=>     { ofs=>0x1a, fmt=>"%04x" },
        res=>      { ofs=>0x1c, fmt=>"%04x" },
        oemid=>    { ofs=>0x24, fmt=>"%04x" },
        oeminfo=>  { ofs=>0x26, fmt=>"%04x" },
        res2=>     { ofs=>0x28, fmt=>"%04x" },
        lfanew=>   { ofs=>0x3c, fmt=>"_%08x" },
    );
    for my $key (sort { $fmt{$a}{ofs} <=> $fmt{$b}{ofs} } keys %fmt) {
        printf("_%08x %-10s ", $fileofs+$fmt{$key}{ofs}, $key);
        if (ref $mz->{$key} eq "ARRAY") {
            for my $i (0..$#{$mz->{$key}}) {
                printf(" $fmt{$key}{fmt}", $mz->{$key}[$i]);
            }
            print "\n";
        }
        else {
            printf(" $fmt{$key}{fmt}\n", $mz->{$key});
        }
    }
}
sub ReadMZHeader {
    my ($fh, $fileofs)= @_;

    $fh->seek($fileofs, SEEK_SET) or croak "seek to mz header: $!\n";

    my $data;
    $fh->read($data, 0x40) or croak sprintf("read mz header at %08x: %s\n", $fileofs, $!);
    my %mz;

    (
        $mz{magic},         # 0000 A2 Magic number                  == 'MZ'
        $mz{cblp},          # 0002 v  Bytes on last page of file
        $mz{cp},            # 0004 v Pages in file
        $mz{crlc},          # 0006 v Relocations                   == 0000
        $mz{cparhdr},       # 0008 v Size of header in paragraphs  == 0004
        $mz{minalloc},      # 000a v Minimum extra paragraphs needed
        $mz{maxalloc},      # 000c v Maximum extra paragraphs needed
        $mz{ss},            # 000e v Initial (relative) SS value
        $mz{sp},            # 0010 v Initial SP value
        $mz{csum},          # 0012 v Checksum
        $mz{ip},            # 0014 v Initial IP value
        $mz{cs},            # 0016 v Initial (relative) CS value
        $mz{lfarlc},        # 0018 v File address of relocation table
        $mz{ovno},          # 001a v Overlay number
        @{$mz{res}}[0..3],  # 001c v Reserved words

        $mz{oemid},         # 0024 v OEM identifier (for e_oeminfo)
        $mz{oeminfo},       # 0026 v OEM information; e_oemid specific
        @{$mz{res2}}[0..9], # 0028 v Reserved words

        $mz{lfanew}         # 003c V File address of new exe header
    ) = unpack("A2v29V", $data);

    $mz{lfanew}= MakeFileOffset($mz{lfanew});   # file offset

    croak "MZ header does not start with MZ\n" if ($mz{magic} ne "MZ");
    warn "MZ header contains relocation info\n" if ($mz{crlc});

    printf("_%08x      : mz header\n", $fileofs) if $verbose;

    return \%mz;
}
sub ReadMZCode {
    my ($fh, $fileofs, $len)= @_;
    $fh->seek($fileofs, SEEK_SET) or croak "seek to mz header: $!\n";

    my $data;
    $fh->read($data, $len) or croak sprintf("read mz code at %08x: %s\n", $fileofs, $!);

    printf("_%08x      : mz code\n", $fileofs) if $verbose;
    return $data;
}

sub DumpDanSRich {
    my ($dans)= @_;
    printf("_%08x : %s\n", $dans->{ofs}, join(", ", map { sprintf("%d x %08x", $_->{count}, $_->{compid}); } @{$dans->{list}}));
}

# returns undef
#    or  [  {compid=>.., count=>..} .. ]
sub GetDanSRich {
    my ($data, $fileofs)= @_;
    my @dwords= unpack("V256", $data);
    my $i=0;
    # find 'Rich'
    while ($i<@dwords && $dwords[$i]!=0x68636952) { $i++; }

    return if ($i==@dwords);  # not found

    my $i_rich= $i;
    my $xorval= $dwords[$i_rich+1];

    while ($i>0 && ($dwords[$i]^$xorval)!=0x536e6144) { $i--; }
    return if ($i==0);  # not found
    my $i_dans= $i;

    my @dans_rich;
    for ($i= $i_dans+4 ; $i<$i_rich ; $i+=2) {
        push @dans_rich, { compid=>$dwords[$i]^$xorval, count=>$dwords[$i+1]^$xorval };
    }
    return {
        ofs=>$fileofs+4*$i_dans,
        list=>\@dans_rich,
    };
}

sub DumpPEHeader {
    my ($file, $pe, $fileofs)= @_;
    my %fmt= (
        magic=>,         { ofs=>0x0000, fmt=>"%s", desc=>"Magic number E32_MAGIC" },
        cpu=>,           { ofs=>0x0004, fmt=>"%04x", desc=>"The CPU type" },
        objcnt=>,        { ofs=>0x0006, fmt=>"%04x", desc=>"Number of memory objects" },
        timestamp=>,     { ofs=>0x0008, fmt=>"%08x", desc=>"Time EXE file was created/modified" },
        symtaboff=>,     { ofs=>0x000c, fmt=>"%08x", desc=>"Offset to the symbol table" },

        symcount=>,      { ofs=>0x0010, fmt=>"%08x", desc=>"Number of symbols" },
        opthdrsize=>,    { ofs=>0x0014, fmt=>"%04x", desc=>"Optional header size" },
        imageflags=>,    { ofs=>0x0016, fmt=>"%04x", desc=>"Image flags" },

        # here the optionalheader starts
        coffmagic=>,     { ofs=>0x0018, fmt=>"%04x", desc=>"Coff magic number (usually 0x10b)" },
        linkmajor=>,     { ofs=>0x001a, fmt=>"%02x", desc=>"The linker major version number" },
        linkminor=>,     { ofs=>0x001b, fmt=>"%02x", desc=>"The linker minor version number" },
        codesize=>,      { ofs=>0x001c, fmt=>"%08x", desc=>"Sum of sizes of all code sections" },

        initdsize=>,     { ofs=>0x0020, fmt=>"%08x", desc=>"Sum of all initialized data size" },
        uninitdsize=>,   { ofs=>0x0024, fmt=>"%08x", desc=>"Sum of all uninitialized data size" },
        entryrva=>,      { ofs=>0x0028, fmt=>"r%08x", desc=>"rva Relative virt. addr. of entry point" },
        codebase=>,      { ofs=>0x002c, fmt=>"r%08x", desc=>"rva Address of beginning of code section" },

        database=>,      { ofs=>0x0030, fmt=>"r%08x", desc=>"rva Address of beginning of data section" },
        vbase=>,         { ofs=>0x0034, fmt=>"%08x", desc=>"Virtual base address of module" },
        objalign=>,      { ofs=>0x0038, fmt=>"%08x", desc=>"Object Virtual Address align. factor" },
        filealign=>,     { ofs=>0x003c, fmt=>"%08x", desc=>"Image page alignment/truncate factor" },

        osmajor=>,       { ofs=>0x0040, fmt=>"%04x", desc=>"The operating system major ver. no." },
        osminor=>,       { ofs=>0x0042, fmt=>"%04x", desc=>"The operating system minor ver. no." },
        usermajor=>,     { ofs=>0x0044, fmt=>"%04x", desc=>"The user major version number" },
        userminor=>,     { ofs=>0x0046, fmt=>"%04x", desc=>"The user minor version number" },
        subsysmajor=>,   { ofs=>0x0048, fmt=>"%04x", desc=>"The subsystem major version number" },
        subsysminor=>,   { ofs=>0x004a, fmt=>"%04x", desc=>"The subsystem minor version number" },
        res1=>,          { ofs=>0x004c, fmt=>"%08x", desc=>"Reserved bytes - must be 0" },

        vsize=>,         { ofs=>0x0050, fmt=>"%08x", desc=>"Virtual size of the entire image" },
        hdrsize=>,       { ofs=>0x0054, fmt=>"%08x", desc=>"Header information size" },
        filechksum=>,    { ofs=>0x0058, fmt=>"%08x", desc=>"Checksum for entire file" },
        subsys=>,        { ofs=>0x005c, fmt=>"%04x", desc=>"The subsystem type" },
        dllflags=>,      { ofs=>0x005e, fmt=>"%04x", desc=>"DLL flags" },

        stackmax=>,      { ofs=>0x0060, fmt=>"%08x", desc=>"Maximum stack size" },
        stackinit=>,     { ofs=>0x0064, fmt=>"%08x", desc=>"Initial committed stack size" },
        heapmax=>,       { ofs=>0x0068, fmt=>"%08x", desc=>"Maximum heap size" },
        heapinit=>,      { ofs=>0x006c, fmt=>"%08x", desc=>"Initial committed heap size" },

        res2=>,          { ofs=>0x0070, fmt=>"%08x", desc=>"Reserved bytes - must be 0" },
        hdrextra=>,      { ofs=>0x0074, fmt=>"%08x", desc=>"Number of extra info units in header" },

    );
    for my $key (sort { $fmt{$a}{ofs} <=> $fmt{$b}{ofs} } keys %fmt) {
        printf("_%08x %-10s ", $fileofs + $fmt{$key}{ofs}, $key);
        if (ref $pe->{$key} eq "ARRAY") {
            for my $i (0..$#{$pe->{$key}}) {
                printf(" $fmt{$key}{fmt}", $pe->{$key}[$i]);
            }
            print "\n";
        }
        else {
            printf(" $fmt{$key}{fmt}\n", $pe->{$key});
        }
    }
    my @tables= qw(EXP IMP RES EXC SEC FIX DEB IMD MSP TLS CBK RS1 RS2 RS3 RS4 RS5);
    for my $i (0..$#tables) {
        if ($tables[$i] eq "SEC" || $tables[$i] eq "RS1") {
            printf("_%08x %-10s _%08x %08x\n",
                $fileofs+0x78+8*$i, $tables[$i],
                $pe->{$tables[$i]}{rva}, $pe->{$tables[$i]}{size})
        }
        else {
            printf("_%08x %-10s r%08x v%08x %08x\n",
                $fileofs+0x78+8*$i, $tables[$i],
                $pe->{$tables[$i]}{rva},
                rva2vbase($file, $pe->{$tables[$i]}{rva}),
                $pe->{$tables[$i]}{size})
        }
    }

    for my $i (0..$#{$pe->{o32}}) {
        printf("............... o32\n");
        DumpO32Header($pe->{o32}[$i], $fileofs+0x18+$pe->{opthdrsize}+0x28*$i);

        printf("_%08lx  ======== r%08lx %d:%s\n", $pe->{o32}[$i]{dataptr}, $pe->{o32}[$i]{rva}, $i, $pe->{o32}[$i]{name});
        printf("_%08lx~ ======== r%08lx v-end of %d:%s\n", $pe->{o32}[$i]{dataptr}+$pe->{o32}[$i]{vsize}, $pe->{o32}[$i]{rva}+$pe->{o32}[$i]{vsize}, $i, $pe->{o32}[$i]{name});
        printf("_%08lx~ ======== r%08lx p-end of %d:%s\n", $pe->{o32}[$i]{dataptr}+$pe->{o32}[$i]{psize}, $pe->{o32}[$i]{rva}+$pe->{o32}[$i]{psize}, $i, $pe->{o32}[$i]{name});
        printf("\n");
    }
}

sub ReadPEHeader {
    my ($fh, $fileofs)= @_;

    $fh->seek($fileofs, SEEK_SET) or croak "seek to pe header: $!\n";

    my $data;
    $fh->read($data, 0xf8) or croak sprintf("@%08lx: read pe header: $!\n", $fileofs);
    my %pe;

    my $infdata;
    (
        $pe{magic},      # A4 Magic number E32_MAGIC
        $pe{cpu},        # v  The CPU type
        $pe{objcnt},     # v  Number of memory objects
        $pe{timestamp},  # V  Time EXE file was created/modified
        $pe{symtaboff},  # V  Offset to the symbol table

        $pe{symcount},   # V  Number of symbols
        $pe{opthdrsize}, # v  Optional header size
        $pe{imageflags}, # v  Image flags

        # optheader:
        $pe{coffmagic},  # v  Coff magic number (usually 0x10b)
        $pe{linkmajor},  # C  The linker major version number
        $pe{linkminor},  # C  The linker minor version number
        $pe{codesize},   # V  Sum of sizes of all code sections

        $pe{initdsize},  # V  Sum of all initialized data size
        $pe{uninitdsize},# V  Sum of all uninitialized data size
        $pe{entryrva},   # V  rva Relative virt. addr. of entry point
        $pe{codebase},   # V  rva Address of beginning of code section

        $pe{database},   # V  rva Address of beginning of data section
        $pe{vbase},      # V  Virtual base address of module
        $pe{objalign},   # V  Object Virtual Address align. factor
        $pe{filealign},  # V  Image page alignment/truncate factor

        $pe{osmajor},    # v  The operating system major ver. no.
        $pe{osminor},    # v  The operating system minor ver. no.
        $pe{usermajor},  # v  The user major version number
        $pe{userminor},  # v  The user minor version number
        $pe{subsysmajor},# v  The subsystem major version number
        $pe{subsysminor},# v  The subsystem minor version number
        $pe{res1},       # V  Reserved bytes - must be 0

        $pe{vsize},      # V  Virtual size of the entire image
        $pe{hdrsize},    # V  Header information size
        $pe{filechksum}, # V  Checksum for entire file
        $pe{subsys},     # v  The subsystem type
        $pe{dllflags},   # v  DLL flags

        $pe{stackmax},   # V  Maximum stack size
        $pe{stackinit},  # V  Initial committed stack size
        $pe{heapmax},    # V  Maximum heap size
        $pe{heapinit},   # V  Initial committed heap size

        $pe{res2},       # V  Reserved bytes - must be 0
        $pe{hdrextra},   # V  Number of extra info units in header
        $infdata
    ) = unpack("A4v2V3v3C2V9v6V4v2V6a*", $data.("\x00" x (0xf8-length($data))));

    croak sprintf("PE header at %08x does not start with PE, but with %s\n", $fileofs, $pe{magic}) if ($pe{magic} ne "PE");

    $pe{entryrva}= MakeRvaOffset($pe{entryrva});
    $pe{codebase}= MakeRvaOffset($pe{codebase});
    $pe{database}= MakeRvaOffset($pe{database});

    my @dw= unpack("V*", $infdata);
    my @tabs= qw(EXP IMP RES EXC SEC FIX DEB IMD MSP TLS CBK RS1 RS2 RS3 RS4 RS5);
    for (0..$#tabs) {
        $pe{$tabs[$_]} = {
            rva=> ( $tabs[$_] eq "SEC" || $tabs[$_] eq "RS1" )
                ? MakeFileOffset($dw[$_*2])
                : MakeRvaOffset($dw[$_*2]),
            size=>$dw[$_*2+1],
        };
    }

    for (0..$pe{objcnt}-1) {
        push @{$pe{o32}}, ReadO32Header($fh, $_, $fileofs+0x18+$pe{opthdrsize}+0x28*$_);
    }

    printf("_%08x      : pe header\n", $fileofs) if $verbose;
    return \%pe;
}
sub DumpO32Header {
    my ($o32, $fileofs)= @_;
    my %fmt= (
        name=>,          { ofs=>0x0000, fmt=>"%s", desc=>"Object name" },
        vsize=>,         { ofs=>0x0008, fmt=>"%08x", desc=>"Virtual memory size" },
        rva=>,           { ofs=>0x000c, fmt=>"r%08x", desc=>"Object relative virtual address" },
        psize=>,         { ofs=>0x0010, fmt=>"%08x", desc=>"Physical file size of init. data" },
        dataptr=>,       { ofs=>0x0014, fmt=>"_%08x", desc=>"Image pages offset" },
        realaddr=>,      { ofs=>0x0018, fmt=>"%08x", desc=>"pointer to actual" },
        access=>,        { ofs=>0x001c, fmt=>"%08x", desc=>"assigned access" },
        temp3=>,         { ofs=>0x0020, fmt=>"%08x", desc=>"" },
        flags=>,         { ofs=>0x0024, fmt=>"%08x", desc=>"" },
    );
    for my $key (sort { $fmt{$a}{ofs} <=> $fmt{$b}{ofs} } keys %fmt) {
        printf("_%08x %-10s ", $fileofs+$fmt{$key}{ofs}, $key);
        if (ref $o32->{$key} eq "ARRAY") {
            for my $i (0..$#{$o32->{$key}}) {
                printf(" $fmt{$key}{fmt}", $o32->{$key}[$i]);
            }
            print "\n";
        }
        else {
            printf(" $fmt{$key}{fmt}\n", $o32->{$key});
        }
    }
}
sub ReadO32Header {
    my ($fh, $i, $fileofs)= @_;

    $fh->seek($fileofs, SEEK_SET) or croak "seek to o32 header: $!\n";

    my $data;
    $fh->read($data, 0x28) or croak "read o32 header: $!\n";
    my %o32;
    (
        $o32{name},       # 00 Object name
        $o32{vsize},      # 08 Virtual memory size
        $o32{rva},        # 0c Object relative virtual address
        $o32{psize},      # 10 Physical file size of init. data
        $o32{dataptr},    # 14 Image pages offset
        $o32{realaddr},   # 18 pointer to actual
        $o32{access},     # 1c assigned access
        $o32{temp3},      # 20
        $o32{flags},      # 24 Attribute flags for the object
    ) = unpack("A8V8", $data);
    $o32{rva} = MakeRvaOffset($o32{rva});
    $o32{dataptr} = MakeFileOffset($o32{dataptr});

    printf("_%08x      : o32 header %d:%s\n", $fileofs, $i, $o32{name}) if $verbose;
    return \%o32;
}
sub CheckPESanity {
    my ($file)= @_;
    my $p;
    # check for rva overlaop
    for (sort {$a->{rva} <=>$b->{rva} } @{$file->{pe}{o32}}) {
        if ($p && $p->{rva}+$p->{psize} > $_->{rva}) {
            warn sprintf("rva overlap between %s (r%08x-r%08x) and %s (r%08x-r%08x)\n",
                $p->{name}, $p->{rva}, $p->{rva}+$p->{psize},
                $_->{name}, $_->{rva}, $_->{rva}+$_->{psize});
        }
        if ($p && $p->{rva}+$p->{vsize} > $_->{rva}) {
            warn sprintf("rva virtual overlap between %s (r%08x-r%08x) and %s (r%08x-r%08x)\n",
                $p->{name}, $p->{rva}, $p->{rva}+$p->{vsize},
                $_->{name}, $_->{rva}, $_->{rva}+$_->{vsize});
        }
        $p= $_;
    }

    $p= undef;

    # check for dataptr overlap
    for (sort {$a->{dataptr} <=>$b->{dataptr} } @{$file->{pe}{o32}}) {
        if ($p && $p->{dataptr}+$p->{psize} > $_->{dataptr}) {
            warn sprintf("dataptr overlap between %s (_%08x-_%08x) and %s (_%08x-_%08x)\n",
                $p->{name}, $p->{dataptr}, $p->{dataptr}+$p->{psize},
                $_->{name}, $_->{dataptr}, $_->{dataptr}+$_->{psize});
        }
        $p= $_;
    }
}

sub DumpExportTable {
     my ($file, $exp, $rvaofs)= @_;

    my %fmt= (
        flags=>,         { ofs=>0x0000, fmt=>"%08x", desc=>"Export table flags, must be 0" },
        timestamp=>,     { ofs=>0x0004, fmt=>"%08x", desc=>"Time export data created" },
        vermajor=>,      { ofs=>0x0008, fmt=>"%04x", desc=>"Major version stamp" },
        verminor=>,      { ofs=>0x000a, fmt=>"%04x", desc=>"Minor version stamp" },
        rva_dllname=>,   { ofs=>0x000c, fmt=>"r%08x", desc=>"[rva] Offset to the DLL name" },
        ordbase=>,       { ofs=>0x0010, fmt=>"%08x", desc=>"First valid ordinal" },
        eatcnt=>,        { ofs=>0x0014, fmt=>"%08x", desc=>"Number of EAT entries" },
        namecnt=>,       { ofs=>0x0018, fmt=>"%08x", desc=>"Number of exported names" },
        rva_eat=>,       { ofs=>0x001c, fmt=>"r%08x", desc=>"[rva] Export Address Table offset" },
        rva_name=>,      { ofs=>0x0020, fmt=>"r%08x", desc=>"[rva] Export name pointers table off" },
        rva_ordinal=>,   { ofs=>0x0024, fmt=>"r%08x", desc=>"[rva] Export ordinals table offset" },
    );
    my $fileofs= rva2file($file, $rvaofs);
    if (!$fileofs) {
        warn sprintf("cannot find rva %08x for exporttable\n", $rvaofs);
        return;
    }
    for my $key (sort { $fmt{$a}{ofs} <=> $fmt{$b}{ofs} } keys %fmt) {
        printf("_%08x r%08x v%08x %-10s ",
            $fileofs+$fmt{$key}{ofs},
            $rvaofs+$fmt{$key}{ofs},
            rva2vbase($file, $rvaofs+$fmt{$key}{ofs}),
            $key) if $verbose;
        if (ref $exp->{$key} eq "ARRAY") {
            for my $i (0..$#{$exp->{$key}}) {
                printf(" $fmt{$key}{fmt}", $exp->{$key}[$i]) if $verbose;
            }
            print "\n" if $verbose;
        }
        else {
            printf(" $fmt{$key}{fmt}\n", $exp->{$key}) if $verbose;
        }
    }
    for (my $i=0 ; $i< $exp->{eatcnt} || $i < $exp->{namecnt} ; $i++) {
        my (@j_list)= grep { $exp->{ord_list}[$_]==$i } (0..$#{$exp->{ord_list}});
        if (@j_list>1) {
            warn "multiple identical ordinals in ord_list\n";
        }
        next if (@j_list==0 && !ref $exp->{eat_list}[$i] && $exp->{eat_list}[$i]==0);

        printf("e %s:ord%04d", $file->{realname}, $i+$exp->{ordbase}) if $verbose;
        if ($i<@{$exp->{eat_list}}) {
            if (ref $exp->{eat_list}[$i]) {
                printf(" ==> %s", $exp->{eat_list}[$i]{forward}) if $verbose;
            }
            else {
                printf(" r%08x", $exp->{eat_list}[$i]) if $verbose;
            }
        } else { printf(" " x 8); }

        my $symbol;
        my $dllname= lc($file->{realname});
        my $ord= $i+$exp->{ordbase};
        if (!exists $symbolsbyord{$dllname}{$ord}) {
            $symbol= $symbolsbyord{$dllname}{$ord}= {
                dllname=>$file->{realname}, 
                ordinal=>$ord
            };
            push @symbollist, $symbol;
        }
        else {
            $symbol= $symbolsbyord{$dllname}{$ord};
        }


        if (@j_list) {
            my $j= shift @j_list;

            printf(" %s:hint%04d", $file->{realname}, $j) if $verbose;
            printf(" r%08x", $exp->{name_rva_list}[$j]) if $verbose;
            printf(" %s", $exp->{name_list}[$j]) if $verbose;

            $symbol->{hint}= $j;
            $symbol->{name}= $exp->{name_list}[$j];
            if (exists $symbolsbyname{$dllname}{$symbol->{name}}) {
                if ($symbolsbyname{$dllname}{$symbol->{name}} != $symbol) {
                    my $nsym= $symbolsbyname{$dllname}{$symbol->{name}};
                    for my $sk (keys %$symbol) {
                        if (exists $nsym->{$sk}) {
                            if (lc($nsym->{$sk}) ne lc($symbol->{$sk})) {
                                warn sprintf("symbol %s:'%s' information %s : %s != %s\n", $dllname, $symbol->{name}, $sk, $nsym->{$sk}, $symbol->{$sk});
                            }
                        }
                        else {
                            $nsym->{$sk}= $symbol->{$sk};
                        }

                    }
                }
            }
            $symbolsbyname{$dllname}{$symbol->{name}}= $symbol;
        }
        printf("\n") if $verbose;
    }
}
sub ReadExportTable {
    my ($file, $fh, $rvaofs, $size)= @_;
    my $fileofs= rva2file($file, $rvaofs);
    if (!$fileofs) {
        warn sprintf("cannot find rva %08x for exporttable\n", $rvaofs);
        return;
    }

    $fh->seek($fileofs, SEEK_SET);

    my $data;
    $fh->read($data, 0x28) or croak "read exp header: $!\n";
    my %exp;
    (
        $exp{flags},      # 00 Export table flags, must be 0
        $exp{timestamp},  # 04 Time export data created
        $exp{vermajor},   # 08 Major version stamp
        $exp{verminor},   # 0a Minor version stamp
        $exp{rva_dllname},# 0c [rva] Offset to the DLL name
        $exp{ordbase},    # 10 First valid ordinal
        $exp{eatcnt},     # 14 Number of EAT entries
        $exp{namecnt},    # 18 Number of exported names
        $exp{rva_eat},    # 1c [rva] Export Address Table offset
        $exp{rva_name},   # 20 [rva] Export name pointers table off
        $exp{rva_ordinal},# 24 [rva] Export ordinals table offset
    ) = unpack("V2v2V7", $data);

    $exp{rva_dllname}  = MakeRvaOffset($exp{rva_dllname});
    $exp{rva_eat}      = MakeRvaOffset($exp{rva_eat});
    $exp{rva_name}     = MakeRvaOffset($exp{rva_name});
    $exp{rva_ordinal}  = MakeRvaOffset($exp{rva_ordinal});

    printf("_%08x-_%08x r%08x-r%08x v%08x-v%08x: export table\n",
        $fileofs, $fileofs+0x28,
        $rvaofs, $rvaofs+0x28,
        rva2vbase($file, $rvaofs), rva2vbase($file, $rvaofs+0x28)) if $verbose;

    $exp{eat_list}= ReadExportAddressTable($file, $fh, $exp{rva_eat}, $exp{eatcnt}) if $exp{rva_eat};
    $exp{name_rva_list}= ReadExportNameTable($file, $fh, $exp{rva_name}, $exp{namecnt}) if $exp{rva_name};
    $exp{ord_list}= ReadExportOrdinalTable($file, $fh, $exp{rva_ordinal}, $exp{namecnt}) if $exp{rva_ordinal};
    $exp{dllname}= ReadRvaString($file, $fh, $exp{rva_dllname}) if $exp{rva_dllname};
    $exp{name_list}= [ map { ReadRvaString($file, $fh, $_) } @{$exp{name_rva_list}} ] if $exp{name_rva_list};

    for (@{$exp{eat_list}}) {
        if ($_>=$rvaofs && $_<$rvaofs+$size) {
            my $forward= ReadRvaString($file, $fh, $_);
            $_= { forward=>$forward };

            if (my ($fwdll, $fword, $fwname)= ($forward =~ /(.*)\.(?:#(\d+)|(.*))/)) {
                push @{$exp{forwards}}, {
                    dllname=>$fwdll,
                    (defined $fword)?(ordinal=>$fword):(),
                    (defined $fwname)?(name=>$fwname):(),
                };

                my $symbol;
                if (defined $fwname) {
                    if (!exists $symbolsbyname{$fwdll}{$fwname}) {
                        $symbol= $symbolsbyname{$fwdll}{$fwname} = {
                            dllname=> $fwdll,
                            name=> $fwname,
                        };
                        push @symbollist, $symbol;
                    }
                    else {
                        $symbol= $symbolsbyname{$fwdll}{$fwname};
                    }
                    push @{$symbol->{imports}}, {
                        dllname=>lc($file->{realname}),
                    };
                }
                else {
                    if (!exists $symbolsbyord{$fwdll}{$fword}) {
                        $symbol= $symbolsbyord{$fwdll}{$fword} = {
                            dllname=> $fwdll,
                            ordinal=> $fword,
                        };
                        push @symbollist, $symbol;
                    }
                    else {
                        $symbol= $symbolsbyord{$fwdll}{$fword};
                    }
                    push @{$symbol->{imports}}, {
                        dllname=>lc($file->{realname}),
                    };
                }
            }
        }
    }
    return \%exp;
}

sub ReadExportAddressTable {
    my ($file, $fh, $rvaofs, $cnt)= @_;
    if ($cnt==0) { return []; }
    my $fileofs= rva2file($file, $rvaofs) or croak sprintf("cannot find rva %08x for ExportAddressTable\n", $rvaofs);

    $fh->seek($fileofs, SEEK_SET);

    my $data;
    $fh->read($data, $cnt*4) or croak "read ExportAddressTable: $!\n";

    printf("_%08x-_%08x r%08x-r%08x v%08x-v%08x: export address table\n",
        $fileofs, $fileofs+4*$cnt,
        $rvaofs, $rvaofs+4*$cnt,
        rva2vbase($file, $rvaofs), rva2vbase($file, $rvaofs+4*$cnt)) if $verbose;
    return [unpack("V*", $data)];
}
sub ReadExportNameTable {
    my ($file, $fh, $rvaofs, $cnt)= @_;
    if ($cnt==0) { return []; }

    my $fileofs= rva2file($file, $rvaofs) or croak sprintf("cannot find rva %08x for ExportNameTable\n", $rvaofs);

    $fh->seek($fileofs, SEEK_SET);

    my $data;
    $fh->read($data, $cnt*4) or croak "read ExportNameTable: $!\n";

    printf("_%08x-_%08x r%08x-r%08x v%08x-v%08x: export name table\n",
        $fileofs, $fileofs+4*$cnt,
        $rvaofs, $rvaofs+4*$cnt,
        rva2vbase($file, $rvaofs), rva2vbase($file, $rvaofs+4*$cnt)) if $verbose;

    return [unpack("V*", $data)];
}
sub ReadExportOrdinalTable {
    my ($file, $fh, $rvaofs, $cnt)= @_;
    if ($cnt==0) { return []; }
    my $fileofs= rva2file($file, $rvaofs) or croak sprintf("cannot find rva %08x for ExportOrdinalTable\n", $rvaofs);

    $fh->seek($fileofs, SEEK_SET);

    my $data;
    $fh->read($data, $cnt*2) or croak "read ExportOrdinalTable: $!\n";

    printf("_%08x-_%08x r%08x-r%08x v%08x-v%08x: export ordinal table\n",
        $fileofs, $fileofs+2*$cnt,
        $rvaofs, $rvaofs+2*$cnt,
        rva2vbase($file, $rvaofs), rva2vbase($file, $rvaofs+2*$cnt)) if $verbose;

    return [unpack("v*", $data)];
}
sub ReadRvaString {
    my ($file, $fh, $rvaofs)= @_;
    my $fileofs= rva2file($file, $rvaofs) or croak sprintf("cannot find rva %08x for String\n", $rvaofs);

    $fh->seek($fileofs, SEEK_SET);

    my $str;
    while (1) {
        my $data;
        $fh->read($data, 64) or croak "read String: $!\n";

        $str .= $data;
        last if ($data =~ /\x00/);
    }
    if (my $ix_nul= index($str, "\x00")) {
        $str= substr($str, 0, $ix_nul);
    }

    printf("_%08x-_%08x r%08x-r%08x v%08x-v%08x: string %s\n",
        $fileofs, $fileofs+length($str)+1,
        $rvaofs, $rvaofs+length($str)+1,
        rva2vbase($file, $rvaofs), rva2vbase($file, $rvaofs+length($str)+1),
        $str) if $verbose;

    return $str;
}

sub DumpImportTable {
    my ($file, $imp, $rvaofs)= @_;

    for (my $i=0 ; $i<@$imp ; $i++) {
        DumpImportEntry($file, $imp->[$i], $rvaofs+0x14*$i);
    }
}
sub DumpImportEntry {
    my ($file, $imp, $rvaofs)= @_;
    my %fmt= (
        rva_lookup=>,   { ofs=>0x0000, fmt=>"r%08x", desc=>"" },
        timestamp=>,    { ofs=>0x0004, fmt=>"%08x", desc=>"" },
        forwarder=>,    { ofs=>0x0008, fmt=>"%08x", desc=>"" },
        rva_dllname=>,  { ofs=>0x000c, fmt=>"r%08x", desc=>"" },
        rva_address=>,  { ofs=>0x0010, fmt=>"r%08x", desc=>"" },
    );
    my $fileofs= rva2file($file, $rvaofs) or croak sprintf("cannot find rva %08x for importentry\n", $rvaofs);
    for my $key (sort { $fmt{$a}{ofs} <=> $fmt{$b}{ofs} } keys %fmt) {
        printf("_%08x r%08x v%08x %-10s ",
            $fileofs+$fmt{$key}{ofs},
            $rvaofs+$fmt{$key}{ofs},
            rva2vbase($file, $rvaofs+$fmt{$key}{ofs}),
            $key) if $verbose;
        if (ref $imp->{$key} eq "ARRAY") {
            for my $i (0..$#{$imp->{$key}}) {
                printf(" $fmt{$key}{fmt}", $imp->{$key}[$i]) if $verbose;
            }
            print "\n" if $verbose;
        }
        else {
            printf(" $fmt{$key}{fmt}\n", $imp->{$key}) if $verbose;
        }
    }
    my $dllname= lc($imp->{dllname});
    for (my $i=0 ; $i<@{$imp->{address_list}} || ($imp->{lookup_list} && $i<@{$imp->{lookup_list}}) ; $i++) {
        printf("i %s %5d", $file->{realname} || $file->{filepath}, $i) if $verbose;
        if ($i<@{$imp->{address_list}}) {
            printf(" r%08x", $imp->{address_list}[$i]) if $verbose;
        } else { printf(" " x 8); }
        if ($imp->{lookup_list} && $i<@{$imp->{lookup_list}}) {
            printf(" r%08x", $imp->{lookup_list}[$i]) if $verbose;
        } else { printf(" " x 8); }
        if ($imp->{lookup_names} && $i<@{$imp->{lookup_names}}) {
            if (ref $imp->{lookup_names}[$i]) {
                printf(" %s:hint%04d %s:'%s'",
                    $imp->{dllname}, $imp->{lookup_names}[$i]{word},
                    $imp->{dllname}, $imp->{lookup_names}[$i]{name}) if $verbose;

                my $symbol;
                my $name= $imp->{lookup_names}[$i]{name};
                if (!exists $symbolsbyname{$dllname}{$name}) {
                    $symbol= $symbolsbyname{$dllname}{$name} = {
                        dllname=> $dllname,
                        name=> $name,
                    };
                    push @symbollist, $symbol;
                }
                else {
                    $symbol= $symbolsbyname{$dllname}{$name};
                }
                push @{$symbol->{imports}}, {
                    dllname=>lc($file->{realname}),
                    hint=>$imp->{lookup_names}[$i]{word},
                };
            }
            else {
                printf(" %s:ord%04d", $imp->{dllname}, $imp->{lookup_names}[$i]) if $verbose;

                my $ord= $imp->{lookup_names}[$i];
                my $symbol;
                if (!exists $symbolsbyord{$dllname}{$ord}) {
                    $symbol= $symbolsbyord{$dllname}{$ord}= {
                        dllname=> $dllname,
                        ordinal=> $ord,
                    };
                    push @symbollist, $symbol;
                }
                else {
                    $symbol= $symbolsbyord{lc($imp->{dllname})}{$ord};
                }
                push @{$symbol->{imports}}, {
                    dllname=>$file->{realname},
                };
            }
        }
        printf("\n") if $verbose;
    }
}

sub ReadImportTable {
    my ($file, $fh, $rvaofs)= @_;
    my $fileofs= rva2file($file, $rvaofs) or croak sprintf("cannot find rva %08x for imptable\n", $rvaofs);

    my @imp;
    for (my $i=0 ; 1 ; $i++) {
        my $imphdr= ReadImportHeader($file, $fh, $rvaofs+$i*0x14);
        last if (!$imphdr);

        $imphdr->{lookup_list}= ReadImpLookupList($file, $fh, $imphdr->{rva_lookup}) if $imphdr->{rva_lookup};
        $imphdr->{dllname}= ReadRvaString($file, $fh, $imphdr->{rva_dllname}) if $imphdr->{rva_dllname};

        # these are rva ptrs relative to the vbase of {dllname}
        $imphdr->{address_list}= ReadImpAddressList($file, $fh, $imphdr->{rva_address}) if $imphdr->{rva_address};

        $imphdr->{lookup_names}= [ map { ($_&0x80000000)
                            ? ($_&~0x80000000)
                            : rva2file($file, $_) ? ReadImpAddress($file, $fh, $_) : -1 } @{$imphdr->{lookup_list}} ] if $imphdr->{lookup_list};

        push @imp, $imphdr;
    }
    printf("_%08x-_%08x r%08x-r%08x v%08x-v%08x: import table\n",
        $fileofs, $fileofs+0x14*(@imp+1),
        $rvaofs, $rvaofs+0x14*(@imp+1),
        rva2vbase($file, $rvaofs), rva2vbase($file, $rvaofs+0x14*(@imp+1))) if $verbose;

    return \@imp;
}
sub ReadImpAddress {
    my ($file, $fh, $rvaofs)= @_;
    my $fileofs= rva2file($file, $rvaofs) or croak sprintf("cannot find rva %08x for impaddress\n", $rvaofs);

    $fh->seek($fileofs, SEEK_SET) or croak "seek to ImpAddress: $!\n";

    my $data;
    $fh->read($data, 2) or croak "read ImpAddress: $!\n";

    printf("_%08x-_%08x r%08x-r%08x v%08x-v%08x: import address word\n",
        $fileofs, $fileofs+2,
        $rvaofs, $rvaofs+2,
        rva2vbase($file, $rvaofs), rva2vbase($file, $rvaofs+2)) if $verbose;

    my $name= ReadRvaString($file, $fh, $rvaofs+2);

    return {
        word=>unpack("v", $data),   #  this is the remote ordinal - 1
        name=>$name,
    };
}
sub ReadImportHeader {
    my ($file, $fh, $rvaofs)= @_;
    my $fileofs= rva2file($file, $rvaofs) or croak sprintf("cannot find rva %08x for impheader\n", $rvaofs);

    $fh->seek($fileofs, SEEK_SET) or croak "seek to ImportHeader: $!\n";

    my $data;
    $fh->read($data, 0x14) or croak "read ImportHeader: $!\n";

    if ($data eq "\x00" x 0x14) {
        return;
    }
    my %imphdr;
    (
        $imphdr{rva_lookup}, # rva
        $imphdr{timestamp},  #
        $imphdr{forwarder},  #
        $imphdr{rva_dllname},# rva
        $imphdr{rva_address},# rva
    )= unpack("V5", $data);

    $imphdr{rva_lookup} = MakeRvaOffset($imphdr{rva_lookup});
    $imphdr{rva_dllname} = MakeRvaOffset($imphdr{rva_dllname});
    $imphdr{rva_address} = MakeRvaOffset($imphdr{rva_address});
    #printf("_%08x-_%08x r%08x-r%08x: import header\n", $fileofs, $fileofs+0x14, $rvaofs, $rvaofs+0x14);
    return \%imphdr;
}
sub ReadImpLookupList {
    my ($file, $fh, $rvaofs)= @_;
    my $fileofs= rva2file($file, $rvaofs);
    if (!$fileofs) {
        warn sprintf("cannot find rva %08x for ImpLookupList\n", $rvaofs);
        return;
    }

    $fh->seek($fileofs, SEEK_SET) or croak "seek to ImpLookupList: $!\n";

    my @lookup;
    my $done= 0;
    while (!$done) {
        my $data;
        $fh->read($data, 64) or croak "read ImpLookupList: $!\n";

        for (unpack("V*", $data)) {
            if ($_) {
                push @lookup, $_;
            }
            else {
                $done= 1;
                last;
            }
        }
    }
    printf("_%08x-_%08x r%08x-r%08x v%08x-v%08x: import lookup list\n",
        $fileofs, $fileofs+4*(@lookup+1),
        $rvaofs, $rvaofs+4*(@lookup+1),
        rva2vbase($file, $rvaofs), rva2vbase($file, $rvaofs+4*(@lookup+1))) if $verbose;
    return \@lookup;
}
sub ReadImpAddressList {
    my ($file, $fh, $rvaofs)= @_;
    my $fileofs= rva2file($file, $rvaofs) or croak sprintf("cannot find rva %08x for ImpAddressList\n", $rvaofs);

    $fh->seek($fileofs, SEEK_SET) or croak "seek to ImpAddressList: $!\n";

    my @addresses;
    my $done= 0;
    while (!$done) {
        my $data;
        $fh->read($data, 64) or croak "read ImpAddressList: $!\n";

        for (unpack("V*", $data)) {
            if ($_) {
                push @addresses, $_;
            }
            else {
                $done= 1;
                last;
            }
        }
    }
    printf("_%08x-_%08x r%08x-r%08x v%08x-v%08x: import addresses list\n",
        $fileofs, $fileofs+4*(@addresses+1),
        $rvaofs, $rvaofs+4*(@addresses+1),
        rva2vbase($file, $rvaofs), rva2vbase($file, $rvaofs+4*(@addresses+1))) if $verbose;
    return \@addresses;
}

sub MakeFileOffset {
    # todo : think of nice transparent way of translating offsets implicitly
    return shift;
}
sub MakeRvaOffset {
    # todo : think of nice transparent way of translating offsets implicitly
    return shift;
}
sub ReadSecurityTable {
    my ($fh, $fileofs, $size)= @_;

    $fh->seek($fileofs, SEEK_SET) or croak "seek to Security Table: $!\n";

    my $data;
    defined $fh->read($data, $size) or croak "read Security able: $!\n";

    if (length($data)==0) {
        return undef;
    }

    my ($length, $flags, $asn1)= unpack("VVa*", $data);
    printf("_%08lx security: l=%08x fl=%08x asn1len=%08x %s\n", $fileofs, $length-8, $flags, length($asn1), unpack("H16", $asn1)) if $verbose;
    return {
        flags=>$flags,
        asn1=>$asn1,
    };
}
sub ReadRvaData {
    my ($file, $fh, $rvaofs, $size, $tabname)= @_;
    my $fileofs= rva2file($file, $rvaofs) or croak sprintf("cannot find rva %08x for table %s\n", $rvaofs, $tabname);

    $fh->seek($fileofs, SEEK_SET);

    my $data;
    $fh->read($data, $size) or croak "read $tabname data: $!\n";

    return unpack("H*", $data);
}
sub ReadFileData {
    my ($fh, $fileofs, $size, $tabname)= @_;

    $fh->seek($fileofs, SEEK_SET);

    my $data;
    $fh->read($data, $size) or croak "read $tabname data: $!\n";

    return unpack("H*", $data);
}


sub ReadResourceTable {
    my ($file, $fh, $rvaofs, $size)= @_;
    my $fileofs= rva2file($file, $rvaofs) or croak sprintf("cannot find rva %08x for RES table\n", $rvaofs);

    $fh->seek($fileofs, SEEK_SET);

    my $data;
    $fh->read($data, $size) or croak "read res data: $!\n";

    return unpack("H*", $data);
}