#!/usr/bin/perl

#
# [ http://www.rootshell.com/ - 3/9/98 ]
#
# This script has the same command line interface as tcpdump since it's fed
# directly to tcpdump :-).  The output is a bunch of files containing the tcp
# data and can be quite useful when you need to reconstruct the original data.
# eg a .gif file.  In case you haven't picked it up yet, you need tcpdump from
# ftp://ftp.ee.lbl.gov/tcpdump.tar.Z
#
# It doesn't do sequence number checking yet (it's stateless), meaning amongst
# other things that if you run it on a loopback interface, you'll see two of
# everything unless you have a good filter, since all packets will be captured
# twice.  Once going out, once going in.  'inbound/outbound' would be perfect
# if they worked.
#
# You can probably speed it up with a good filter too.  eg, you don't want to
# be bothered by non-tcp and non-data-carrying packets since they are
# (read should be) ignored anyway.  You can safely add these to the line
# that opens tcpdump, just as I've added "-x", but I get the feeling this is
# The Wrong Thing, since it could screw up the "compatibility" with tcpdumps
# command line.
#
# You probably want to wind the tcpdump packet capture size up to that of a
# full packet (with -s) unless you're only trying to capture keystrokes and
# gosh, why would you want to do that?
#

# Run tcpdump with the args that were given to us.
open (STDIO,"tcpdump -x @ARGV |");

# Change back to the real user.  Consider the line above.  This doesn't work?
$>=$< ; $)=$( ;

# This originaly came from a2p and is probably the only remaining line.  OUCH!
$[ = 1;			# set array base to 1

$opened="::";
$tcpData="";
$fh="";

# Profiling code.  See alarmhandler().
#$picks=$opens=0;
#$state="[start]";
#$SIG{ALRM}='alarmhandler';
#alarm 1;

line: while (<STDIO>) {
	$procLine++;
	# tcpdump description line.
	if (/^\d/) {
		@Fld = split(' ', $_, 5);
		$sourceDest = "$Fld[2]:$Fld[4]";
		$procLine = -1;
		$tcpDataLine=$ipLen=$turbo=0;
		$lookForNow="procIpHeader";
		next line;
	}
	# Turbo Mode for large data packets.
	if ($turbo!=0) {
		dataLineOut();
		next line;
	}

	# Prepare line (now containing hex chars only) for substr();
	# This is a bottleneck.
	s/\W//g;

	goto $lookForNow;

	# First line of packet data (ip header).
	procIpHeader:
	if (($procLine == 0) && (substr($_,19,2)=="06")) {
		$ipHeaderLen = ((hex substr($_, 2, 1)) << 2);
		$tcpHeaderLenLine = (($ipHeaderLen+12) >> 4);
		$tcpHeaderLenWord = (($ipHeaderLen+12) % 16);
		$ipLen = hex substr($_,5,4);
		$ipEndLine = $ipLen>>4;
		$ipEndWord = $ipLen%16;
		$lookForNow="procTcpHeader";
	}
	next line;

	# Process tcp header.  There's only one thing we need to do here.
	procTcpHeader:
	if ($procLine == $tcpHeaderLenLine) {
		$HeaderLen = $ipHeaderLen+((hex substr($_,($tcpHeaderLenWord<<1)+1, 1)) << 2);
		$tcpDataLine = (($HeaderLen) >> 4);
		$tcpDataWord = (($HeaderLen) % 16);
		$lookForNow="extract";
	}

	if ($ipLen<=($HeaderLen)) {next line}

	# Extract tcp data.  Want to get rid of tcpDataLine.
	extract:
	if ($tcpDataLine && $tcpDataLine<=$procLine && $procLine<=$ipEndLine) {
		$turbo=ipEndLine-$procLine;
		dataLineOut();
	}
}
# Flush the remaining data.
$tcpData=~s/\W//g;
printf $fh pack ("H*",$tcpData);
alarmhandler();

sub dataLineOut {
# This entire function is a bottleneck.  Specialy for large packets.
	if ($tcpDataLine==$procLine) {
		# Write the previous packet to disk and grab the new packet.
		# One big subst is faster than lots of little ones.
		# This assumes we have pure hex char pairs.
		$tcpData=~s/\W//g;
		printf $fh pack ("H*",$tcpData);
		&Pick('>>', $sourceDest) || print ("File open error") ;
		$tcpData=substr($_,($tcpDataWord<<1)+1);
	} else { $tcpData.=$_; }
	if ($procLine==$ipEndLine) {
		# Remove end of packet garbage.
		# Can be omitted if you know there is none.
		#$tcpData=substr($tcpData,1,($ipLen-$HeaderLen)<<1);
		$turbo=($ipEndLine-$procLine);
	}
}

# Needs a cache of open files.  This isn't the bottleneck though.
sub Pick {
	$picks++;
	local($mode,$name) = @_;
	if ($opened ne $name) {
		$opens++;
		close($fh);
		$opened = $name;
		open($fh,$mode.$name."");
		$return=1;
	} else { $return=1; }
	return $return;
}

# Old but useful profiling code.
# Uncomment the profiling code at the top to use.  You need to add $state=
# lines before points in the code you're trying to profile.
sub alarmhandler {
	$states{$state}++;
	print (%states," $opens/$picks\n");
	alarm 1;
}