perl script to parse HTTP through tcpdump

This is buggy. The most difficulty is the gzip processing — since in that case, the order of packet is important.
I'll not rewrite this, since it already resolved the problem, which cause me write this snippet code. If you have change/fix something, an email is very appreciated.
If you need this, it's a headache.
This is also useful for sniff password or email(with arpspoof), :-).
#!/usr/bin/perl -w
#
# Author: jiangzuoyan@gmail.com
# 2008-07-22
#
# parse http get/send through
# tcpdump -S -lnx -s 40960 'tcp port 80 and (((ip[2:2] - ((ip[0]&0xf)<<2)) - ((tcp[12]&0xf0)>>2)) != 0)'
#
# this is buggy.
use Getopt::Long;
use warnings;
use strict;

#open (STDIN,"/usr/sbin/tcpdump -lnx -s 40960 'tcp port 80 and (((ip[2:2] - ((ip[0]&0xf)<<2)) - ((tcp[12]&0xf0)>>2)) != 0)'|");
my ($srchost, $dsthost, $seqstart, $seqend, $ack, $packet);

# packet = {srchost: dsthost:, seqstart:, seqend:, ack:}
my @packets;

sub add_packet {
  return unless $_[5] && length($_[5]) && $_[0] && length($_[0]);
  my @tmp = @_;
  $packets[@packets] = \@tmp;
  #print "add packet (" , join(",", @_[0..4]) , "), lidx=", $#packets, "\n";
}
sub is_following {
  my ($a, $b) = (shift, shift); #@_;
  return ($$a[0] eq $$b[0]) &&
    ($$a[1] eq $$b[1]) &&
    ($$a[4] eq $$b[4]) &&
    ($$a[3] eq $$b[2]);
}

sub compare_packet() {
  my ($a, $b) = (shift, shift);
  my ($ret, $idx) = 0;
  for ($idx = 0; !$ret && $idx < 5; ++$idx) {
    $ret =  $$a[$idx] cmp $$b[$idx];
  }
  return $ret;
}

sub print_packets {
  return unless @packets;
  my $idx = 0;
  my ($srchost, $dsthost, $seqstart, $seqend, $ack, $packet) = @{$packets[$idx]};
  for ($idx = 1; $idx < @packets; ++$idx) {
    #print "check is_following (", join(",", @{$packets[$idx-1]}[0..4]), ") , (", join(",", @{$packets[$idx]}[0..4]), ")\n";
    if (&is_following($packets[$idx-1], $packets[$idx])) {
      $packet .= $packets[$idx][5];
      $seqend = $packets[$idx][3];
    } else {
      #print $idx, " is not following...\n";
      while ($packet && length($packet)) {
        $packet = &print_packet($srchost, $dsthost, $seqstart, $seqend, $ack, $packet);
      }
      ($srchost, $dsthost, $seqstart, $seqend, $ack, $packet) = @{$packets[$idx]};
    }
  }
  while ($packet && length($packet)) {
    $packet = &print_packet($srchost, $dsthost, $seqstart, $seqend, $ack, $packet);
  }
}
sub print_packet{
  #print "on print packet, (", join(",", @_[0..4]), ")\n";
  my ($srchost, $dsthost, $seqstart, $seqend, $ack, $packet) = @_;
  return unless $packet && $srchost && $dsthost;
  print "##FROM-TO:$srchost -> $dsthost $seqstart,$seqend ack $ack\n";
  my $hp = index($packet, "\r\n\r\n");
  if ($hp != -1) {
    my $header = substr($packet, 0, $hp);
    print "##GOT HEAD\n", $header, "\n\n";
    my ($clen) = $header =~ /[\r\n]Content-Length: +([0-9]+)\s/;
    $clen = 0 unless $clen;
    my  $data;
    if ($clen) {
      $data = substr($packet, $hp + 4, $clen);
      $packet = substr($packet, $hp + 4 + $clen);
    } else {
      $data = substr($packet, $hp+4);
      $packet = "";
    }
    if ($header =~ /[\r\n]Content-Encoding: +gzip\s/) {
      print "##got gzip content len=$clen\n";
      open(GZIP, "| gunzip");
      print GZIP $data;
      close(GZIP);
    } elsif($header =~ /[\r\n]Content-Type: image\//) {
      print "##got a image ....\n";
    } else {
      print "##got plain content len=$clen\n";
      print $data;
    }
  } else {
    print "##UNFOUND HEADER PACKET\n";
    print $packet;
    $packet = "";
  }
  print "\n##EFROM-TO:$srchost -> $dsthost\n";
  return $packet;
}
binmode STDOUT;
while (<>) {
  if (/^\S/) {
    &add_packet($srchost, $dsthost, $seqstart, $seqend, $ack, $packet);
    ($srchost, $dsthost, $seqstart, $seqend, $ack)
      = /(\d+(?:\.\d+){4})\s+>\s+(\d+(?:\.\d+){4}):[^0-9]+([0-9]+):([0-9]+)\([0-9]+\) ack ([0-9]+)/;
    $packet = "";
  } else {
    next if /\s+0x00[012]0:\s+/;
    s/^(\s+0x[0-9a-f]+:\s+[0-9a-f\s]{0,40}).*$/$1/;
    s/^(\s+0x0030:\s+)(?:[0-9a-f]{4}\s+){1,2}/$1/;
    s/^\s+0x[0-9a-f]+:\s+//;
    s/\s*$//;
    s/([0-9a-f]{2})\s?/chr(hex($1))/eg;
    $packet .= $_;
  }
}
@packets = sort {&compare_packet($a, $b) } @packets;
&print_packets();

No comments: