contrib/packet_utils.pm

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