Line # Revision Author
1 11 dpavlin #!/usr/bin/perl -w
2
3 # portmon-3m-810-decode.pl
4 #
5 # 09/22/08 23:53:24 CEST Dobrica Pavlinusic <dpavlin@rot13.org>
6
7 use Data::Dump qw/dump/;
8
9 14 dpavlin my $dump_chars = 0;
10 11 dpavlin my $debug = 1;
11 14 dpavlin
12 11 dpavlin my $p;
13
14 sub as_chars {
15 my $c = join('', map { chr(hex($_)) } @_ );
16 $c =~ s/[^a-zA-Z0-9]/./g;
17 return $c;
18 }
19
20 while(<>) {
21 chomp;
22 next unless m/IRP_MJ_(READ|WRITE)/;
23
24 my ( $op, $data ) = (split(/\t/, $_))[3,6];
25
26 # $op = $op =~ m/READ/ ? '<<' : '>>';
27 $op =~ s/IRP_MJ_//;
28
29 warn "?? $op $data\n" if $debug;
30
31 if ( $data =~ m/Length\s+(\d+):\s+(.+)/ ) {
32 my ( $this_len, $hex ) = ( $1, $2 );
33 $hex = $p->{$op} . " $hex";
34 $hex =~ s/^\s+//;
35 $p->{$op} = $hex;
36
37 warn "#### p->{op}: $hex" if $debug;
38
39 my @h = split(/\s+/, $hex);
40
41 my $h = join(' ', @h);
42 $h =~ s/(D[56])/ $1/g; # indent known commands
43
44 warn sprintf "## RAW %-5s %2d %-30s '%s'\n",$op,$this_len,$h,as_chars( @h );
45
46 if ( $h[0] =~ m/D[56]/ ) {
47 # do we have length?
48 if ( ! defined $h[2] ) {
49 warn "## no length yet: $h\n";
50 } else {
51 my $len = hex($h[2]) + 0x100 * hex($h[1]);
52 my $curr_len = $#h - 2; # strip length
53 if ( $curr_len < $len ) {
54 warn "## packet not full $curr_len < $len : $h\n";
55 } else {
56 warn sprintf("FULL %5s %2d | %s\n", $op, $len, $h);
57 my @msg = splice( @h, 0, $len + 3 );
58 14 dpavlin printf("%-5s 0x%02x %-80s %s\n", $op, $#msg, join(' ', @msg), $dump_chars ? as_chars( @msg ) : '');
59 11 dpavlin $p->{$op} = join(' ', @h);
60 warn "LEFT: ", $p->{$op} if $p->{$op};
61 }
62 }
63 } else {
64 warn "## not valid command: $h\n";
65 $p->{$op} = '';
66 }
67 } else {
68 warn "SKIPPED $op\t$data\n";
69 }
70 }
71
72