#!/usr/local/bin/perl -w
use strict;
# script to decode the rapi-invoke stream from the ida wince debugger
$|=1;
# see ~/projects/ida/archive/ida550/idasdk/plugins/debugger /consts.h
my %rpc= (
 0=>{ name=>'OK',   },
 1=>{ name=>'UNK'   },
 2=>{ name=>'MEM'   },
 3=>{ name=>'OPEN'  },
 4=>{ name=>'EVENT', fmtwce=>[qw(debugevent:event)] },
 5=>{ name=>'EVOK'  },
10=>{ name=>'INIT', fmtida=>[qw(long:debug)] },
11=>{ name=>'TERM', fmtida=>[qw(-)] },
12=>{ name=>'GET_PROCESS_INFO', fmtida=>[qw(long:n str:input )], fmtwce=>[qw(processinfo)] },
13=>{ name=>'DETACH_PROCESS', fmtida=>[qw(-)] },
14=>{ name=>'START_PROCESS', fmtida=>[qw(str:path str:args str:startdir long:flags str:inputpath long:filecrc)] }, 
15=>{ name=>'GET_DEBUG_EVENT', fmtida=>[qw(long:idle)], fmtwce=>[qw(debugevent:event)] },
16=>{ name=>'ATTACH_PROCESS', fmtida=>[qw(long:pid long:eventid)]  },
17=>{ name=>'PREPARE_TO_PAUSE_PROCESS', fmtida=>[qw(-)] },
18=>{ name=>'EXIT_PROCESS', fmtida=>[qw(-)] },
19=>{ name=>'CONTINUE_AFTER_EVENT', fmtida=>[qw(debugevent:event)] },
20=>{ name=>'STOPPED_AT_DEBUG_EVENT'   },
21=>{ name=>'TH_SUSPEND', fmtida=>[qw(long:tid)] },
22=>{ name=>'TH_CONTINUE', fmtida=>[qw(long:tid)] },
23=>{ name=>'TH_SET_STEP', fmtida=>[qw(long:tid)] },
24=>{ name=>'READ_REGS', fmtida=>[qw(long:tid long:n)], fmtwce=>[qw(regvals:regs)] },
25=>{ name=>'GET_MEMORY_INFO', fmtida=>[qw()], fmtwce=>[qw(long:n meminfo)] },
26=>{ name=>'READ_MEMORY', fmtida=>[qw(ea:ea long:size)], fmtwce=>[qw(rest:bytes)] },
27=>{ name=>'WRITE_MEMORY', fmtida=>[qw(ea:ea mem:bytes)] },
28=>{ name=>'ISOK_BPT', fmtida=>[qw(long:type ea:ea long:len)] },
29=>{ name=>'ADD_BPT', fmtida=>[qw(long:type ea:ea long:len)] },
30=>{ name=>'DEL_BPT', fmtida=>[qw(ea:ea mem:origbytes)] },
31=>{ name=>'WRITE_REG', fmtida=>[qw(long:tid long:regidx regvals:regs)] },
32=>{ name=>'GET_SREG_BASE', fmtida=>[qw(long:tid long:value)] },
33=>{ name=>'SET_EXCEPTION_INFO', fmtida=>[qw(long:qty excinfo)] },
34=>{ name=>'OPEN_FILE', fmtida=>[qw(str:file long:readonly)], fmtwce=>[qw(long:handle long:size)] },
35=>{ name=>'CLOSE_FILE', fmtida=>[qw(long:handle)] },
36=>{ name=>'READ_FILE', fmtida=>[qw(long:handle long:off long:size)], fmtwce=>[qw(mem:bytes)] },
38=>{ name=>'WRITE_FILE', fmtida=>[qw(long:handle long:off mem:bytes)] },
39=>{ name=>'IOCTL',      fmtida=>[qw(long:fn mem:request)], fmtwce=>[qw(mem:reply)] },
50=>{ name=>'SET_DEBUG_NAMES'          },
51=>{ name=>'SYNC_STUB'                },
52=>{ name=>'ERROR'                    },
53=>{ name=>'MSG'                      },
54=>{ name=>'WARNING'                  },
);
my $longdecoder;
my %decoders= (
    long=>{ decode=>sub {
            my $hd= ord(substr($_[0], $_[1],1));
            #printf("hd:%02x\n", $hd);
            if ($hd==0xff) {
                my $val= unpack("N", substr($_[0], $_[1]+1,4));
                $_[1] += 5;
                return $val;
            }
            elsif (($hd&0xc0)==0xc0) {
                my $val= unpack("N", substr($_[0], $_[1],4));
                $_[1] += 4;
                return $val&0x3fffffff;
            }
            elsif (($hd&0xc0)==0x80) {
                my $val= unpack("n", substr($_[0], $_[1],2));
                $_[1] += 2;
                return $val&0x3fff;
            }
            elsif (($hd&0xc0)==0x00) {
                $_[1] += 1;
                return $hd&0x3f;
            }
            die sprintf("unknown long format: %s\n", unpack("H*", substr($_[0], $_[1], 8)));
        }, fmt=>sub { return sprintf("0x%x", $_[0]); } },
    ea=>{ decode=>sub {
            my $ea= $longdecoder->($_[0], $_[1]);
            if (($ea&1)==1) {
                return $ea&0x3ffffffe;
            }
            die sprintf("unsupported EA encoding: %s\n", unpack("H*", substr($_[0], $_[1], 8)));
        }, fmt=>sub { return sprintf("0x%08x", $_[0]); } },
    mem=>{ decode=>sub { #mem   : long + bytes
            my $size= $longdecoder->(@_);
            if ($_[1]>length($_[0]) || $_[1]+$size>length($_[0])) {
                printf("!!!! l=%d,  o=%d, s=%d\n", length($_[0]), $_[1], $size);
            }
            my $data= substr($_[0], $_[1], $size);
            $_[1]+=$size;
            return $data;
        }, fmt=>sub { return unpack("H*", $_[0]); } },
    rest=>{ decode=>sub {
            my $data= substr($_[0], $_[1]);
            $_[1]= length($_[0]);
            return $data;
        }, fmt=>sub { return unpack("H*", $_[0]); } },
    str=>{ decode=>sub { #str   : NUL term string
            my $nul= index($_[0], "\x00", $_[1]);
            my $str= substr($_[0], $_[1], $nul-$_[1]);
            $_[1]= $nul+1;
            return $str;
        }, fmt=>sub { return "'$_[0]'"; } },

    #debugevent
    #excinfo
    #meminfo
    #processinfo
    #regvals     - list of 12 byte items
);
$longdecoder= $decoders{long}{decode};
my $prevtype;
my $t0;
while (<>) {
    if (/(\d+\.\d+):\w+([<>])\s+\d+\s+\d+\s+(\w+)/) {
        my ($ts, $dir, $data)= ($1, $2, pack("H*", $3));
        while (length($data)) {
            my ($len, $type, $payload)= unpack("NCa*", $data);
            #printf("data: %s\n", unpack("H*", $data));
            $data= substr($payload, $len);
            $payload= substr($payload, 0, $len);
            if ($len != length($payload)) {
                printf("!!! l=%x, p=%x\n", $len, length($payload));
            }
            #printf("payload: %s\n", unpack("H*", $payload));
            my $fmt= $dir eq '>' ? $rpc{$prevtype||$type}{fmtwce} : $rpc{$type}{fmtida};
            my $str= $fmt ? decodeformat($fmt, $payload) : "";
            $str ||= unpack("H*", $payload);
            printf("%+11.6f %-30s %s\n", $t0 ? $ts-$t0 : 0, $rpc{$type}{name}, $str);

            $prevtype= $type;
        }
        $t0= $ts;
    }
}
sub decodeformat {
    my ($fmt, $data)= @_;
    my $ofs=0;
    my @items;
    #printf("decoding %s\n", unpack("H*", $data));
    for my $item (@$fmt)
    {
        if ($item !~ /^(\w+):(\w+)$/) {
            warn "invalid fmt: $item\n";
            push @items, "?".unpack("H*", substr($data, $ofs)) if ($ofs<length($data));
            last;
        }
            
        my ($type, $name)= ($1, $2);
        if (!exists $decoders{$type}) {
            push @items, "?".unpack("H*", substr($data, $ofs));
            last;
        }

        my $xofs= $ofs;
        my $value= $decoders{$type}{decode}->($data, $ofs);
        #printf("%d-%d: %s %s\n", $xofs, $ofs, unpack("H*", substr($data, $xofs, $ofs-$xofs)), $type);

        push @items, sprintf("%s:%s", $name, $decoders{$type}{fmt}->($value));
    }
    push @items, "+".unpack("H*", substr($data, $ofs)) if ($ofs<length($data));
    push @items, "---" if ($ofs>length($data));

    return join(", ", @items);
}