parsecrash.pl

dumprom source code,use for learning the dumprom.exe tool for wince

    my ($mod)= @_;
    printf("%08lx %08lx %08lx %08lx %02x %s\n",
        struct('Module.inuse', $mod),
        struct('Module.BasePtr', $mod),
        struct('Module.e32.e32_vbase', $mod),
        struct('Module.startip', $mod),
        struct('Module.bTrustLevel', $mod),
        $vimg->ReadWString(struct('Module.lpszModName', $mod)));
}
if ($doListModules) {
    for (my $mod= kdata('KINX_MODULES') ; $mod ; $mod= struct('Module.pMod', $mod)) {
        DumpModuleEntry($mod);
    }
}
if ($doDumpMemory) {
    croak "specify virtual address with -d\n" if (!@ARGV);
    my $addr= eval(shift);
    croak "specify virtual address with -d\n" if (!defined $addr);

    for (my $i= 0 ; $i<256 ; $i+=4) {
        printf("%08lx: ", $addr+$i) if (($i%16)==0);
        printf(" %08lx", $vimg->ReadDword($addr+$i));
        printf("\n") if (($i%16)==12);
    }
}
if ($doSaveSection == 1) {
    croak "specify virtual address with -s\n" if (!@ARGV);
    my $addr= eval(shift);
    croak "specify virtual address with -s\n" if (!defined $addr);
    my $length= eval(shift);
    croak "specify length with -s\n" if (!defined $length);

    my $savefile= shift;
    croak "specify savefile with -s\n" if (!$savefile);

    my $fh= IO::File->new($savefile, "w") or croak "$savefile: $!\n";
    binmode $fh;

    for (my $ofs= $addr ; $ofs < $addr + $length ; $ofs += 0x1000)
    {
        my $data;
        eval {
            $data= $vimg->ReadData($ofs, 0x1000);
        };
        if (!$@) {
            $fh->print($data);
        }
        else {
            $fh->seek(0x1000, SEEK_CUR);
        }
    }
}
if ($doSaveSection == 2) {
    SaveAllSections();
}
if ($doSectionOverview) {
    PrintSectionOverview();
}
if ($doListHandles) {
    ListHandles();
}
exit(0);
sub isStartPtr {
    my $ofs= shift;
    return ((struct('HDATA.hValue', $ofs)&3)!=2);
}
sub handle2HData {
    my $h= shift;
    return kdata('handleBase')+($h&0x1ffffffc);
}
sub handleFFSD {
    my ($vmbase, $obj)= @_;
    return struct("FFSDinfo.pFileinfo->pFilename->name", $obj, $vmbase);
}
sub handleHFSD {
    my ($vmbase, $obj)= @_;
    return struct("FFSDinfo.pGtgtInfo->pWStrName->str", $obj, $vmbase);
}
sub handleW32D {
    my ($vmbase, $obj)= @_;
    return sprintf("%s%d:", 
        struct("fsopendev_t.lpDev->type", $obj, $vmbase),
        struct("fsopendev_t.lpDev->index", $obj, $vmbase)
    );
}
sub handleW32H {
    my ($vmbase, $obj)= @_;

    return sprintf("oid %08lx", struct("W32Hinfo.oid", $obj, $vmbase));
}
sub handlePFSD {
    my ($vmbase, $obj)= @_;
    return "" if ($obj==1);
    return struct("FFSDinfo.name", $obj, $vmbase);
}
sub handleBDEV {
    my ($vmbase, $obj)= @_;
    return sprintf("%s - %s", 
        struct("BDEVinfo.name1", $obj, $vmbase),
        struct("BDEVinfo.name2", $obj, $vmbase));
}
sub handleSTRG {
    my ($vmbase, $obj)= @_;
    return sprintf("%s %s %s",
        struct("STRGinfo.pstorageinfo->devname", $obj, $vmbase),
        struct("STRGinfo.pstorageinfo->desc1", $obj, $vmbase),
        struct("STRGinfo.pstorageinfo->desc2", $obj, $vmbase));
}
sub handleFMAP {
    my ($vmbase, $obj)= @_;
    return struct("FSMAP.name->name", $obj, $vmbase);
}
sub structdumper {
    my ($type, $vmbase, $ofs, $parent)= @_;
    return "(null)" if ($ofs==0);
    return sprintf("(null_%04lx)",$ofs) if ($ofs<0x10000);

    if ($type eq "CINFO") {
        # special handling for cinfo.
        $vmbase= struct("CINFO.pServer->dwVMBase", $ofs);
    }

    if ( exists $dumptypes{vmofs($ofs,$vmbase)} && $dumptypes{vmofs($ofs,$vmbase)} ne $type 
         && $dumptypes{vmofs($ofs,$vmbase)} ne "APISET" && $type ne "CINFO") {
         #  APISET = { CINFO + dword }
        warn sprintf("\n!%08lx : %s != %s  - %s {%s}\n", $ofs, $dumptypes{vmofs($ofs,$vmbase)}, $type, $parent, join(", ", @{$dumpoffsets{vmofs($ofs,$vmbase)}}) );
    }
    else {
        $dumptypes{vmofs($ofs,$vmbase)}= $type;
    }
    $dumpedstructs{vmofs($ofs, $vmbase)}++;

    my @itemstrs;
    for my $item (sort { $a->{ofs} <=> $b->{ofs} } values %{$structs{$type}{items}}) {
        my $dumppath= sprintf("%s->%s.%s:%08lx", $parent, $type, $item->{name}, $ofs);
        if (exists $item->{ptype}) {
            my @values= struct("$type.$item->{name}", $ofs, $vmbase);
            for my $ixval (0..$#values) {
                my $val= $values[$ixval];
                next if (!$vimg->isValidPtr(vmofs($val, $vmbase)));
                push @{$dumpoffsets{vmofs($val,$vmbase)}}, sprintf("%s[%d]", $dumppath, $ixval);
                if ( exists $dumptypes{vmofs($val,$vmbase)} && $dumptypes{vmofs($val,$vmbase)} ne $item->{ptype} ) {
                    warn sprintf("\n!%s:%08lx %s=%08lx: %s != %s - %s {%s}\n", 
                        $type, $ofs, $item->{name}, vmofs($val,$vmbase), 
                        $dumptypes{vmofs($val,$vmbase)}, $item->{ptype}, $parent, join(", ", @{$dumpoffsets{vmofs($ofs,$vmbase)}}) );
                }
                else {
                    $dumptypes{vmofs($val,$vmbase)}= $item->{ptype};
                }
            }
        }
        elsif ($item->{type} eq "DWORD") {
            my @values= struct("$type.$item->{name}", $ofs, $vmbase);
            for my $ixval (0..$#values) {
                my $val= $values[$ixval];
                next if (!$vimg->isValidPtr(vmofs($val, $vmbase)));
                # todo: add value index to offset string for items.count>1
                push @{$dumpoffsets{vmofs($val,$vmbase)}}, sprintf("%s[%d]", $dumppath, $ixval);
            }
        }
        if (exists $structs{$item->{type}}{format}) {
            my @value= struct("$type.$item->{name}", $ofs, $vmbase);
            push @itemstrs, sprintf("%s=[%s]", $item->{name}, join(",", map { sprintf($structs{$item->{type}}{format}, $value[$_]) } (0..$#value)));
        }
        else {
            push @itemstrs, sprintf("%s=[%s]", $item->{name}, join(",", map {
                        structdumper($item->{type}, $vmbase, structofs("$type.$item->{name}", $ofs, $vmbase)+$structs{$item->{type}}{size}*$_, 
                            sprintf("%s[%d]", $dumppath, $_)) 
                    } (0..$item->{count}-1)));
        }
    }
    return sprintf("%s:%s", $type, join(", ", @itemstrs));
}
sub ListHandles
{
    my $ha= handle2HData(kdata('hCurProc'));
    my $hi= $ha;
    do {
        if (isStartPtr($ha)) {
            $ha= struct('HDATA.fwd', $ha);
        }
        my $acname= struct('HDATA.pci->acName', $ha);
		printf("%08lx %-4s  %08lx %08lx", $ha, $acname, struct('HDATA.hValue', $ha), struct('HDATA.pvObj', $ha));
        $dumptypes{$ha}= "HDATA";
        $dumpedstructs{$ha}++;

        if (!exists $handletypes{$acname}) {
        }
        else {
            if ($g_verbose) {
                print " ", structdumper($handletypes{$acname}{structtype},
                    struct('HDATA.pci->pServer', $ha) ? struct('HDATA.pci->pServer->dwVMBase', $ha) : 0, 
                    struct('HDATA.pvObj', $ha), sprintf("HDATA[%08lx].pvObj", $ha));
            }
            elsif (exists $handletypes{$acname}{simpledump}) {
                print " ", $handletypes{$acname}{simpledump}(
                    struct('HDATA.pci->pServer', $ha) ? struct('HDATA.pci->pServer->dwVMBase', $ha) : 0, 
                    struct('HDATA.pvObj', $ha));
            }

        }
        print "\n";

        $ha= struct('HDATA.fwd', $ha);
    } while ($hi != $ha);

    if ($g_verbose) {
        my $newcount;
        do {
            $newcount=0;
            for my $ofs (keys %dumpoffsets) {
                if (!exists $dumpedstructs{$ofs}) {
                    eval {
                        if (exists $dumptypes{$ofs}) {
                            printf("%08lx##:%s{%s} %s\n", $ofs, $dumptypes{$ofs}, join(", ", @{$dumpoffsets{$ofs}}), structdumper($dumptypes{$ofs}, ofsvm($ofs), $ofs, sprintf("%s", $dumpoffsets{$ofs}[0])));
                        }
                        else {
                            printf("%08lx##{%s} %s\n", $ofs, join(", ", @{$dumpoffsets{$ofs}}), structdumper("DWLIST", ofsvm($ofs), $ofs, sprintf("%s", $dumpoffsets{$ofs}[0])));
                        }
                    };
                    if ($@) { printf("%08lx!!!!!%s  %s\n", $ofs, exists $dumptypes{$ofs}?$dumptypes{$ofs}:"", $@); }
                    $dumpedstructs{$ofs}++;
                    $newcount++;
                }
            }
        } while ($newcount);
    }
}
sub SaveAllSections
{
}
sub PrintSectionOverview
{
    my %phys;
    for my $ixSection (1..63, 0xb3) {
        my $pscn = $vimg->ReadDword(kdata('KINX_SECTIONS') + 4*$ixSection);
        if ($pscn!=0) {
            for my $ixBlock (0..511) {
                my $pmb = $vimg->ReadDword($pscn+4*$ixBlock);
                if ($pmb!=0 && $pmb!=1) {
                    my $apages= struct("MemBlock.aPages", $pmb);
                    for my $ixPage (0..15) {
                        my $dwPage= $vimg->ReadDword($apages+4*$ixPage);
                        if ($dwPage!=~0xf && $dwPage!=0) {
                            push @{$phys{$dwPage&0xfffff000}}, $ixSection;
                        }
                    }
                }
            }
        }
    }
    # todo: process KINX_MEMINFO  -> freelists
    my %stotal;
    for my $pofs (keys %phys) {
        $stotal{$_} += 0x1000 / @{$phys{$pofs}} for @{$phys{$pofs}};
    }
    printf("memory usage per secion:\n");
    for my $ix (sort { $a<=>$b } keys %stotal) {
        printf("%02x : %8x\n", $ix*2, $stotal{$ix});
    }
    my $prevptag;
    my $prevprintedofs;
    my $lastpofs;
    for my $pofs (sort {$a<=>$b} keys %phys)
    {
        my $ptag= join(":",map { sprintf("%02x", $_) } sort {$a<=>$b} @{$phys{$pofs}});

        if (!defined $lastpofs) {
            printf("%08lx-%08lx ----\n", 0, $pofs);
            $prevptag= undef;
            $prevprintedofs= $pofs;
        }
        elsif (defined $lastpofs && $pofs-$lastpofs>0x1000) {
            if (defined $prevptag) {
                printf("%08lx-%08lx  %s\n", $prevprintedofs, $lastpofs+0x1000, $prevptag);
            }
            printf("%08lx-%08lx ----\n", $lastpofs+0x1000, $pofs);
            $prevptag= undef;
            $prevprintedofs= $pofs;
        }
        elsif (defined $prevptag && $prevptag ne $ptag) {
            printf("%08lx-%08lx  %s\n", $prevprintedofs, $lastpofs+0x1000, $prevptag);
            $prevprintedofs= $lastpofs+0x1000;
        }
        $prevptag= $ptag;
        $lastpofs= $pofs;
    }
    printf("%08lx-%08lx  %s\n", $prevprintedofs, $lastpofs+0x1000, $prevptag);
    printf("%08lx-%08lx ----\n", $lastpofs+0x1000, -1);
}
sub DumpOpenExe {
    my $addr= shift;

    my $type= struct('openexe_t.filetype', $addr);
    my $isoid= struct('openexe_t.bIsOID', $addr);

    if ($type==2) {   # objstore
        printf("openexe: objectstore handle=%08lx pm=%04x %08lx",
            struct('openexe_t.handle', $addr),
            struct('openexe_t.pagemode', $addr),
            struct('openexe_t.offset', $addr));
    }
    elsif ($type==3) {# romimage
        printf("openexe: TOCentry=%08lx pm=%04x %08lx",
            struct('openexe_t.handle', $addr),
            struct('openexe_t.pagemode', $addr),
            struct('openexe_t.offset', $addr));
    }
    elsif ($type==4) {# extimage
        printf("openexe: ppfs handle=%08lx pm=%04x %08lx",
            struct('openexe_t.handle', $addr),
            struct('openexe_t.pagemode', $addr),
            struct('openexe_t.offset', $addr));
    }
    if ($isoid) {
        printf("  oid=%08lx\n", struct('openexe_t.name', $addr));
    }
    else {
        printf("  name=%s\n", struct('openexe_t.name->name', $addr));
    }
}
sub DumpProcessEntry {
    my $addr= shift;

    return if (struct('PROCESS.dwVMBase', $addr)==0);

    my $nameptr= struct('PROCESS.lpszProcName', $addr);
    my $cmdlineptr= struct('PROCESS.pcmdline', $addr);

    #todo:
    #  create object that translates process memory.
    my $procnum= struct('PROCESS.procnum', $addr);
    printf("%08lx: slot%02lx vmbase=%08lx hProc= %08lx  name=%08lx:%s  cmd=%08lx:%s\n",
        $addr,
        $procnum,
        struct('PROCESS.dwVMBase', $addr),
        struct('PROCESS.hProc', $addr),
        $nameptr,
        $vimg->ReadWString($nameptr),
        $cmdlineptr,
        $vimg->ReadWString($cmdlineptr));

    DumpOpenExe(structofs('PROCESS.oe', $addr));

    if (struct('PROCESS.pTh', $addr)) {
        DumpThreads(struct('PROCESS.pTh', $addr));
    }
}
sub DumpThreads {
    my $firstaddr= shift;

    my $addr= $firstaddr;
    while (1) {
        DumpThread($addr);

        $addr= struct('THREAD.pNextInProc', $addr);
        last if ($addr==0 || $addr==$firstaddr);
    }
}
sub DumpThread {
    my $addr= shift;
    printf("%08lx:    hTh=%08lx  SP=%08lx LR=%08lx PC=%08lx  prio=%02x.%02x start=%08lx  kern=%08lx  user=%08lx\n",