contrib/packet_utils.pm

   1 package packet_utils;
   2
   3 # $Id: packet_utils.pm 1100 2005-01-25 09:12:47Z stanleyhopcroft $
   4
   5 # Revision 1.1  2005/01/25 09:12:47  stanleyhopcroft
   6 # packet creation and dumping hacks used by check_ica* and check_lotus
   7 #
   8 # Revision 1.1  2005-01-25 15:28:58+11  anwsmh
   9 # Initial revision
  10 #
  11
  12 require Exporter;
  13 @ISA = qw(Exporter);
  14 @EXPORT_OK = qw(tethereal pdump);
  15
  16 sub tethereal {
  17         my ($tethereal_dump, $start_byte) = @_ ;
  18
  19         # Return a string or array (depending on context) containing the characters from a tethereal trace.
  20         # Skip all stuff until the first byte given by $start_byte in the first row ..
  21
  22         &outahere("Invalid tethereal dump:", substr($tethereal_dump, 0, 71), 'fails to match m#\d\d\d\d  \S\S(?: \S\S){1,15}#')
  23                 unless $tethereal_dump =~ m#\d\d\d\d  \S\S(?: \S\S){1,15}# ;
  24
  25         my @tethereal_dump      = split(/\n/, $tethereal_dump) ;
  26         my $first_line          = shift @tethereal_dump ;
  27         $first_line                     = unpack('x6 a48', $first_line) ;
  28                                                                                                 # Take one extra space (after hex bytes) to use a template of 'a2 x' x 16
  29                                                                                                 # instead of 'a2 x' x 15 . 'a2'
  30         my $last_line           = pop @tethereal_dump ;
  31         $last_line                      = unpack('x6 a48', $last_line) ;
  32
  33         my $idx = index($first_line, $start_byte) ;
  34
  35         &outahere(qq(Invalid tethereal dump: "$start_byte" not found in first line - "$first_line"))
  36                 if $idx == -1 ;
  37
  38         $first_line = substr($first_line, $idx) ;
  39
  40         my ($dump, @dump) = ('', ()) ;
  41
  42         my $bytes = 0 ;
  43         $bytes++
  44                 while $first_line =~ m#\b\S\S#g ;
  45         push @dump, unpack('a2x' x $bytes, $first_line) ;
  46
  47         push @dump, unpack('x6 ' . 'a2x' x 16, $_)
  48                 foreach @tethereal_dump ;
  49
  50         $bytes = 0 ;
  51         $bytes++
  52                 while $last_line =~ m#\b\S\S#g ;
  53
  54                                                                                                 # Be more cautious with the last line; the ASCII decode may
  55                                                                                                 # have been omitted.
  56
  57         push @dump, unpack(('a2x' x ($bytes - 1)) . 'a2', $last_line) ;
  58
  59         return wantarray ? map pack('H2', $_), @dump : pack('H2' x scalar @dump, @dump) ;
  60         # return wantarray ? map hex($_), @dump : pack('H2' x scalar @dump, @dump) ;
  61
  62 }
  63
  64 sub pdump {
  65         my ($x) = shift @_ ;
  66         my (@bytes_in_row, $row, $dump) ;
  67
  68         my $number_in_row = 16 ;
  69         my $number_of_bytes = length $x ;
  70         my $full_rows = int( $number_of_bytes / $number_in_row ) ;
  71         my $bytes_in_last_row = $number_of_bytes % $number_in_row ;
  72         my $template = "a$number_in_row " x $full_rows ;
  73         my $nr = 0 ;
  74                                                                                                 # Output format styled on tethereal.
  75         foreach $row ( unpack($template, $x) ) {
  76                 @bytes_in_row = unpack('C*', $row) ;
  77                 $row =~ tr /\x00-\x1f\x80-\xff/./ ;
  78                 $dump .= join('  ', sprintf('%4.4x', $nr * 0x10), join(' ', map { sprintf "%2.2x", $_} @bytes_in_row), $row) ;
  79                 $dump .= "\n" ;
  80                 $nr++ ;
  81         }
  82
  83         if ( $bytes_in_last_row ) {
  84                 my $number_of_spaces = ($number_in_row - $bytes_in_last_row)*3  - 2 ;
  85
  86                                                                                                 # 3 spaces (2 digts + 1 space) for each digit printed
  87                                                                                                 # minus two spaces for those added by the join('  ',) below.
  88
  89                 $row = substr($x, -$bytes_in_last_row) ;
  90                 @bytes_in_row = unpack('C*', $row) ;
  91                 $row =~ tr /\x00-\x1f\x80-\xff/./ ;
  92                                                                                                 # my $bytes = join(' ', map { sprintf "%2.2x", $_} @bytes_in_row) ;
  93                                                                                                 # See comment below.
  94                 my $spaces = ' ' x $number_of_spaces ;
  95                 $dump .= join('  ', sprintf("%4.4x", $nr * 0x10 ), join(' ', map { sprintf "%2.2x", $_} @bytes_in_row), $spaces, $row) ;
  96                 $dump .= "\n" ;
  97         }
  98
  99         print STDERR $dump, "\n" ;
 100
 101 =begin comment
 102
 103 tsitc> perl -MBenchmark -e 'timethese(1_00_000, { printf => q<printf "%2.2x %2.2x %2.2x\n", 61, 62, 63>, sprintf => q<$x = sprintf "%2
 104 .2x %2.2x %2.2x\n", 61, 62, 63; print $x>} )' | perl -ne 'print if /intf/'
 105
 106 Benchmark: timing 100000 iterations of printf, sprintf...
 107     printf:  1 wallclock secs ( 0.55 usr +  0.00 sys =  0.55 CPU)
 108    sprintf:  0 wallclock secs ( 0.11 usr +  0.00 sys =  0.11 CPU)
 109
 110 so having sprintf in a loop seems more rational than a printf for the line ...
 111
 112 =comment
 113
 114 =cut
 115
 116 }
 117
 118
 119