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