#!/usr/bin/perl # # [ 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 () {
$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; } 
