#!perl -w
# (C) 2003-2007 Willem Jan Hengeveld <itsme@xs4all.nl>
# Web: http://www.xs4all.nl/~itsme/
#      http://wiki.xda-developers.com/
#
# $Id: rdmsflsh.pl 1857 2008-06-09 13:33:00Z itsme $
#
# this perl script decodes the IMGFS rom filesystem format
# as used by wm2005 devices
#
# problem: files with RELOC section, the reloc section needs more padding.
# 
package Reader;
use strict;
use IO::File;

sub new {
    my ($type, $fh, $base)= @_;
    my $self= bless {
        fh=>$fh,
        baseofs=>$base,
    }, $type;
    return $self;
}
package TyphReader;
use strict;
use IO::File;
our @ISA=qw(Reader);

sub ReadData {
    my ($self, $ofs, $len, $desc)= @_;
    printf("%08lx-%08lx l=%08lx %s\n", $ofs, $ofs+$len, $len, $desc) if ($main::verbose && $desc);
    $self->{fh}->seek($self->cv2file($ofs), SEEK_SET) or return;
    my $data="";
    $self->{fh}->read($data, $len) or return;
    return $data;
}
sub ReadDword {
    my ($self, $ofs, $desc)= @_;
    printf("%08lx-%08lx l=%08lx %s\n", $ofs, $ofs+4, 4, $desc) if ($main::verbose && $desc);
    $self->{fh}->seek($self->cv2file($ofs), SEEK_SET) or return;
    my $data;
    $self->{fh}->read($data, 4) or return;
    return unpack("V", $data);
}
sub cv2file {
    my ($self, $ofs)= @_;
    return $self->{baseofs} + $ofs;
}


package HimaReader;
use strict;
use IO::File;
our @ISA=qw(Reader);

sub ReadData {
    my ($self, $ofs, $len, $desc)= @_;
    printf("%08lx-%08lx l=%08lx %s\n", $ofs, $ofs+$len, $len, $desc) if ($main::verbose && $desc);
    my $data="";
    while ($len) {
        my $want= $len;
        my $realofs= $self->cv2file($ofs);
        $self->{fh}->seek($realofs, SEEK_SET) or return;
        if ($want>0x40000-($realofs&0x3ffff)) {
            $want= 0x40000-($realofs&0x3ffff);
        }

        $self->{fh}->read($data, $want, length($data)) or return;
        $len -= $want;
        $ofs += $want;
    }
    return $data;
}

sub ReadDword {
    my ($self, $ofs, $desc)= @_;
    printf("%08lx-%08lx l=%08lx %s\n", $ofs, $ofs+4, 4, $desc) if ($main::verbose && $desc);
    $self->{fh}->seek($self->cv2file($ofs), SEEK_SET) or return;
    my $data;
    $self->{fh}->read($data, 4) or return;
    return unpack("V", $data);
}

sub cv2file {
    my ($self, $ofs)= @_;
    return $self->{baseofs} + int($ofs/0x3f000)*0x40000+($ofs%0x3f000);
}

package cvtime;
use strict;
use POSIX;

sub convert2unixtime {
    my $wtime= shift;
    my @w= unpack("VV", $wtime);
    return int(($w[1]*(2**32)+$w[0])/10000000.0-11644473600)
}

package main;
use strict;
use Getopt::Long;
use Carp;
use IO::File;
use integer;
use XdaDevelopers::CompressUtils;
$|=1;

#
# i split the wm2005 sp rom apart as follows:
#
# 00000000-00000400  : hdr.nb
# 00000400-00200400  : first xip
# 00200400-00210000  : empty, filled with 0xff
# 00210000-003f0000  : second xip
# 003f0000-01819f00  : imgfs filesystem
# 01819f00-01819f80   signature?
# 01819f80-01b00000   empty 0xff
#
# this script operates on the extracted imgfs part
#

my $reader;
my $outdir;
our $verbose;
my %stats;

sub usage {
    return <<__EOF__
Usage: rdmsflsh [-d savedir] file
__EOF__
}
GetOptions(
    "d=s"=> \$outdir,
    "v"=>\$verbose,
) or die usage();
my $fn= shift or die "usage: need filename\n";
my $fh= IO::File->new($fn, "r") or croak "$fn: $!\n";
binmode $fh;

mkdir $outdir if ($outdir);

# himalaya 80500000
# 00000000: f8 ac 2c 9d e3 d4 2b 4d bd 30 91 6e d8 4f 31 dc
# 00000010: 00000001 00000001 00000001 00000034
# 00000020: 00000040 00001000 00001000 "LZX"
# 00000030: 0000057b 00000020
# 
# typhoon: 003f0000
# 00000000: f8 ac 2c 9d e3 d4 2b 4d bd 30 91 6e d8 4f 31 dc
# 00000010: 00000001 00000001 00000001 00000034
# 00000020: 00000008 00000200 00001000 "XPR"
# 00000030: 00001730 00000100

# universal: 706e0000
# 00000000: f8 ac 2c 9d e3 d4 2b 4d bd 30 91 6e d8 4f 31 dc
# 00000010: 00000001 00000001 00000001 00000034
# 00000020: 00000008 00000200 00001000 "LZX"
# 00000030: 0000ce0c 00000100

my $imgfs_hdr= findimgfs_header($fh) || die "could not find imgfs header\n";

#       universal   tornado0   tornado1   wizard   himalaya   typhoon
# 0000:      ** "MSFLSH50" **
# 0008:      ** 00000000 **
# 000c:      ** 00000038 **                                               size of this header
# 0010:      ** 00000000 **
# 0014:      ** 00000000 **
# 0018: 00000000   00000000   00000000   00000000   00000010   00000000
# 001c: 0000005e   00000048   0000004c   00000060   00000000   0000003f   start block of imgfs
# 0020: 00000080   00000080   00000080   00000080   00000040   00000080   nr of sectors per block
# 0024: 00010000   00010000   00010000   00010000   00040000   00010000   imgfs blocksize
# 0028:      ** 00000000 **
# 002c:      ** 00000001 **
# 0030: 00000000   00000000   00000000   00000000   00000010   00000000
# 0034: 00000000   00000000   00000000   00000000   0000006c   00000000
# 0038: 00000392   000001e8   00000204   00000330   00000000   00000171   nr of blocks in imgfs
# 003c: 00000080   00000080   00000080   00000080   0000003f   00000080   nr of used sectors per block
# 0040: 00010000   00010000   00010000   00010000   00040000   00010000   imgfs blocksize
# 0044: 00000000   00000000   00000000   00000000   00000002   00000000

#      :005e0000: :00480000: :004c0000: :00600000: :00500000: :003f0000:
# 0000:      ** f8ac2c9de3d42b4dbd30916ed84f31dc **                       guidBootSignature
# 0010:      ** 00000001 **                                               dwFSVersion;
# 0014:      ** 00000001 **                                               dwSectorsPerHeaderBlock;
# 0018:      ** 00000001 **                                               dwRunsPerFileHeader;
# 001c:      ** 00000034 **                                               dwBytesPerHeader;
# 0020: 00000008   00000008   00000008   00000008   00000040   00000008   dwChunksPerSector;
# 0024: 00000200   00000200   00000200   00000200   00001000   00000200   dwFirstHeaderBlockOffset;
# 0028:      ** 00001000 **                                               dwDataBlockSize;
# 002c: "LZX"      "LZX"      "LZX"      "LZX"      "LZX"      "XPR"      zCompressionType[4];
# 0030: 0000ce0c   000072a5   00001e72   0000cf31   0000057b   00001730   dwFreeSectorCount;
# 0034: 00000100   00000100   00000100   00000100   00000020   00000100   dwHiddenSectorCount;
# 0038:      ** 00000000 **                                               dwUpdateModeFlag;



# 0000:  magic == f8ac2c9de3d42b4dbd30916ed84f31dc
# 0010:0                                            dwFSVersion;
# 0014:1                                            dwSectorsPerHeaderBlock;
# 0018:2                                            dwRunsPerFileHeader;
# 001c:3  header length == 0x34                     dwBytesPerHeader;
# 0020:4  .. reader type                            dwChunksPerSector;
# 0024:5  .. dir block size                         dwFirstHeaderBlockOffset;
# 0028:6                                            dwDataBlockSize;
# 002c:7  compression magic == "LZX" or == "XPR"    szCompressionType[4];
# 0030:8  .. nr of files                            dwFreeSectorCount;
# 0034:9                                            dwHiddenSectorCount;
# 0038:a                                            dwUpdateModeFlag;

sub findimgfs_header {
    my ($fh)= @_;
    my $signature= pack("H*", "f8ac2c9de3d42b4dbd30916ed84f31dc");
    my $ofs= 0;
    while (1) {
        my $data;
        $fh->seek($ofs, SEEK_SET);
        $fh->read($data, 512) or last;
        my $i= index($data, $signature);
        if ($i>512-40) {
            warn sprintf("ignoring sig at %08lx\n", $ofs+$i);
        }
        elsif ($i>=0) {
            my @hdr= unpack("V7A4V2", substr($data, $i+16));
            if ($hdr[3]==0x34 && ($hdr[7] eq "LZX" || $hdr[7] eq "XPR")) {
                printf("found hdr at %08lx\n", $ofs+$i);
                return {
                    baseofs=>$ofs+$i,
                    compression=>$hdr[7],
                    readertype=>$hdr[4],
                    dirblocksize=>$hdr[5],
                    firstdirofs=>$hdr[5],
                    nroffiles=>$hdr[8],
                };
            }
            else {
                printf("sig at %08lx, but inv hdr: %08lx %s\n", $i+$ofs, $hdr[3], $hdr[7]);
            }
        }
        $ofs += 0x400;
    }
    return undef;
}
my $rd= $imgfs_hdr->{readertype}==8 || $imgfs_hdr->{readertype}==0x20
        ? TyphReader->new($fh, $imgfs_hdr->{baseofs})
        : $imgfs_hdr->{readertype}==0x40
        ? HimaReader->new($fh, $imgfs_hdr->{baseofs})
        : undef;
if (!$rd) {
    die sprintf("could not determine filetype: rd=0x%x base=0x%x\n", $imgfs_hdr->{readertype}, $imgfs_hdr->{baseofs});
}

my $dirdata="";
my $ofs= $imgfs_hdr->{firstdirofs};
while (length($dirdata)==0 || $ofs) {
    my $magic= $rd->ReadDword($ofs, "dirblock magic");
    if ($magic != 0x2f5314ce) {
        carp sprintf("%08lx: magic =%08lx  != 2f5314ce\n", $ofs, $magic);
        last;
    }

    my $dirchunk = $rd->ReadData($ofs+8, $imgfs_hdr->{dirblocksize}-8, sprintf("dirchunk %08lx", $ofs));

    $dirchunk =~ s/(?:\xff\xff\xff\xff)+$//;

    $dirdata .= $dirchunk;

    $ofs= $rd->ReadDword($ofs+4, "dirblock nextptr");
}
my %ref;
for (my $i= 0 ; $i<length($dirdata) ; $i+=4*13)
{
    my $type= unpack("V", substr($dirdata, $i, 4));
    $stats{sprintf("ent_%x", $type)}++;
    if ($type == 0xfffff6fe || $type == 0xfffffefe) {
        my $file= process_fileentry(substr($dirdata, $i, 4*13), sprintf("fileent %d", $i));

        save_file($outdir, $file) if ($outdir);

        printf(" %7d %04x %s %s\n", 
            $file->{size}, 
            $file->{attributes}, 
            POSIX::strftime("%Y-%m-%d %H:%M:%S", localtime $file->{timestamp}),
            $file->{name});
    }
}
print "statistics:\n";
print map { sprintf("%6d [ 0x%08x ] %s\n", $stats{$_}, $stats{$_}, $_) } sort keys %stats;
exit(0);
sub save_data {
    my ($filename, $data)= @_;
    my $fh= IO::File->new($filename, "w") or die "$filename: $!\n";
    binmode $fh;
    $fh->print($data) if (defined $data && length($data));
    $fh->close();
}
sub save_file {
    my ($dirpath, $file)= @_;
    my $filepath= sprintf("%s/%s", $dirpath, $file->{name});
    if ($file->{sections} && @{$file->{sections}}) {
        my $exedata= reconstruct_binary($file);
        save_data($filepath, $exedata);
    }
    else {
        save_data($filepath, $file->{data});
    }
}
sub unpack_e32rom {
    my ($data)= @_;
    my %e32rom;
    (
        $e32rom{objcnt},                # 0x00
        $e32rom{imageflags},            # 0x02
        $e32rom{entryrva},              # 0x04
        $e32rom{vbase},                 # 0x08
        $e32rom{subsysmajor},           # 0x0C
        $e32rom{subsysminor},           # 0x0E
        $e32rom{stackmax},              # 0x10
        $e32rom{vsize},                 # 0x14
        $e32rom{sect14rva},             # 0x18
        $e32rom{sect14size},            # 0x1C
        $e32rom{timestamp},             # 0x20
        $e32rom{EXP_rva}, $e32rom{EXP_size},    # 0x24
        $e32rom{IMP_rva}, $e32rom{IMP_size},    # 0x2c
        $e32rom{RES_rva}, $e32rom{RES_size},    # 0x34
        $e32rom{EXC_rva}, $e32rom{EXC_size},    # 0x3c
        $e32rom{SEC_rva}, $e32rom{SEC_size},    # 0x44
        $e32rom{FIX_rva}, $e32rom{FIX_size},    # 0x4c
        $e32rom{DEB_rva}, $e32rom{DEB_size},    # 0x54
        $e32rom{IMD_rva}, $e32rom{IMD_size},    # 0x5c
        $e32rom{MSP_rva}, $e32rom{MSP_size},    # 0x64
        $e32rom{subsys},                # 0x6c
    )= unpack("v2V2v2V23v", $data);

    return \%e32rom;
}
sub unpack_o32rom {
    my ($data)= @_;
    my %o32rom;

    (
        $o32rom{vsize},
        $o32rom{rva},
        $o32rom{psize},
        $o32rom{dataptr},
        $o32rom{realaddr},
        $o32rom{flags},
    ) = unpack("V6", $data);
    return \%o32rom;
}
sub parse_pe_data {
    my ($data)= @_;
    my %pe;

    if (length($data) < 0x70) {
        printf("WARNING: PE data block too small\n");
    }

    $pe{e32rom}= unpack_e32rom(substr($data, 0, 0x70));

    if (length($data) < 0x70 + $pe{e32rom}{objcnt}*0x18) {
        printf("WARNING: PE data block too small\n");
    }
    elsif (length($data) > 0x70 + $pe{e32rom}{objcnt}*0x18) {
        printf("WARNING: PE data block too large: %s\n", unpack("H*", substr($data, 0x70+0x18*$pe{e32rom}{objcnt})));
    }
    for (my $i=0 ; $i<$pe{e32rom}{objcnt} ; $i++) {
        push @{$pe{o32rom}}, unpack_o32rom(substr($data, 0x70+0x18*$i, 0x18));
    }
    return \%pe;
}
sub pack_mz_header {
    return pack("H*", "4d5a90000300000004000000ffff0000").
           pack("H*", "b8000000000000004000000000000000").
           pack("H*", "00000000000000000000000000000000").
           pack("H*", "00000000000000000000000080000000").
           pack("H*", "0e1fba0e00b409cd21b8014ccd215468").
           pack("H*", "69732070726f6772616d2063616e6e6f").
           pack("H*", "742062652072756e20696e20444f5320").
           pack("H*", "6d6f64652e0d0d0a2400000000000000");
}
sub pack_e32exe {
    my ($e32exe)= @_;

    my @info= qw(EXP IMP RES EXC SEC FIX DEB IMD MSP TLS CBK RS1 RS2 RS3 RS4 RS5);
    return pack("a4vvVVVvvvCCVV8v6V4v2V6",
            $e32exe->{magic}, 
            $e32exe->{cpu}, 
            $e32exe->{objcnt}, 
            $e32exe->{timestamp}, 
            $e32exe->{symtaboff}, 

            $e32exe->{symcount}, 
            $e32exe->{opthdrsize}, 
            $e32exe->{imageflags}, 
            $e32exe->{coffmagic}, 
            $e32exe->{linkmajor}, 
            $e32exe->{linkminor}, 
            $e32exe->{codesize}, 

            $e32exe->{initdsize}, 
            $e32exe->{uninitdsize}, 
            $e32exe->{entryrva}, 
            $e32exe->{codebase}, 

            $e32exe->{database}, 
            $e32exe->{vbase}, 
            $e32exe->{objalign}, 
            $e32exe->{filealign}, 

            $e32exe->{osmajor}, 
            $e32exe->{osminor}, 
            $e32exe->{usermajor}, 
            $e32exe->{userminor}, 
            $e32exe->{subsysmajor}, 
            $e32exe->{subsysminor}, 
            $e32exe->{res1}, 

            $e32exe->{vsize}, 
            $e32exe->{hdrsize}, 
            $e32exe->{filechksum}, 
            $e32exe->{subsys}, 
            $e32exe->{dllflags}, 

            $e32exe->{stackmax}, 
            $e32exe->{stackinit}, 
            $e32exe->{heapmax}, 
            $e32exe->{heapinit}, 

            $e32exe->{res2}, 
            $e32exe->{hdrextra}, 
    ).  join("", map { pack("VV", $e32exe->{"${_}_rva"}||0, $e32exe->{"${_}_size"}||0) } @info);
}
sub pack_o32obj {
    my ($o32obj)= @_;

    return pack("a8V8",
        $o32obj->{name},
        $o32obj->{vsize}, 
        $o32obj->{rva}, 
        $o32obj->{psize}, 
        $o32obj->{dataptr}, 
        $o32obj->{realaddr}, 
        $o32obj->{access}, 
        $o32obj->{temp3}, 
        $o32obj->{flags});
}
sub IMAGE_FILE_RELOCS_STRIPPED { 1 };
sub IMAGE_SCN_COMPRESSED               { 0x00002000 }
sub IMAGE_SCN_CNT_CODE                 { 0x00000020 }
sub IMAGE_SCN_CNT_INITIALIZED_DATA     { 0x00000040 }
sub IMAGE_SCN_CNT_UNINITIALIZED_DATA   { 0x00000080 }
sub IMAGE_SCN_TYPE_NOLOAD              { 0x00000002 }
sub IMAGE_SCN_MEM_DISCARDABLE          { 0x02000000 }
sub IMAGE_SCN_MEM_EXECUTE              { 0x20000000 }
sub IMAGE_SCN_MEM_READ                 { 0x40000000 }
sub IMAGE_SCN_MEM_WRITE                { 0x80000000 }

sub STD_EXTRA    {  16 }
sub IMAGE_FILE_MACHINE_ARM  { 0x01c0 }

sub FindFirstSegment {
    my ($segtypeflag, @o32rom)= @_;
    for (@o32rom) {
        if ($_->{flags} & $segtypeflag) {
            return $_->{rva};
        }
    }
    return 0;
}
sub CalcSegmentSizeSum {
    my ($segtypeflag, @o32rom)= @_;
    my $size= 0;
    for (@o32rom) {
        # vsize is not entirely correct, I should use the uncompressed size,
        # but, I don't know that here yet.
        if ($_->{flags}&$segtypeflag) {
            $size += $_->{vsize};
        }
    }

    return $size;
}
sub round_to_page {
    my ($val, $page)= @_;

    if ($val%$page) {
        return (int($val/$page)+1)*$page;
    }
    return $val;
}
sub round_padding {
    my ($val, $page)= @_;
    if ($val%$page) {
        return $page - ($val%$page);
    }
    return 0;
}

sub convert_e32rom_to_e32exe {
    my ($e32rom, @o32rom)= @_;
    my %e32exe;
    $e32exe{magic}= "PE";
    $e32exe{cpu}= IMAGE_FILE_MACHINE_ARM;   # todo: get cpu-type from romhdr.
    $e32exe{objcnt}= $e32rom->{objcnt};
    $e32exe{timestamp}= $e32rom->{timestamp};
    $e32exe{symtaboff}=0;
    $e32exe{symcount}=0;
    $e32exe{opthdrsize}= 0xe0;   # fixed.
    $e32exe{imageflags}= $e32rom->{imageflags} | IMAGE_FILE_RELOCS_STRIPPED;
    $e32exe{coffmagic}= 0x10b;
    $e32exe{linkmajor}= 6;
    $e32exe{linkminor}= 1;
    $e32exe{codesize}= CalcSegmentSizeSum(IMAGE_SCN_CNT_CODE, @o32rom);
    $e32exe{initdsize}= CalcSegmentSizeSum(IMAGE_SCN_CNT_INITIALIZED_DATA, @o32rom);
    $e32exe{uninitdsize}= CalcSegmentSizeSum(IMAGE_SCN_CNT_UNINITIALIZED_DATA, @o32rom);
    $e32exe{entryrva}= $e32rom->{entryrva};
    $e32exe{codebase}= FindFirstSegment(IMAGE_SCN_CNT_CODE, @o32rom);
    $e32exe{database}= FindFirstSegment(IMAGE_SCN_CNT_INITIALIZED_DATA, @o32rom);
    $e32exe{vbase}= $e32rom->{vbase};
    $e32exe{objalign}= 0x1000;
    $e32exe{filealign}= 0x200;
    $e32exe{osmajor}= 4;
    $e32exe{osminor}= 0;
    $e32exe{usermajor}= 0;
    $e32exe{userminor}= 0;
    $e32exe{subsysmajor}= $e32rom->{subsysmajor};
    $e32exe{subsysminor}= $e32rom->{subsysminor};
    $e32exe{res1}= 0;   # 'Win32 version' according to dumpbin
    $e32exe{vsize}= $e32rom->{vsize};
    # 0x80 = sizeof mz header
    # 0xf8 = sizeof e32 header
    # 0x28 = sizeof o32 header
    $e32exe{hdrsize}= round_to_page(0x80+0xf8+@o32rom*0x28, $e32exe{filealign});

    $e32exe{filechksum}= 0;
    $e32exe{subsys}= $e32rom->{subsys};
    $e32exe{dllflags}= 0;
    $e32exe{stackmax}= $e32rom->{stackmax};
    $e32exe{stackinit}=0x1000; # ?
    $e32exe{heapmax}=0x100000; # ?
    $e32exe{heapinit}=0x1000;  # ?

    $e32exe{res2}= 0;      # 'loader flags' according to dumpbin
    $e32exe{hdrextra}= STD_EXTRA;   # nr of directories

    $e32exe{EXP_rva}= $e32rom->{EXP_rva}; $e32exe{EXP_size}= $e32rom->{EXP_size};
    $e32exe{IMP_rva}= $e32rom->{IMP_rva}; $e32exe{IMP_size}= $e32rom->{IMP_size};
    $e32exe{RES_rva}= $e32rom->{RES_rva}; $e32exe{RES_size}= $e32rom->{RES_size};
    $e32exe{EXC_rva}= $e32rom->{EXC_rva}; $e32exe{EXC_size}= $e32rom->{EXC_size};
    $e32exe{SEC_rva}= $e32rom->{SEC_rva}; $e32exe{SEC_size}= $e32rom->{SEC_size}; # always 0

    # ...fixup segment does not look like a real fixup seg.
    # so we do include the data, but don't do anything with it.
    #$e32exe{FIX_rva}= $e32rom->{FIX_rva}; $e32exe{FIX_size}= $e32rom->{FIX_size};

    $e32exe{DEB_rva}= $e32rom->{DEB_rva}; $e32exe{DEB_size}= $e32rom->{DEB_size};
    $e32exe{IMD_rva}= $e32rom->{IMD_rva}; $e32exe{IMD_size}= $e32rom->{IMD_size}; # always 0
    $e32exe{MSP_rva}= $e32rom->{MSP_rva}; $e32exe{MSP_size}= $e32rom->{MSP_size}; # always 0

    $e32exe{RS4_rva}= $e32rom->{sect14rva}; $e32exe{RS4_size}= $e32rom->{sect14size};

    return \%e32exe;
}
sub convert_o32rom_to_o32obj {
    my ($o32rom, $e32rom)= @_;

    my $segtype;
    if ($e32rom->{RES_rva} == $o32rom->{rva} && $e32rom->{RES_size} == $o32rom->{vsize}) {
        $segtype= ".rsrc";
    }
    elsif ($e32rom->{EXC_rva} == $o32rom->{rva} && $e32rom->{EXC_size} == $o32rom->{vsize}) {
        $segtype= ".pdata";
    }
    elsif ($e32rom->{FIX_rva} == $o32rom->{rva} && $e32rom->{FIX_size} == $o32rom->{vsize}) {
        $segtype= ".reloc";
    }
    elsif ($o32rom->{flags}&IMAGE_SCN_CNT_CODE) {
        $segtype= ".text";
    }
    elsif ($o32rom->{flags}&IMAGE_SCN_CNT_INITIALIZED_DATA) {
        $segtype= ".data";
    }
    elsif ($o32rom->{flags}&IMAGE_SCN_CNT_UNINITIALIZED_DATA) {
        $segtype= ".pdata";
    }
    else {
        $segtype= ".other";
    }

    my %o32obj;

    # todo: add sequence nrs to identically named sections
    $o32obj{name} = $segtype;
    $o32obj{vsize}= $o32rom->{vsize};
    if (($o32rom->{flags}&IMAGE_SCN_TYPE_NOLOAD)!=0 && $o32rom->{realaddr}==0) {
        # most likely fixup
        $o32obj{rva}  = $o32rom->{rva};
    }
    else {
        $o32obj{rva}  = $o32rom->{realaddr} - $e32rom->{vbase};
    }
    $o32obj{psize}= $o32rom->{psize};
    $o32obj{dataptr}= 0;  # *** set at a later moment
    $o32obj{realaddr}= 0; # file pointer to relocation table
    $o32obj{access}= 0;   # file pointer to line numbers
    $o32obj{temp3}= 0;    # number of relocations + number of line numbers
    $o32obj{flags}= $o32rom->{flags} & ~IMAGE_SCN_COMPRESSED;

    return \%o32obj;
}

sub convert_rom_to_exe {
    my ($perom)= @_;

    my %peexe;
    $peexe{e32exe}= convert_e32rom_to_e32exe($perom->{e32rom}, @{$perom->{o32rom}});
    
    my $fileofs= $peexe{e32exe}{hdrsize};
    for (@{$perom->{o32rom}}) {
        my $o32obj= convert_o32rom_to_o32obj($_, $perom->{e32rom});
        push @{$peexe{o32obj}}, $o32obj;

        $o32obj->{dataptr}= $fileofs;

        $peexe{rvamap}{$_->{rva}}= { rva=>$o32obj->{rva}, size=>$o32obj->{vsize} };

        $fileofs += round_to_page($o32obj->{psize}, $peexe{e32exe}{filealign})
    }

    return \%peexe;
}
sub RvaToFileOfs {
    my ($rva, @o32obj)= @_;
    for (@o32obj) {
        if ($_->{rva}<=$rva && $rva < $_->{rva} + $_->{vsize}) {
            return $_->{dataptr}+$rva-$_->{rva};
        }
    }
}
sub strread_dword {
    my ($pstr, $ofs)= @_;
    return unpack("V", substr($$pstr, $ofs, 4));
}
sub strwrite_dword {
    my ($pstr, $ofs, $dword)= @_;
    substr($$pstr, $ofs, 4)= pack("V", $dword);
}

# rvamap maps romrva's to objrva's
sub find_rva_patch {
    my ($rva, $rvamap)= @_;
        #$peexe{rvamap}{$_->{rva}}= { rva=>$o32obj->{rva}, size=>$o32obj->{vsize} };
    for (keys %$rvamap) {
        my $info= $rvamap->{$_};
        if ($_ <= $rva && $rva < $_+$info->{size}) {
            return $rva-$_+$info->{rva};
        }
    }
    return $rva;
}

sub reconstruct_binary {
    my ($file)= @_;

    my $perom= parse_pe_data($file->{data});

    my $peexe= convert_rom_to_exe($perom);

    my $mz_data = pack_mz_header();
    # $file->{sections}[$i]{data}  contains the section data

    my $e32exe_data = pack_e32exe($peexe->{e32exe});
    my @o32exe_data = map { pack_o32obj($_) } @{$peexe->{o32obj}};

    my $image= $mz_data;
    $image .= $e32exe_data;
    $image .= $_ for (@o32exe_data);

    # page to filealign
    $image .= "\x00" x ($peexe->{e32exe}{hdrsize} - length($image));

    for my $i (0 .. $#{$file->{sections}}) {
        my $section = $file->{sections}[$i];
        my $o32= $peexe->{o32obj}[$i] if ($i<@{$peexe->{o32obj}});
        $image .= $section->{data};
#       if ($o32 && $o32->{name} eq ".reloc") {
#           printf("reloc %-20s %s %08lx-%08lx-%08lx (%04x): %s\n", 
#               $file->{name},
#               $section->{name},
#               $o32->{rva}, $o32->{rva}+$o32->{psize}, $o32->{rva}+$o32->{vsize},
#               length($section->{data}), unpack("H*", $section->{data}));
#       }
        $image .= "\x00" x round_padding(length($section->{data}), $peexe->{e32exe}{filealign});
    }

    # repair import table.
    my $impofs= RvaToFileOfs($peexe->{e32exe}{IMP_rva}, @{$peexe->{o32obj}});
    while (1) {
        my $impaddr= strread_dword(\$image, $impofs+0x10);
        last if ($impaddr==0);

        my $newimpaddr = find_rva_patch($impaddr, $peexe->{rvamap});

        strwrite_dword(\$image, $impofs+0x10, $newimpaddr);

        $impofs += 0x14;
    }

    return $image;
}

# 0000: magic  0xFFFFF6FD
# 0004: DWORD dwNextDataTableOffset;
# 0008: DWORD dwNextStreamHeaderOffset;
# 000c: FS_NAME fsName; : cchName + wFlags
# 0010:                 : wszShortName[4]
# 0014:
# 0018: DWORD dwStreamSize;
# 001c: FS_DATA_RUN dataTable[1];
# 0020:
# 0024:
# 0028:
# 002c:
# 0030:
sub process_sectionentry {
    my ($dirent, $file)= @_;
    my %section;

    my $magic;

    (
        $magic,
        $section{unk}[0],        # 0  always 0   : nextdatatable offset
        $section{next},          # 1  dirptr to next section entry
        $section{unk}[1],        # 2  always 4   == name flags
        $section{name},          # 3,4  WCHAR[4] == sectionname
        $section{size},          # 5  total section size
        $section{indexblock},    # 6,7  dataptr,size  ptr  to index block of section data
        $section{indexsize},
        @{$section{unk}}[2..5],     # 8-b  always 0
    ) = unpack("VVVVa8VVVVVVV", $dirent);
    if ($magic != 0xfffff6fd && $magic != 0xfffffcfd) {
        croak sprintf("invalid magic %08lx in section entry for %s\n", $magic, $file->{name});
    }
    $section{name} = unicode2string($section{name});
    $section{name} =~ s/\x00+$//g;

    my $sdesc= sprintf("indexblock section %s for %s", $section{name}, $file->{name});
    $section{data}= process_indexed_data($rd->ReadData($section{indexblock}, $section{indexsize}, $sdesc), $sdesc);

    #printf("file %s section %s: %s\n", $file->{name}, $section{name}, $section{data});

    return \%section;
}


# magic: 0xfffffefe or 0xfffff6fe
# 0000: magic
# 0004: DWORD dwNextDataTableOffset;
# 0008: DWORD dwNextStreamHeaderOffset;
# 000c: FS_NAME fsName.cchName;
# 000e: FS_NAME fsName.wFlags;
# 0010: FS_NAME fsName.szShortName;
# 0014: FS_NAME fsName.longName;
# 0018: DWORD dwStreamSize;
# 001c: DWORD dwFileAttributes;
# 0020: _FILETIME fileTime;
# 0028: DWORD dwReserved;
# 002c: FS_DATA_RUN dataTable[1];
# 0030:
sub process_fileentry {
    my ($dirent, $desc)= @_;
    my $magic;
    my %file;
    (
        $magic,
        $file{unk}[0],          # 0  always 0
        $file{firstsection},    # 1  dirptr to first section file
        $file{namelength},      # 2  WORD  filename length  : <=4 -> char[4]+ptr = literal filename.
        $file{nameflags},       #    WORD  flag: 2= filename ptr is direntry, 0= filenameptr is datablock
        $file{namehash},        # 3  char[4]
        $file{filenameptr},     # 4  ptr to filename file ( see flag for type )
        $file{size},            # 5  total file length
        $file{attributes},      # 6  file attributes
        $file{timestamp},       # 7,8  timestamp
        $file{unk}[1],          # 9  always 0
        $file{indexblock},    # a,b  dataptr,length  to index block of file data
        $file{indexsize},
    ) = unpack("VVVvva4VVVa8VVV", $dirent);

    $file{timestamp}= cvtime::convert2unixtime($file{timestamp});
    if ($magic!=0xfffffefe && $magic!=0xfffff6fe) {
        croak sprintf("invalid magic: %08lx in fileent\n", $magic);
    }
    if ($file{nameflags}&2) {
        $file{name}= process_nameentry($rd->ReadData($file{filenameptr}, 4*13, "name entry $desc"));
    }
    elsif ($file{namelength}<=4) {
        $file{name}= unicode2string(substr($dirent, 16, 8));
        $file{filenameptr}= 0;
        $file{namehash}= "";
    }
    else {
        $file{name}= unicode2string($rd->ReadData($file{filenameptr}, $file{namelength}*2, "filenameblock $desc"));
    }
    $file{name} =~ s/\x00+$//g;

    if ($file{firstsection}) {
        $stats{modules}++;
    }
    else {
        $stats{files}++;
    }
    printf("%s: %s\n", $desc, $file{name}) if ($main::verbose);
    for (my $ofs= $file{firstsection} ; $ofs ; $ofs= $file{sections}[-1]{next})
    {
        $stats{sections}++;
        push @{$file{sections}}, process_sectionentry($rd->ReadData($ofs, 4*13, sprintf("sectionentry %d for %s", scalar @{$file{sections}}, $file{name})), \%file);
    }
    if ($file{indexblock}) {
        my $fdesc= sprintf("indexblock filedata for %s", $file{name});
        $stats{datablocks}++;
        $file{data}= process_indexed_data($rd->ReadData($file{indexblock}, $file{indexsize}, $fdesc), $fdesc);
    }
    else {
        printf("no index block %08lx %08lx for %s\n", $file{indexblock}, $file{indexsize}, $file{name});
    }

    #printf("file %s: %s\n", $file{name}, $file{data});

    return \%file;
}
sub process_indexed_data {
    my ($index, $desc)= @_;
    my $data= "";
    for (my $iofs=0 ; $iofs<length($index) ; $iofs+=8) {
        $stats{datablocks}++;
        my ($compsize, $fullsize, $dataofs)= unpack("vvV", substr($index, $iofs, 8));
        last if ($dataofs==0);
        my $block= $rd->ReadData($dataofs, $compsize, sprintf("datablock %d for %s", $iofs/8, $desc));
        if (!defined $block) {
            printf("error reading data from %08lx l=%08lx : datablock %d for %s\n", $dataofs, $compsize, $iofs/8, $desc);
        }
        elsif ($fullsize==$compsize) {
            $data .= $block;
            $stats{uncompressed}++;
        }
        elsif ($imgfs_hdr->{compression} eq "XPR") {
            $stats{compressed}++;
            my $decomp= XdaDevelopers::CompressUtils::XPR_DecompressDecode($block.("\x00" x 16), $fullsize);
            if (!defined $decomp) {
                printf("no decomp !!!: %08lx->%08lx %s\n", $compsize, $fullsize, $desc);
                $data .= $block;
            }
            else {
                $data .= $decomp;
            }
        }
        elsif ($imgfs_hdr->{compression} eq "LZX") {
            $stats{compressed}++;
            my $decomp= XdaDevelopers::CompressUtils::LZX_DecompressDecode($block.("\x00" x 16), $fullsize);
            if (!defined $decomp) {
                printf("no decomp !!!: %08lx->%08lx %s\n", $compsize, $fullsize, $desc);
                $data .= $decomp;
            }
            else {
                $data .= $decomp;
            }
        }
    }
    return $data;
}
sub unicode2string {
    my ($data)= @_;
    return pack("U*", unpack("v*", $data));
}

# magic 0xfffffefb
sub process_nameentry {
    my ($nameent)= @_;
    my ($magic, $name)= unpack("Va*", $nameent);
    if ($magic!=0xfffffefb) {
        croak "unexpected: no nameentry magic\n";
    }
    return unicode2string($name);
}