#!perl -w
use strict;
use warnings;
$|=1;
# (C) 2003-2007 Willem Jan Hengeveld <itsme@xs4all.nl>
# Web: http://www.xs4all.nl/~itsme/
#      http://wiki.xda-developers.com/
#
# $Id: $
#
# problem: files with RELOC section, the reloc section needs more padding.
# 
#  6fe efe : fileentry  ( 6fe for modules, efe for files )
#  6fd cfd : sectionentry
#  efb     : nameentry

#  fff     : deleted entry
#
# todo:
#  add reloc info: ~/projects/wince/mamaich/imgfs060412/recmod/RecMod.cpp

# bug:
#   an incorrect fffb entry is added before the imgfs section
#   it should stay 'ffffffff ffffffff', instead  '000014ff fffbffff' is added.
#
package SimpleFile;
use strict;

our @ISA= qw(IO::File);

#sub new { my $class= shift; return $class->SUPER::new(@_); }
sub filesize { return -s $_[0]; }

package Reader;
use strict;
use warnings;
use IO::File;

sub new {
    my ($type, $fh, $base)= @_;
    my $self= bless {
        fh=>$fh,
        baseofs=>$base,
    }, $type;
    return $self;
}
sub ReadDword {
    my ($self, $ofs)= @_;
    $self->{fh}->seek($self->cv2file($ofs), SEEK_SET) or return;
    my $data;
    $self->{fh}->read($data, 4) or return;
    return unpack("V", $data);
}
sub WriteDword {
    my ($self, $ofs, $value)= @_;
    $self->{fh}->seek($self->cv2file($ofs), SEEK_SET) or return;
    $self->{fh}->write(pack("V", $value)) or return;
    #printf("W[%08lx] : 0x%x\n", $ofs, $value);
}

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

sub ReadData {
    my ($self, $ofs, $len)= @_;
    $self->{fh}->seek($self->cv2file($ofs), SEEK_SET) or return;
    my $data="";
    $self->{fh}->read($data, $len) or return;
    return $data;
}
sub WriteData {
    my ($self, $ofs, $data)= @_;
    $self->{fh}->seek($self->cv2file($ofs), SEEK_SET) or return;
    $self->{fh}->write($data) or return;
    #printf("W[%08lx] : %s\n", $ofs, unpack("H*", $data));
}
sub cv2file {
    my ($self, $ofs)= @_;
    return $self->{baseofs} + $ofs;
}
sub filesize {
    my ($self)= @_;
    return $self->{fh}->filesize()-$self->{baseofs};
}

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

sub ReadData {
    my ($self, $ofs, $len)= @_;
    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 WriteData {
    my ($self, $ofs, $data)= @_;
    my $dofs= 0;
    while ($dofs < length($data)) {
        my $want= length($data)-$dofs;
        my $realofs= $self->cv2file($ofs);
        $self->{fh}->seek($realofs, SEEK_SET) or return;
        if ($want>0x40000-($realofs&0x3ffff)) {
            $want= 0x40000-($realofs&0x3ffff);
        }

        $self->{fh}->write(substr($data, $dofs, $want)) or return;
        #printf("W[%08lx] : %s\n", $ofs, unpack("H*", substr($data, $dofs, $want)));
        $ofs += $want;
        $dofs += $want;
    }
    return $data;
}

sub cv2file {
    my ($self, $ofs)= @_;
    return $self->{baseofs} + int($ofs/0x3f000)*0x40000+($ofs%0x3f000);
}
sub filesize {
    my ($self)= @_;
    return ($self->{fh}->filesize()/0x40000)*0x3f000-$self->{baseofs};
}
package cvtime;
use strict;
use warnings;
use POSIX;

sub convert2unixtime {
    my $wtime= shift;
    my @w= unpack("VV", $wtime);
    return int(($w[1]*(2**32)+$w[0])/10000000.0-11644473600)
}
sub convert2mstime {
    my $utime= shift;
    my $wtime= ($utime+11644473600)*10000000;
    return pack("VV", $wtime%(2**32), $wtime/(2**32));
}
sub unix2string {
    return POSIX::strftime("%Y-%m-%d %H:%M:%S", localtime $_[0]);
}

package cvstring;
use strict;
use warnings;

sub unicode2string {
    return pack("U*", unpack("v*", $_[0]));
}
sub string2unicode {
    return pack("v*", unpack("U*", $_[0]));
}

###################################################################################################
###################################################################################################
# common interface to Entries:
#    XXXEntry->new($reader)
#    $ent->save($ofs)
#    XXXEntry->load($reader, $ofs)

package DirEntry;
use strict;
use warnings;

sub calc_name_hash {
    my $hash= lc pack("C*", map { $_&0xff } unpack("C*", $_[0]));

    $hash =~ s/(.{4})\..{3}$/$1/;
    
    return substr($hash,0,2).substr($hash,-2,2);
}
# decodes a namedata struct ( offset 0xC in a dir entry )
sub parse_namedata {
    my %name;

    (
        $name{length},    # 00 v   WORD  filename length  : <=4 -> char[4]+ptr = literal filename.
        $name{flags},     # 02 v   WORD  flag: 2= filename ptr is direntry, 0= filenameptr is datablock
        $name{hash},      # 04 a4  char[4]
        $name{dataptr},   # 08 V   ptr to filename file ( see flag for type )
    )= unpack("vva4V", $_[0]);

    if ($name{length}<=4) {
        $name{name}= cvstring::unicode2string(substr($_[0], 4, 2*$name{length}));
        $name{dataptr}= 0;
        $name{hash}= "";
    }
    return \%name;
}

# get name from a decoded namedata struct
sub get_name {
    my ($self)= @_;
    if (defined $self->{name}{name}) {
        return $self->{name}{name};
    }
    if ($self->{name}{flags} & 2) {
        my $nameentry= NameEntry->load($self->{reader}, $self->{name}{dataptr}, $self->{name}{length});
        $self->{name}{name}= $nameentry->{name};
    }
    else {
        $self->{name}{name}= cvstring::unicode2string($self->{reader}->ReadData($self->{name}{dataptr}, $self->{name}{length}*2));
    }
    $self->{name}{name} =~ s/\x00+$//g;
    return $self->{name}{name};
}
sub setname {
    my ($self, $newname, $alloc)= @_;
    $self->{name}{length}= length($newname);
    $self->{name}{name}= $newname;
    $self->{name}{hash}= calc_name_hash($newname);
    if (length($newname)<=4) {
        $self->{name}{dataptr}= 0;
        $self->{name}{flags}= 0;
    }
    elsif (length($newname)<=24) {
        $self->{name}{dataptr}= $alloc->allocent("n");
        $self->{name}{flags}= 2;
        my $nent= NameEntry->new($self->{reader});
        $nent->{name}= $self->{name}{name};
        $nent->save($self->{name}{dataptr});
    }
    else {
        my $uname= cvstring::string2unicode($newname);
        my $roundedsize= $alloc->roundsize(length($uname));
        $self->{name}{dataptr}= $alloc->allocchunk($roundedsize, "n");
        $self->{name}{flags}= 0;
        $self->{reader}->WriteData($self->{name}{dataptr}, $uname.("\x00" x ($roundedsize-length($uname))));
    }
    $self->save($self->{ofs});
}
sub getnamedata {
    my ($self)= @_;
    my $uname= pack 'v*', unpack 'U*', $self->{name}{name};

    if (length($uname)<=8) {
        return pack("vva8", length($self->{name}{name}), 0, $uname);
    }
    else {
        return pack("vva4V", length($self->{name}{name}), $self->{name}{flags}, $self->{name}{hash}, $self->{name}{dataptr});
    }
}
sub datatable_iterator {
    my ($self, $chunkfn)= @_;

    return if $self->{indexblock}==0 || $self->{indexsize}==0;

    #printf("datatable[%08lx] iterator\n", $self->{ofs});
    my $block= $self->{reader}->ReadData($self->{indexblock}, $self->{indexsize});
    for (my $iofs= 0 ; $iofs<length($block) ; $iofs+=8) {
        my ($compsize, $fullsize, $dataofs)= unpack("vvV", substr($block, $iofs, 8));
        next if ($compsize==0 || $fullsize==0 || $dataofs==0);
        $chunkfn->($dataofs, $compsize, $fullsize);
    }
}

sub nameiterator {
    my ($self, $entryfn, $chunkfn)= @_;

    #printf("name[%08lx] iterator\n", $self->{ofs});
    if ($self->{name}{length}<=4) {
        #
    }
    elsif ($self->{name}{flags}&2) {
        $entryfn->($self->{name}{dataptr});
    }
    else {
        $chunkfn->($self->{name}{dataptr}, $self->{name}{length}*2);
    }
}
package SectionEntry;
use strict;
use warnings;
our @ISA=qw(DirEntry);

sub load {
    my ($class, $reader, $ofs)= @_;

    my $self= bless { reader=>$reader }, $class;

    $self->{ofs}= $ofs;
    $self->{data}= $reader->ReadData($ofs, 4*13);
    $self->{magic}= unpack("V", $self->{data});
    die sprintf("%08lx not a section entry: magic=%08lx\n", $ofs, $self->{magic}) unless $self->{magic}==0xfffff6fd;

    my ($namedata, $alwaysnul);
    (
        $self->{magic},         # 00 V 
        $self->{nextdatatable}, # 04 V   always 0   : nextdatatable offset
        $self->{nextsection},   # 08 V   dirptr to next section entry
        $namedata,              # 0c a12 FS_NAME struct
        $self->{size},          # 18 V   total section size

        $self->{indexblock},    # 1c V   dataptr,size  ptr  to index block of section data
        $self->{indexsize},     # 20 V
        $alwaysnul,             # 24 a16
    ) = unpack("VVVa12VVVa16", $self->{data});

    $self->{name}= DirEntry::parse_namedata($namedata);

    warn sprintf("%08lx: unexpected data: ndt=%x\n", $ofs, $self->{nextdatatable}) if $self->{nextdatatable};
    warn sprintf("%08lx: unexpected data: +24=%s\n", $ofs, unpack("H*", $alwaysnul)) unless $alwaysnul =~ /^\x00+$/;

    return $self;
}
sub new {
    my ($class, $reader)= @_;
    my $self= bless { reader=>$reader,
        ofs=>0,
        magic=>0xfffff6fd,
        nextdatatable=>0,
        nextsection=>0,
        size=>0,
        indexblock=>0,
        indexsize=>0,
        name=>{ name=>"" },
    }, $class;
    return $self;
}
sub save {
    my ($self, $ofs)= @_;
    my $namedata= $self->getnamedata();
    $self->{ofs}= $ofs;
    $self->{data}= pack("VVVa12VVVa16", 
        $self->{magic},         # 00 V 
        $self->{nextdatatable}, # 04 V   always 0   : nextdatatable offset
        $self->{nextsection},   # 08 V   dirptr to next section entry
        $namedata,              # 0c a12 FS_NAME struct
        $self->{size},          # 18 V   total section size

        $self->{indexblock},    # 1c V   dataptr,size  ptr  to index block of section data
        $self->{indexsize},     # 20 V
        "\x00" x 16);
    $self->{reader}->WriteData($ofs, $self->{data});
}

sub dump {
    my ($self)= @_;
    printf("%08lx: s->%08lx  %9d  i->%08lx:%08lx %s\n",
        $self->{magic}, $self->{nextsection}, $self->{size}, $self->{indexblock}, $self->{indexsize}, $self->{name}{name});
}
package FileEntry;
use strict;
use warnings;
our @ISA=qw(DirEntry);

sub load {
    my ($class, $reader, $ofs)= @_;

    my $self= bless { reader=>$reader, ofs=>$ofs }, $class;

    $self->{data}= $reader->ReadData($ofs, 4*13);
    $self->{magic}= unpack("V", $self->{data});
    die sprintf("%08lx not a file entry: magic=%08lx\n", $ofs, $self->{magic}) unless $self->{magic}==0xfffff6fe || $self->{magic}==0xfffffefe;

    my ($namedata, $alwaysnul, $tsdata);
    (
        $self->{magic},         # 00 V 
        $self->{nextdatatable}, # 04 V   always 0   : nextdatatable offset
        $self->{nextsection},   # 08 V   dirptr to next section entry
        $namedata,              # 0c a12 FS_NAME struct
        $self->{size},          # 18 V   total file size

        $self->{attributes},    # 1c V    file attributes
        $tsdata,                # 20 a8   timestamp
        $self->{reserved},      # 28 V    always 0
        $self->{indexblock},    # 2c V    dataptr,length  to index block of file data
        $self->{indexsize},     # 30 V
    ) = unpack("VVVa12VVa8VVV", $self->{data});

    $self->{timestamp}= cvtime::convert2unixtime($tsdata);
    $self->{name}= DirEntry::parse_namedata($namedata);

    warn sprintf("%08lx: unexpected data: ndt=%x\n", $ofs, $self->{nextdatatable}) if $self->{nextdatatable};
    warn sprintf("%08lx: unexpected data: res=%x\n", $ofs, $self->{reserved}) if $self->{reserved};

    return $self;
}
sub new {
    my ($class, $reader)= @_;
    my $self= bless { reader=>$reader,
        ofs=>0,
        magic=>0xfffff6fe,
        nextdatatable=>0,
        nextsection=>0,
        size=>0,
        attributes=>0x41,
        timestamp=>0,
        indexblock=>0,
        reserved=>0,
        indexsize=>0,
        name=>{ name=>"" },
    }, $class;
    return $self;
}
sub save {
    my ($self, $ofs)=@_;

    my $tsdata= cvtime::convert2mstime($self->{timestamp});
    my $namedata= $self->getnamedata();
    $self->{ofs}= $ofs;
    $self->{data}= pack("VVVa12VVa8VVV", 
        $self->{magic},         # 00 V 
        $self->{nextdatatable}, # 04 V   always 0   : nextdatatable offset
        $self->{nextsection},   # 08 V   dirptr to next section entry
        $namedata,              # 0c a12 FS_NAME struct
        $self->{size},          # 18 V   total file size

        $self->{attributes},    # 1c V    file attributes
        $tsdata,                # 20 a8   timestamp
        $self->{reserved},      # 28 V    always 0
        $self->{indexblock},    # 2c V    dataptr,length  to index block of file data
        $self->{indexsize},     # 30 V
    );
    $self->{reader}->WriteData($ofs, $self->{data});
}
sub dump {
    my ($self)= @_;
    printf("%08lx: s->%08lx %9d [%08lx] %s  i->%08lx:%08lx %s\n",
        $self->{ofs}, $self->{nextsection}, $self->{size}, $self->{attributes}, cvtime::unix2string($self->{timestamp}), $self->{indexblock}, $self->{indexsize}, $self->{name}{name});
    $self->section_iterator(
        sub {
            my ($section)= @_;
            printf("%08lx:%08lx: n->%08lx %9d                        i->%08lx:%08lx %s\n",
                $self->{ofs},$section->{ofs}, $section->{nextsection}, $section->{size}, $section->{indexblock}, $section->{indexsize}, $section->{name}{name});
        }
    );
}
sub section_iterator {
    my ($self, $fn)= @_;

    #printf("section[%08lx] iterator\n", $self->{ofs});
    my $section;
    for (my $sectionofs= $self->{nextsection} ; $sectionofs ; $sectionofs= $section->{nextsection}) {
        $section= SectionEntry->load($self->{reader}, $sectionofs);
        $fn->($section);
    }
}
sub saveto {
    my ($self, $saveas, $decomp)= @_;

    my $fh= IO::File->new($saveas, "w") or die "$saveas: $!\n";
    binmode $fh;
    # todo: warn user that module extraction is not yet supported
    $self->datatable_iterator(
        sub {
            my ($ofs, $comp, $full)= @_;
            my $block= $self->{reader}->ReadData($ofs, $comp);

            $fh->print($decomp->($block, $full));
        }
    );

    $fh->close();
}

package NameEntry;
use strict;
use warnings;

sub load {
    my ($class, $reader, $ofs, $len)= @_;
    my $self= bless { reader=>$reader }, $class;

    $self->{ofs}= $ofs;
    $self->{data}= $reader->ReadData($ofs, 4*13);
    $self->{magic}= unpack("V", $self->{data});
    die sprintf("%08lx not a name entry: magic=%08lx\n", $ofs, $self->{magic}) unless $self->{magic}==0xfffffefb;

    $self->{name}= cvstring::unicode2string(substr($self->{data}, 4, $len*2));

    return $self;
}

sub new {
    my ($class, $reader)= @_;
    my $self= bless { reader=>$reader, magic=>0xfffffefb, ofs=>0, name=>"" }, $class;
    return $self;
}
sub save {
    my ($self, $ofs)= @_;

    $self->{ofs}= $ofs;
    my $uname= pack("Va48", $self->{magic}, cvstring::string2unicode($self->{name}));
    die "NameEntry : name too large\n" if length($uname)>0x34;
    $self->{reader}->WriteData($ofs, $uname);
}
sub dump {
    my ($self)= @_;
    printf("%08lx: %s\n",
        $self->{magic}, $self->{name});
}

#############################################################################
#############################################################################

package ImgfsFile;
use strict;
use warnings;
use XdaDevelopers::CompressUtils;
# 'h'  : first dirchunk
# 'd'  : dirchunk
# 'i'  : indexchunk for section
# 'a'  : datachunk for section
# 'n'  : namechunk for section
# 'I'  : indexchunk for file
# 'A'  : datachunk for file
# 'N'  : namechunk for file
# ' '  : free
sub mark {
    my ($self, $ofs, $size, $tag)= @_;
    die sprintf("mark(%s):invalid ofs/size: %08lx/%08lx\n", $tag, $ofs, $size) if ($size==0 || $size>=$self->{reader}->filesize() || $ofs>=$self->{reader}->filesize());
    $size= $self->roundsize($size);
    die sprintf("unaligned chunk: %08lx/%08lx\n", $ofs, $size) if $ofs%$self->{imgfs}{chunksize} || $size%$self->{imgfs}{chunksize};
    my ($ix, $n)= (int($ofs/$self->{imgfs}{chunksize}), int($size/$self->{imgfs}{chunksize})); 

    if ($tag ne " " && substr($self->{chunkmap}, $ix, $n) ne " " x $n) {
        warn sprintf("chunk %08lx/%08lx is already: '%s'\n", $ofs, $size, substr($self->{chunkmap}, $ix, $n));
    }
    substr($self->{chunkmap}, $ix, $n)= $tag x $n;
}
sub allocdirblock {
    my ($self)= @_;
    my $blocksize= $self->{imgfs}{chunksperblock};
    my $bsm1= $blocksize-1;
    while ($self->{chunkmap} =~ / (?= {$bsm1})/g) {
        my $ix= pos($self->{chunkmap})-1;
        if (($ix % $blocksize)==0) {
            my $ofs= $ix*$self->{imgfs}{chunksize};
            $self->mark($ofs, $blocksize*$self->{imgfs}{chunksize}, "d");
            return $ofs;
        }
    }
    print join "", map { sprintf("%08x: %s\n", $_*0x100, substr($self->{chunkmap}, $_*0x100, 0x100)) } 0..int((length($self->{chunkmap})+0xff)/0x100)-1;
    die sprintf("could not alloc dirblock\n");
}
sub allocchunk {
    my ($self, $size, $tag)= @_;
    return 0 if $size==0;
    die sprintf("unaligned size in allocchunk: %x\n", $size) if $size%$self->{imgfs}{chunksize};
    my $n= $size/$self->{imgfs}{chunksize};
    my $ix= index($self->{chunkmap}, " " x $n);
    if ($ix==-1) {
        die sprintf("could not alloc chunk of size 0x%x\n", $size);
    }
    my $ofs= $ix*$self->{imgfs}{chunksize};
    $self->mark($ofs, $size, $tag);
    return $ofs;
}
sub erase {
    my ($self, $ofs, $size)= @_;
    printf("erase data: %08lx/%08lx\n", $ofs, $size) if $::verbose>2;
    $self->mark($ofs, $size, " ");
    $self->{reader}->WriteData($ofs, "\xff" x $size);
}
# 'f'  : file entry
# 'n'  : file-name entry
# 'N'  : section-name entry
# ' '  : free entry
# 's'  : section entry
sub markent {
    my ($self, $ofs, $tag)= @_;
    die sprintf("markent(%s): invalid ofs: %08lx\n", $tag, $ofs) if ($ofs<0x200 || $ofs>=$self->{reader}->filesize());
    my $ix= $self->entrytoindex($ofs);
    die sprintf("dirent ix too large: %d\n", $ix) if $ix>=length($self->{entrymap});
    if ($tag ne " " && substr($self->{entrymap}, $ix, 1) ne " ") {
        warn sprintf("entry %08lx ( %d ) is already %s\n", $ofs, $ix, $tag);
    }
    substr($self->{entrymap}, $ix, 1)= $tag;
}
sub allocent {
    my ($self, $tag)= @_;
    my $ix= index($self->{entrymap}, " ");
    if ($ix==-1) {
        my $blkofs= $self->allocdirblock();
        $ix= $self->registerdirblock($blkofs);

        my $prevblocknr= int($ix/$self->{imgfs}{entriesperblock})-1;
        my $prevofs= $self->{dir_nr2ofs}{$prevblocknr};
        $self->{reader}->WriteData($prevofs, pack("VV", 0x2f5314ce, $blkofs));
        $self->{reader}->WriteData($blkofs, pack("VV", 0x2f5314ce, 0).("\xff" x ($self->{imgfs}{dirblocksize}-8)));
        #printf("extended dir: %08lx->%08lx\n", $prevofs, $blkofs);
    }
    #printf("l(m)=0x%x, i=%x\n", length($self->{entrymap}), $ix);
    #printf("o2n: %s\n", join(" ", map { sprintf("%x:%x", $_, $self->{dir_ofs2nr}{$_}) } sort {$a<=>$b} keys %{$self->{dir_ofs2nr}}));
    #printf("n2o: %s\n", join(" ", map { sprintf("%x:%x", $_, $self->{dir_nr2ofs}{$_}) } sort {$a<=>$b} keys %{$self->{dir_nr2ofs}}));
    my $ofs= $self->indextoentry($ix);

    $self->markent($ofs, $tag);
    #printf("allocent->%08lx\n", $ofs);
    return $ofs;
}
sub eraseent {
    my ($self, $ofs)= @_;
    $self->markent($ofs, " ");
    $self->{reader}->WriteData($ofs, "\xff" x $self->{imgfs}{direntsize});
}

# returns index of first entry of new block
sub registerdirblock {
    my ($self, $ofs)= @_;
    my $ix= length($self->{entrymap});
    my $blocknr= int($ix/$self->{imgfs}{entriesperblock});
    $self->{dir_ofs2nr}{$ofs}= $blocknr;
    $self->{dir_nr2ofs}{$blocknr}= $ofs;
    $self->{entrymap} .= " " x $self->{imgfs}{entriesperblock};

    #printf("adding %d dir entries: total=%d\n", $self->{imgfs}{entriesperblock}, length($self->{entrymap}));
    return $ix;
}
sub entrytoindex {
    my ($self, $ofs)= @_;
    my ($dirblockofs, $blockofs)= (int($ofs/$self->{imgfs}{dirblocksize})*$self->{imgfs}{dirblocksize}, $ofs % $self->{imgfs}{dirblocksize});

    die sprintf("unaligned direntry offset %08lx\n", $ofs) if ($blockofs-8)%$self->{imgfs}{direntsize}; 
    die sprintf("unknown dirblock ofs 0x%x:%x (%08lx)\n", $dirblockofs, $blockofs, $ofs) if !exists $self->{dir_ofs2nr}{$dirblockofs};

    my $ix= $self->{dir_ofs2nr}{$dirblockofs}*$self->{imgfs}{entriesperblock} + int(($blockofs-8)/$self->{imgfs}{direntsize});
    return $ix;
}
sub indextoentry {
    my ($self, $ix)= @_;
    my ($blocknr, $blockix)= (int($ix/$self->{imgfs}{entriesperblock}), $ix%$self->{imgfs}{entriesperblock});
    die sprintf("unknown dirblock nr %d:%d ( %d )\n", $blocknr, $blockix, $ix) if !exists $self->{dir_nr2ofs}{$blocknr};
    return $self->{dir_nr2ofs}{$blocknr}+8+$self->{imgfs}{direntsize}*$blockix;
}
sub roundsize {
    my ($self, $size)=@_;
    return 0 if $size==0;
    return (($size-1)|($self->{imgfs}{chunksize}-1))+1;
}
sub new {
    my ($class, $reader, $imgfs)= @_;

    my $self= bless {
        reader=>$reader,
        imgfs=>$imgfs,
        chunkmap=>" " x int($reader->filesize()/$imgfs->{chunksize}),
        entrymap=>"",
        dir_ofs2nr => {},
        dir_nr2ofs => {},
        filebyname=> {},
    }, $class;

    $self->mark(0, $self->{imgfs}{firstdirofs}, "h");
    # fill alloc maps
    $self->dirblock_iterator(
        sub {
            my $ofs= shift;
            #printf("imgfs: dirblock(%08lx)\n", $ofs);
            $self->mark($ofs, $imgfs->{dirblocksize}, "d");
            $self->registerdirblock($ofs);
        }
    );

    $self->direntry_iterator(
        sub {
            my $file= shift;
            #printf("imgfs: file(%08lx)\n", $file->{ofs});
            $self->markent($file->{ofs}, "f");
            my $name= $file->get_name();
            warn sprintf("duplicate name: %s\n", $name) if exists $self->{filebyname}{lc($name)};
            $self->{filebyname}{lc($name)}= $file;
            $file->section_iterator(
                sub {
                    my $section= shift;
                    $self->markent($section->{ofs}, "s");
                    $section->nameiterator(
                        sub {
                            $self->markent($_[0], "n");
                        },
                        sub {
                            $self->mark($_[0], $_[1], "n");
                        }
                    );
                    $section->datatable_iterator(
                        sub {
                            $self->mark($_[0], $_[1], "a");
                        }
                    );
                    if ($section->{indexblock}) {
                        $self->mark($section->{indexblock}, $section->{indexsize}, "i");
                    }
                    else {
                        printf("NOTE: %s : %s is empty\n", $name, $section->{name}{name});
                    }
                }
            );
            $file->nameiterator(
                sub {
                    $self->markent($_[0], "N");
                },
                sub {
                    $self->mark($_[0], $_[1], "N");
                }
            );
            $file->datatable_iterator(
                sub {
                    $self->mark($_[0], $_[1], "A");
                }
            );
            if ($file->{indexblock} || $file->{indexsize}) {
                $self->mark($file->{indexblock}, $file->{indexsize}, "I");
            }
        }
    );
    return $self;
}
sub dumpinfo
{
    my ($self)= @_;
    my %cxref;
    $cxref{substr($self->{chunkmap},$_,1)}++ for 0..length($self->{chunkmap})-1;
    printf("chunkmap: %s\n", join(", ", map { sprintf("%s:%d", $_, $cxref{$_}) } keys %cxref));
    if ($self->{chunkmap} =~ /\s+$/ && length($&)!=$cxref{' '}) {
        printf("  %4d unallocated non-tail chunks\n", $cxref{' '}-length($&));
    }
    print(join "", map { sprintf("%08x: %s\n", $_*0x100, substr($self->{chunkmap}, $_*0x100, 0x100)) } 0..int((length($self->{chunkmap})+0xff)/0x100)-1) if $::verbose;
    my %exref;
    $exref{substr($self->{entrymap},$_,1)}++ for 0..length($self->{entrymap})-1;
    printf("entrymap: %s\n", join(", ", map { sprintf("%s:%d", $_, $exref{$_}) } keys %exref));
    print(join "", map { sprintf("%08x: %s\n", $_*0x100, substr($self->{entrymap}, $_*0x100, 0x100)) } 0..int((length($self->{entrymap})+0xff)/0x100)-1) if $::verbose;
    if ($self->{entrymap} =~ /\s+$/ && length($&)!=$exref{' '}) {
        printf("  %4d unallocated non-tail entries\n", $exref{' '}-length($&));
    }

    printf("o2n: %d items,  n2o: %d items, byname: %d items\n",
        scalar keys %{$self->{dir_ofs2nr}},
        scalar keys %{$self->{dir_nr2ofs}},
        scalar keys %{$self->{filebyname}});

    return $self;

}

sub dirblock_iterator {
    my ($self, $blockfn)= @_;
    my $dirblockofs= $self->{imgfs}{firstdirofs};
    #printf("dirblock iterator: %08lx\n", $dirblockofs);
    while ($dirblockofs) {
        my ($magic, $next)= unpack("VV", $self->{reader}->ReadData($dirblockofs, 8));
        die sprintf("%08lx: invalid dirblock magic: %08lx\n", $dirblockofs, $magic) if $magic != 0x2f5314ce;
        $blockfn->($dirblockofs);

        $dirblockofs= $next;
    }
}
sub direntry_iterator {
    my ($self, $filefn)= @_;
    for my $dirblockofs (sort { $a<=>$b } keys %{$self->{dir_ofs2nr}}) {
        my $dirchunk = $self->{reader}->ReadData($dirblockofs+8, $self->{imgfs}{dirblocksize}-8);

        for (my $cofs= 0 ; $cofs+$self->{imgfs}{direntsize}<=length($dirchunk) ; $cofs += $self->{imgfs}{direntsize})
        {
            my $magic= unpack("V", substr($dirchunk, $cofs, 4));
            #printf("ent: %08lx : %s\n", $magic, unpack("H*", substr($dirchunk, $cofs+4,0x30)));
            if ($magic==0xfffffefe || $magic==0xfffff6fe) {
                $filefn->(FileEntry->load($self->{reader}, $dirblockofs+$cofs+8));
            }
        }
    }
}

sub delete {
    my ($self, $name)= @_;
    return if !exists $self->{filebyname}{lc($name)};
    my $file= $self->{filebyname}{lc($name)};
    delete $self->{filebyname}{lc($name)};


    printf("erasing index data\n") if $::verbose>1;
    $file->datatable_iterator(
        sub {
            printf("del datatabs: %08lx/%08lx\n", @_) if $::verbose>1;
            $self->erase($_[0], $_[1]);
        }
    );
    printf("erasing index block\n") if $::verbose>1;
    $self->erase($file->{indexblock}, $file->{indexsize});

    printf("erasing sections\n") if $::verbose>1;
    $file->section_iterator(
        sub {
            my $section= shift;
            printf("erasing section index data\n") if $::verbose>1;
            $section->datatable_iterator(
                sub {
                    $self->erase($_[0], $_[1]);
                }
            );
            printf("erasing section indexblock\n") if $::verbose>1;
            $self->erase($section->{indexblock}, $section->{indexsize});

            printf("erasing section name\n") if $::verbose>1;
            $section->nameiterator(
                sub {
                    printf("erasing section name entry\n") if $::verbose>1;
                    $self->eraseent($_[0]);
                },
                sub {
                    printf("erasing section name chunk\n") if $::verbose>1;
                    $self->erase($_[0], $_[1]);
                }
            );
            printf("erasing section entry\n") if $::verbose>1;
            $self->eraseent($section->{ofs});

        }
    );
    printf("erasing file name\n") if $::verbose>1;
    $file->nameiterator(
        sub {
            printf("erasing file name entry\n") if $::verbose>1;
            $self->eraseent($_[0]);
        },
        sub {
            printf("erasing file name chunk\n") if $::verbose>1;
            $self->erase($_[0], $_[1]);
        }
    );
    printf("erasing file entry %s\n", $file->{name}{name}) if $::verbose>1;
    $self->eraseent($file->{ofs});
}
sub rename {
    my ($self, $oldname, $newname)= @_;

    die sprintf("rename: %s does not exist\n", $oldname) if !exists $self->{filebyname}{lc($oldname)};
    die sprintf("rename: %s already exists\n", $newname) if exists $self->{filebyname}{lc($newname)};

    my $file= $self->{filebyname}{lc($oldname)};
    delete $self->{filebyname}{lc($oldname)};

    # first delete oldname
    $file->nameiterator(
        sub {
            printf("rename: erase entry %08lx\n", $_[0]) if $::verbose>1;
            $self->eraseent($_[0]);
        },
        sub {
            printf("rename: erase chunk %08lx/%08lx\n", $_[0], $_[1]) if $::verbose>1;
            $self->erase($_[0], $_[1]);
        }
    );

    $file->setname($newname, $self);

    $self->{filebyname}{lc($newname)}= $file;
}

sub dump {
    my ($self, $filename)= @_;
    if (!exists $self->{filebyname}{lc($filename)}) {
        die "$filename does not exist\n";
    }
    $self->{filebyname}{lc($filename)}->dump();
}

sub saveto {
    my ($self, $filename, $saveas)= @_;
    if (!exists $self->{filebyname}{lc($filename)}) {
        die "$filename does not exist\n";
    }
    my $decomp= ($self->{imgfs}{compression} eq "XPR") ? \&XdaDevelopers::CompressUtils::XPR_DecompressDecode
              : ($self->{imgfs}{compression} eq "LZX") ? \&XdaDevelopers::CompressUtils::LZX_DecompressDecode
              : undef;
    $self->{filebyname}{lc($filename)}->saveto($saveas, $decomp);
}

sub addfile {
    my ($self, $filename, $data, $timestamp)= @_;
    my $file= FileEntry->new($self->{reader});
    $file->{ofs}= $self->allocent("f");
    $file->setname($filename, $self);
    $file->{size}= length($data);
    $file->{timestamp}= $timestamp;
    my @chunks;

    printf("alloc chunks\n") if $::verbose>1;
    my $o= 0;
    while ($o<$file->{size}) {
        my $wanted= ($file->{size}-$o<0x1000)?$file->{size}-$o:0x1000;
        my $udata= substr($data, $o, $wanted);
        # compress data
        my $cdata= ($self->{imgfs}{compression} eq "XPR") ? XdaDevelopers::CompressUtils::XPR_CompressEncode($udata)
                 : ($self->{imgfs}{compression} eq "LZX") ? XdaDevelopers::CompressUtils::LZX_CompressEncode($udata)
                 : undef;
        if (!defined $cdata || length($cdata) >= $wanted) {
            $cdata= $udata;
        }
        my $csize= length($cdata);
        push @chunks, {
            comp=>$csize,
            full=>$wanted,
            ofs=>$self->allocchunk($self->roundsize($csize), "A"),
        };
        # pad last chunk with zero's
        if ($csize % $self->{imgfs}{chunksize}) {
            my $padlen= $self->{imgfs}{chunksize}-( $csize % $self->{imgfs}{chunksize} );
            $cdata .= "\x00" x $padlen;
        }
        $self->{reader}->WriteData($chunks[-1]{ofs}, $cdata);
        $o+=$wanted;
    }
    my $indexdata= join("", map { pack("vvV", $_->{comp}, $_->{full}, $_->{ofs}) } @chunks);
    printf("alloc index (%d)\n", length($indexdata)) if $::verbose>1;
    my $roundedsize= $self->roundsize(length($indexdata));
    $file->{indexblock}= $self->allocchunk($roundedsize, "I");
    $file->{indexsize}= $roundedsize;
    printf("-> %08lx/%08lx\n", $file->{indexblock}, $file->{indexsize}) if $::verbose>1;
    $self->{reader}->WriteData($file->{indexblock}, $indexdata.("\x00" x ($roundedsize-length($indexdata))));
    printf("save new file entry '%s'\n", $file->get_name()) if $::verbose>1;
    $file->save($file->{ofs});
}
package FFFBFFFD;
use strict;
use IO::File;

sub new {
    my ($class, $fh, $baseofs, $blocksize)= @_;
    my $self= bless {
        fh=>$fh,
        baseofs=>$baseofs,
        blocksize=>$blocksize,
    }, $class;

    return $self;
}
sub DESTROY {
    my ($self)= @_;
    return if (!$self->{maxwpos});

    my $pos= $self->{maxwpos};

    my $c0= $pos%0x800;
    if ($c0) {
        $pos += 0x800-$c0;
    }
    my $pofs= $self->cv2file($pos);
    $self->{fh}->seek($pofs-8, SEEK_SET);
    $self->{fh}->print(pack("VV", $self->vofs2physblocknr($pos-0x800), $self->{footinfo}{tag}));
    printf("lastblock: v=0x%x, p=0x%x\n", $pos, $pofs);
}
sub seek {
    my ($self, $pos, $set)= @_;
    if ($set == SEEK_SET) {
        $self->{pos}= $pos;
    }
    elsif ($set == SEEK_CUR) {
        $self->{pos}+= $pos;
    }
    elsif ($set == SEEK_END) {
        $self->{pos} = $self->filesize()+$pos;
    }
    return 1;
}
sub calcphyssize {
    my ($vpos, $vsize)= @_;

    my $psize= 0;

    my $c0= $vpos%0x800;

    if ($c0) {
        my $want= 0x800-$c0;
        $want=$vsize if ($want>$vsize);

        $psize += $want;
        $vpos  += $want;
        $vsize -= $want;
        $psize += 8 if (($vpos%0x800)==0);
    }
    if ($vsize) {
        # now vpos is aligned to a 0x800 block
        my $nblocks= int($vsize/0x800);

        $psize += $nblocks*0x808;

        $vpos  += $nblocks*0x800;
        $vsize -= $nblocks*0x800;
    }
    if ($vsize) {
        $psize += $vsize;
        $vpos += $vsize;
        $vsize -= $vsize;
    }

    return $psize;
}
sub read {
    my $self= shift;
    # $_[0] = data
    my $len= $_[1];
    my $vofs= $self->{pos};
    $_[0]= "";

    my $physsize= calcphyssize($vofs, $len);
    my $pofs= $self->cv2file($vofs);

    $self->{fh}->seek($pofs, SEEK_SET);
    my $physdata;
    $self->{fh}->read($physdata, $physsize);

    $_[0]= "";
    my $dofs= 0;
    while ($len) {
        my $want= 0x800-($vofs%0x800);
        $want= $len if ($want > $len);

        $_[0] .= substr($physdata, $dofs, $want);

        $dofs += $want+8;
        $len -= $want;
        $vofs += $want;

        # remember footer info
        if (!$self->{footinfo} && ($vofs%0x800)==0 && $dofs>=8 && length($physdata)>$dofs) {
            my @f= unpack("VV", substr($physdata, $dofs-8, 8));
            if ($f[0]!=0xffffffff && $f[1]!=0xffffffff) {
                $self->{footinfo}= {
                    tag=> $f[1],
                    vblock=> $f[0],
                    pblock=>($vofs/0x800)-1,
                };
                printf("found foot reference: %08lx  v=%d -> p=%d\n", $self->{footinfo}{tag}, $self->{footinfo}{vblock}, $self->{footinfo}{pblock});
            }
        }
    }
    $self->{pos}= $vofs;
    return length($_[0]);
}
sub write {
    my $self= shift;

    my $vofs= $self->{pos};
    my $pofs= $self->cv2file($vofs);
    my $physdata="";
    if (($vofs%0x800)==0) {
        $physdata .= pack("VV", $self->vofs2physblocknr($vofs-0x800), $self->{footinfo}{tag});
        $pofs -= 8;
    }

    my $len= length($_[0]);
    my $dofs= 0;
    while ($len) {
        my $want= $len;
        if ($want > 0x800-($vofs%0x800)) {
            $want= 0x800-($vofs%0x800);
        }
        $physdata .= substr($_[0], $dofs, $want);

        $dofs += $want;
        $len -= $want;
        $vofs += $want;

        if (($vofs%0x800)==0) {
            $physdata .= pack("VV", $self->vofs2physblocknr($vofs-0x800), $self->{footinfo}{tag});
        }
    }

    $self->{fh}->seek($pofs, SEEK_SET);
    $self->{fh}->print($physdata);

    my $count= $vofs-$self->{pos};
    $self->{pos}= $vofs;
    $self->{maxwpos}= $vofs if !defined $self->{maxwpos} || $self->{maxwpos}<$vofs;
    return $count;
}
sub vofs2physblocknr {
    my ($self, $vofs)= @_;
    return ($vofs/0x800)+$self->{footinfo}{vblock}-$self->{footinfo}{pblock};
}
sub cv2file {
    my ($self, $ofs)= @_;
    # 000 -> 000
    # 7ff -> 7ff
    # 800 -> 808
    # 900 -> 908
    # fff -> 1007
    #1000 -> 1010

    my $block= int($ofs/0x800);
    my $bofs= $ofs % 0x800;

    return $block*0x808+$bofs;
}
sub filesize {
    my ($self)= @_;
    return ($self->{fh}->filesize()/($self->{blocksize}+8))*$self->{blocksize};
}
package main;
use strict;
use warnings;
use Getopt::Long;
use Carp;
use IO::File;
use integer;
$|=1;

my $reader;
my @fileops;
our $verbose=0;
my $readonly;
my $savedir;
my $forcetyph;
my %stats;
my $imgfs;
sub usage {
    return <<__EOF__
Usage: editimgfs file [edit commands]
   -add     romname[=filename]
   -del     romname
   -ren     oldromname=newromname
   -dump    romname
   -extract romname
   -d SAVEDIR        - where to extract to
   -list
__EOF__
}
GetOptions(
    "add=s" => sub {
        my @args;
        if ($_[1] =~ /^\s*(.*?)=(.*?)\s*$/) {
            my ($romname, $filename)= ($1,$2);
            push @args, $romname, $filename;
        }
        elsif ($_[1] =~ /^\s*(.*?)\s*$/) {
            my ($romname, $filename)= ($1,$1);
            $romname =~ s{.*[/\\]}{};
            push @args, $romname, $filename;
        }
        else {
            die "invalid add parameter: $_[1]\n";
        }
        die "$args[1] does not exist\n" if ! -r $args[1];
        push @fileops, { action=>\&del_file, param=>[ $args[0] ] };
        push @fileops, { action=>\&add_file, param=>[ @args ] };
    },
    "ren=s" => sub {
        my @args;
        if ($_[1] =~ /^\s*(.*?)=(.*?)\s*$/) {
            push @args, $1, $2;
        }
        else {
            die "invalid ren parameter: $_[1]\n";
        }

        push @fileops, { action=>\&ren_file, param=>[ @args ] };
    },
    "del=s" => sub {
        my @args;
        if ($_[1] =~ /^\s*(.*?)\s*$/) {
            push @args, $1;
        }
        else {
            die "invalid del parameter: $_[1]\n";
        }
        push @fileops, { action=>\&del_file, param=>[ @args ] };
    },
    "dump=s" => sub {
        my @args;
        if ($_[1] =~ /^\s*(.*?)\s*$/) {
            push @args, $1;
        }
        else {
            die "invalid dump parameter: $_[1]\n";
        }
        push @fileops, { action=>\&dump_file, param=>[ @args ] };
    },
    "extract=s" => sub {
        my @args;
        if ($_[1] =~ /^\s*(.*?)\s*$/) {
            push @args, $1;
        }
        else {
            die "invalid extract parameter: $_[1]\n";
        }

        push @fileops, { action=>\&extract_file, param=>[ @args, $savedir || "." ] };
    },
    "list" => sub {
        push @fileops, { action=>\&list_files, param=>[] };
    },
    "v+"   => \$verbose,
    "r"    => \$readonly,
    "d=s"  => \$savedir,
    "T"    => \$forcetyph,
) or die usage();

sub read_file {
    my ($srcname)= @_;
    my $ifh= SimpleFile->new($srcname, "r") or die "$srcname: $!\n";
    binmode $ifh;
    my $data;
    $ifh->read($data, $ifh->filesize());
    $ifh->close();
    return $data;
}
my $fn= shift or die usage();
my $fh= SimpleFile->new($fn, $readonly ? "r" : "r+") or croak "$fn: $!\n";
binmode $fh;

my $imgfs_hdr= findimgfs_header($fh) || die "could not find imgfs header\n";
#print map { sprintf("%08lx %s\n", $imgfs_hdr->{$_}, $_) } keys %$imgfs_hdr;
my $rd= $forcetyph || $imgfs_hdr->{readertype}==8 || $imgfs_hdr->{readertype}==0x20
        ? TyphReader->new($imgfs_hdr->{fh}, $imgfs_hdr->{baseofs})
        : $imgfs_hdr->{readertype}==0x40
        ? HimaReader->new($imgfs_hdr->{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});
}


$imgfs= ImgfsFile->new($rd, $imgfs_hdr);

printf("%d fileops\n", scalar @fileops) if $::verbose>1;
for (@fileops) {
    $_->{action}->(@{$_->{param}});
}

exit(0);

sub findimgfs_header {
    my ($fh)= @_;

    # the imgfs header signature ( at start of imgfs partition )
    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) {
            # the file we are processing starts with imgfs
            my @hdr= unpack("V7A4V2", substr($data, $i+16));
            if ($hdr[3]==0x34 && ($hdr[7] eq "LZX" || $hdr[7] eq "XPR" || $hdr[7] eq "XPH")) {
                printf("found hdr at %08lx\n", $ofs+$i) if $::verbose>1;
                return {
                    fh=>$fh,
                    baseofs=>$ofs+$i,
                    direntsize=>$hdr[3],     # 0x1c  dwBytesPerHeader
                    readertype=>$hdr[4],     # 0x20  dwChunksPerSector
                    dirblocksize=>$hdr[5],   # 0x24  dwFirstHeaderBlockOffset
                    firstdirofs=>$hdr[5],    # 0x24  dwFirstHeaderBlockOffset
                    compression=>$hdr[7],    # 0x2c  zCompressionType
                    freesectors=>$hdr[8],    # 0x30  dwFreeSectorCount

                    chunksperblock=>$hdr[4],
                    chunksize=>0x40,
                    entriesperblock=>int(($hdr[5]-8)/$hdr[3]),
                };
            }
            else {
                printf("WARNING: sig at %08lx, but inv hdr: %08lx %s\n", $i+$ofs, $hdr[3], $hdr[7]);
            }
        }
        elsif (substr($data, 510,2) eq "\x55\xaa") {
            # partition table
            if (substr($data, 0x1e2,1) eq "\x25") {
                # imgfs partition
                my ($start, $size)= unpack("VV", substr($data, 0x1e6, 8));
                $fh->read($data, 2048) or last;
                if (substr($data,0,8) eq "MSFLSH50") {
                    $ofs= $start*0x200;
                    next;
                }
                elsif (substr($data,0x200,8) eq "MSFLSH50") {
                    $ofs= $start*0x400;
                    next;
                }
                elsif (substr($data,0x600,8) eq "MSFLSH50") {
                    $ofs= $start*0x800;
                    next;
                }
                elsif (substr($data,0,16) eq "\x00\x00\x00\x00\xfd\xff\xfb\xffMSFLSH50") {
                    $fh= FFFBFFFD->new($fh, 0, 0x800);
                    $ofs= $start*0x200;
                    next;
                }
                elsif (substr($data,0x200,16) eq "\x00\x00\x00\x00\xfd\xff\xfb\xffMSFLSH50") {
                    $fh= FFFBFFFD->new($fh, 0, 0x800);
                    $ofs= $start*0x400;
                    next;
                }
                elsif (substr($data,0x600,16) eq "\x00\x00\x00\x00\xfd\xff\xfb\xffMSFLSH50") {
                    $fh= FFFBFFFD->new($fh, 0, 0x800);
                    $ofs= $start*0x800;
                    next;
                }
            }
        }
        $ofs += 0x10000;
    }
    return undef;
}


#top level
sub dump_file {
    my ($filename)= @_;
    $imgfs->dump($filename);
}
sub extract_file {
    my ($imgfsname, $targetpath)= @_;
    if (-d $targetpath) {
        $targetpath .= '/'.$imgfsname;
    }
    $imgfs->saveto($imgfsname, $targetpath);
}


sub add_file {
    my ($imgfsfile, $srcfile)= @_;
    if (my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
      $atime,$mtime,$ctime,$blksize,$blocks)= stat $srcfile) {
        my $data= read_file($srcfile);
        $imgfs->addfile($imgfsfile, $data, $mtime);
    }
    else {
        die "$srcfile: $!\n";
    }
}

sub ren_file {
    my ($oldname, $newname)= @_;
    $imgfs->rename($oldname, $newname);
}

sub del_file {
    my ($filename)= @_;
    $imgfs->delete($filename);
}

sub list_files {
    $imgfs->dumpinfo();
    for my $filename (keys %{$imgfs->{filebyname}}) {
        $imgfs->dump($filename);
    }
}