#!perl -w# (C) 2003-2007 Willem Jan Hengeveld <itsme@xs4all.nl># Web: http://www.xs4all.nl/~itsme/#      http://wiki.xda-developers.com/## $Id: parsecrash.pl 1762 2008-04-10 11:57:55Z itsme $#use strict;use IO::File;use Carp qw(croak verbose);use Getopt::Long qw(:config no_ignore_case);use Dumpvalue;my $d= new Dumpvalue;$|=1;# find the tlb by looking for 'vfffd0000' in the output of 'pmemmap -v'# magician:#  load 0xa0000000 allram.nb#  tlb 0xa0660000## typhoon:# load 0x20001000 4640.mem# load 0x10000000 8300.mem# load 0x10200000 8c00.mem# load 0x20000000 8e00.mem# load 0x11d00000 8f10.mem# tlb 0x10200000 # #  himalaya:#  0xfffd0000 -> 0x901c0000  TLB#  0xffff0000 -> 0x901c4000  vectors#  0xffffc000 -> 0x901c5000  Kdata##  z:/sources/wince500/PUBLIC/COMMON/SDK/INC/winnt.h#     IMAGE_DOS_HEADER#  z:/sources/wince500/PUBLIC/COMMON/SDK/INC/kfuncs.h#     SH_*  #  z:/sources/wince500/PUBLIC/COMMON/OAK/INC/romldr.h#     ROMHDR, TOCentry, FILESentry#  z:/sources/wince500/PRIVATE/WINCEOS/COREOS/NK/INC/kernel.h#     cinfo APISet MemBlock CALLSTACK openexe_t#     Thread PGPOOL_Q Process Module FSMAP HDATA ##  z:/sources/wince500/PRIVATE/WINCEOS/COREOS/NK/INC/nkarm.h#     KDataStruct _CPUCONTEXT##  z:/sources/wince500/PRIVATE/WINCEOS/COREOS/NK/INC/schedule.h#     PROXY EVENT CRIT MUTEX SEMAPHORE CLEANEVENT##  z:/sources/wince500/PUBLIC/COMMON/OAK/INC/pehdr.h#     e32_lite o32_lite info e32_exe## z:/sources/wince500/PUBLIC/COMMON/SDK/INC/winbase.h#     CRITICAL_SECTION## z:/sources/wince500/PUBLIC/COMMON/OAK/INC/pkfuncs.h#     KINX_* constants## z:/sources/wince500/PUBLIC/COMMON/SDK/INC/winioctl.h#     FILE_DEVICE_* constants#my %syms;my %structs= (    char=> {size=>1, format=>'%s'},    wchar=>{size=>2, format=>'%s'},    BYTE=> {size=>1, format=>'%02x'},    WORD=> {size=>2, format=>'%04x'},    DWORD=>{size=>4, format=>'%08lx'},);readsymbols();#$d->dumpValue(\%structs);sub readsymbols {    my $curtype= "";    my $curstruct= "";    while (<DATA>) {        if (/^!struct\s(\w+)/) {            $curstruct= $1;            $curtype= undef;            $structs{$curstruct}= {size=>0, items=>{}};        }        elsif (/^!(\w+)/) {            $curtype= $1;            $curstruct= undef;        }        elsif ($curtype && /^(\w+)\s+(\w+)/) {            $syms{$curtype}{$2}= eval($1);        }        elsif ($curstruct && /^(\w+)\s+(\*)?(\w+)(?:@(\d+))?\s+(\w+)/) {            my ($ofs, $ptrflag, $type, $count, $itemname)= (eval($1), $2, $3, $4 || 1, $5);            my $ptype;            if ($ptrflag) {                $ptype= $type;                $type= "DWORD";            }            $structs{$curstruct}{items}{$itemname}= {                ofs=>$ofs,                type=>$type,                count=>$count,                name=>$itemname,                $ptrflag?(ptype=>$ptype):(),            };            if (!exists $structs{$type}) {                croak "unknown type $type  in struct $curstruct\n";            }            if ($structs{$curstruct}{size} != $ofs) {                warn sprintf("offset-size mismatch: o=%08lx s=%08lx  %s.%s\n",                     $ofs, $structs{$curstruct}{size}, $curstruct, $itemname);            }            $structs{$curstruct}{size} += $count * $structs{$type}{size};        }    }}my %handletypes= (    FFSD=> { simpledump=>\&handleFFSD, structtype=>'FFSDinfo' },    HFSD=> { simpledump=>\&handleHFSD, structtype=>'FFSDinfo' },    W32D=> { simpledump=>\&handleW32D, structtype=>'fsopendev_t' },    W32H=> { simpledump=>\&handleW32H, structtype=>'W32Hinfo' },    PFSD=> { simpledump=>\&handlePFSD, structtype=>'FFSDinfo' },    BDEV=> { simpledump=>\&handleBDEV, structtype=>'BDEVinfo' },    STRG=> { simpledump=>\&handleSTRG, structtype=>'STRGinfo' },    FMAP=> { simpledump=>\&handleFMAP, structtype=>'FSMAP' },    PROC=> {    structtype=>'PROCESS' },    THRD=> {    structtype=>'THREAD' },    APIS=> {    structtype=>'APISET' },    EVNT=> {    structtype=>'EVENT' },    MUTX=> {    structtype=>'MUTEX' },    SEMP=> {    structtype=>'SEMAPHORE' },    DBOA=> {    structtype=>'DBInfo' },    Sock=> {    structtype=>'SocketInfo' },);my $img= PhysicalMemory->new();my %dumptypes;my %dumpedstructs;my %dumpoffsets;my $doListProcesses= 0;my $doListKdata= 0;my $doDumpMemory= 0;my $doSaveSection= 0;my $doSectionOverview= 0;my $doListHandles= 0;my $doListModules= 0;my $g_verbose= 0;sub usage {    return <<__EOF__Usage: parsecrash [-d VOFS] [-p] [-k] [-s VADDR LEN file] cfgfile   -p  : list processes   -k  : list kdata   -d  : dump memory   -s  : save section   -S  : save all sections   -h  : list handles   -o  : section overview   -v  : verbose__EOF__}GetOptions(    "p"=>\$doListProcesses,    "k"=>\$doListKdata,    "d"=>\$doDumpMemory,    "m"=>\$doListModules,    "s"=>\$doSaveSection,    "S"=> sub { $doSaveSection= 2; },    "h"=>\$doListHandles,    "o"=>\$doSectionOverview,    "v"=>\$g_verbose,) or croak usage();my $cfgname= shift || croak usage();my $cfg= LoadConfig($cfgname);sub LoadConfig {    my ($fn)= @_;    my $fh= IO::File->new($fn, "r") or croak "LoadConfig $fn: $!\n";    my %cfg;    while (<$fh>)    {        s/\s+$//;        next if (/^$/);        next if (/^\s*[#;]/);        if (/load\s+(\w+)\s+(.*)/i) {            push @{$cfg{images}}, { poffset=>eval($1), filename=>$2 };        }        elsif (/tlb\s+(\w+)/i) {            $cfg{PhysTLBOffset}= eval($1);        }        else {            croak "unrecognized cfg line: $_\n";        }    }    $fh->close();    return \%cfg;}for (@{$cfg->{images}}) {    $img->Load($_->{filename}, $_->{poffset});}my $vimg= VirtualMemory->new($img, $cfg->{PhysTLBOffset});$vimg->SetSectionTable(kdata('KINX_SECTIONS'));sub kdata {    my $sym= shift;        return $vimg->ReadDword($syms{kdata}{$sym});}sub vmofs {    my ($ofs, $vmbase)= @_;    if ($vmbase && $ofs>=0x10000 && $ofs<0x02000000) { $ofs += $vmbase; }    return $ofs;}sub ofsvm {    my ($ofs)= @_;    if ($ofs<0x80000000) {        return $ofs&0xfe000000;    }    return 0;}sub structofs {    my ($sym, $ofs, $vmbase)= @_;    if ($vmbase && $ofs<0x02000000) { $ofs += $vmbase; }    if ($sym =~ /^(\w+)\.(\w+)((?:\.|->).*)?$/) {        my ($structname, $itemname, $subitems)= ($1, $2, $3);        if (!exists $structs{$structname}) {            croak "invalid structname $structname\n";        }        if (!exists $structs{$structname}{items}{$itemname}) {            croak "invalid itemname $structname.$itemname\n";        }        my $item= $structs{$structname}{items}{$itemname};        if (!defined $subitems) {            return $item->{ofs}+$ofs;        }        elsif ($subitems =~ /^\./) {            return structofs("$item->{type}$subitems", $ofs+$item->{ofs}, $vmbase);        }        elsif ($subitems =~ /^->(.*)/) {            return structofs("$item->{ptype}.$1", struct("$structname.$itemname", $ofs, $vmbase), $vmbase);        }        else {            croak "invalid subitem spec: $sym\n";        }    }    else {        croak "invalid struct spec: '$sym'\n";    }}sub struct {    my ($sym, $ofs, $vmbase)= @_;    #printf("struct(%s %08lx)\n", $sym, $ofs);    if ($vmbase && $ofs<0x02000000) { $ofs += $vmbase; }    if ($sym =~ /^(\w+)\.(\w+)((?:\.|->).*)?$/) {        my ($structname, $itemname, $subitems)= ($1, $2, $3);        if (!exists $structs{$structname}) {            croak "invalid structname $structname\n";        }        if (!exists $structs{$structname}{items}{$itemname}) {            croak "invalid itemname $structname.$itemname\n";        }        my $item= $structs{$structname}{items}{$itemname};        my @result;        if (!defined $subitems) {            if ($item->{type} eq "DWORD") {                for (0..$item->{count}-1) {                    push @result, $vimg->ReadDword($ofs+4*$_+$item->{ofs});                }            }            elsif ($item->{type} eq "WORD") {                for (0..$item->{count}-1) {                    push @result, $vimg->ReadWord($ofs+2*$_+$item->{ofs});                }            }            elsif ($item->{type} eq "BYTE") {                for (0..$item->{count}-1) {                    push @result, $vimg->ReadByte($ofs+$_+$item->{ofs});                }            }            elsif ($item->{type} eq "char") {                my @chars;                for (0..$item->{count}-1) {                    my $char= $vimg->ReadByte($ofs+$_+$item->{ofs});                    last if ($char==0);                    push @chars, $char;                }                #printf("char: @chars\n");                push @result, pack("C*", @chars);            }            elsif ($item->{type} eq "wchar") {                my @chars;                for (0..$item->{count}-1) {                    my $wchar= $vimg->ReadWord($ofs+$_*2+$item->{ofs});                    last if ($wchar==0);                    push @chars, $wchar;                }                push @result, pack("U*", @chars);            }            else {                croak "unknown primitive type in struct $sym: $item->{type}\n";            }        }        elsif ($subitems =~ /^\./) {            if (exists $structs{$item->{type}}) {                for (0..$item->{count}-1) {                    push @result, struct("$item->{type}$subitems", $ofs+$_*$structs{$item->{type}}{size}+$item->{ofs}, $vmbase);                }            }            else {                croak "could not resolve struct specifier $sym\n";            }        }        elsif ($subitems =~ /^->(.*)/) {            for (0..$item->{count}-1) {                my $ptr= struct("$structname.$itemname", $ofs, $vmbase);                if ($ptr) {                    push @result, struct("$item->{ptype}.$1", $ptr, $vmbase);                }                else {                    push @result, 0xFFFFFFFF;                }            }        }        else {            croak "invalid subitem spec: $sym\n";        }        if (@result==1) {            return $result[0];        }        else {            return @result;        }    }    else {        croak "invalid struct spec: '$sym'\n";    }}if ($doListKdata) {    for (sort { $syms{kdata}{$a} <=> $syms{kdata}{$b} } keys %{$syms{kdata}}) {        eval { printf("%08lx %-20s  %08lx\n", $syms{kdata}{$_}, $_, kdata($_)); };    }}if ($doListProcesses) {    my $procbase= kdata('KINX_PROCARRAY');    printf("procbase= %08lx  curproc=%08lx(%08lx) curthread=(%08lx)%08lx\n",         $procbase, kdata('hCurProc'), kdata('pCurPrc'), kdata('hCurThread'), kdata('pCurThd'));    if (!$procbase) {        croak "could not find procbase\n";    }    for (my $pi= 0 ; $pi<32 ; $pi++) {        #todo: 0xf0 = sizeof(PROCESS)        DumpProcessEntry($pi*0xf0+$procbase);    }}sub DumpModuleEntry {    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),