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