1 |
#!/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 |
my $dump_chars = 0; |
10 |
my $debug = 1; |
11 |
|
12 |
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 |
printf("%-5s 0x%02x %-80s %s\n", $op, $#msg, join(' ', @msg), $dump_chars ? as_chars( @msg ) : ''); |
59 |
$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 |
|