packaging/tcpdump-qeth

   1 #!/usr/bin/perl
   2 # (C)2002 by IBM Corporation, published under terms of the GPL V2
   3 # Author: Holger Smolinski <smolinsk@de.ibm.com>
   4 # this file is a wrapper around tcpdump, which provides the capability
   5 # for debugging qeth and/or HiperSocket(TM) network interfaces under
   6 # Linux for S/390 and zSeries. tcpdump Syntax is preserved.
   7 # Bugs: When the input pipe ends the process is not stopped.
   8
   9 use Getopt::Std;
  10
  11 my $incmd,$outcmd;
  12
  13 getopts ("adeflnNOpqRStuvxXc:C:F:i:m:r:s:T:w:E:",\%options);
  14
  15 # Check which options to replace for the reader process
  16 if ( defined($options{'r'}) ) {
  17   $incmd = "cat $options{'r'}";
  18   $filter_out = 1;
  19 } else {
  20   $incmd = "tcpdump -l -w -";
  21   $filter_out = 0;
  22   if ( defined($options{'i'}) ) {
  23     $incmd .= " -i ".$options{'i'};
  24     delete $options{'i'}; # remove -i option from option list
  25   }
  26   foreach $key (@ARGV) {
  27     $incmd .= " $key";
  28   }
  29 }
  30
  31 $outcmd = "tcpdump -r -";
  32 # Rebuild arglist for the writer process
  33 delete $options{'r'}; # remove -r option from option list
  34 foreach $key (keys %options) {
  35   if ((index "adeflnNOpqRStuvxX",$key) >= 0 ) {
  36     $outcmd .= " -$key";
  37   } else {
  38     $outcmd .= " -$key $options{$key}";
  39   }
  40   if ( $filter_out == 1 ) {
  41     foreach $key (@ARGV) {
  42       $outcmd .= " $key";
  43     }
  44   }
  45 }
  46
  47 open READER,"$incmd|" or die "Cannot spawn reader command $incmd";
  48 open WRITER,"|$outcmd" or die "Cannot spawn writer command $outcmd";
  49
  50 sysread READER,$filehdr,24 or die "Cannot read file header";
  51 ($magic,$version_major,$version_minor,$thiszone,$sigfigs,$snaplen,$linktype) =
  52   unpack("ISSIIII",$filehdr);
  53 $snaplen += 14;
  54 $filehdr = pack ("ISSIIII",($magic,$version_major,$version_minor,$thiszone,$sigfigs,$snaplen,$linktype));
  55 syswrite WRITER,$filehdr,24;
  56
  57 $etherheaderip6 = pack ("IIIS",(0,0,0,0x8dd));
  58 $etherheaderip4 = pack ("IIIS",(0,0,0,0x800));
  59
  60 while ( 1 ) {
  61   $hdrd = 0;
  62   do {$hdrd += sysread READER, $pkthdr, 16-$hdrd, $hdrd; } while ($hdrd < 16);
  63   ($seconds,$usecs,$caplen,$len) = unpack ("IIII",$pkthdr);
  64   $hdrd = 0;
  65   do {$hdrd += sysread READER, $packet,$caplen-$hdrd, $hdrd; } while ($hdrd < $caplen);
  66   $paktype = unpack("C",$packet);
  67   if ( $paktype & 0xf0 == 0x60 ) {
  68     $caplen += 14;
  69     $len += 14;
  70     $header = $etehrheaderip6;
  71   } elsif ($paktype >= 0x45 && $paktype <= 0x4f ) {
  72     $caplen += 14;
  73     $len += 14;
  74     $header = $etherheaderip4;
  75   } else {
  76     $header = "";
  77   }
  78   $pkthdr = pack ("IIII",($seconds,$usecs,$caplen,$len));
  79   syswrite WRITER,"$pkthdr$header$packet",16+$caplen;
  80 }