#!/usr/bin/perl
#Copyright 2004 William Stearns <wstearns@pobox.com>
#Released under the GPL
#Version 0.2.6

#FIXME
#get and set ip options

#Note that this is under development.

#Future Usage: tcpsed.pl s//FIELD=value
#Future Usage: tcpsed.pl s/restrict/FIELD=value

#This has been tested on Linux, but should have no problems running on
#any platform with perl. Requires perl-Net-RawIP; see
#http://www.stearns.org/perl/ for RPMs or http://www.cpan.org for
#source.

#use strict;
use warnings;

use Net::RawIP qw(:pcap);
use Net::Pcap;
use Getopt::Long;

#Strange.  If I don't initialize icmp => {} here, I get incorrect values
#later (echo _reply_ instead of request, etc). Net::RawIP({icmp=>{}})
#needed.
#Update, appears this has to be hardcoded to the type of traffic
#expected to be sniffed.  Ugh.
#{icmp=>{}, tcp=>{}, udp=>{}}
my $RawPacket = new Net::RawIP({});	#Hmmm, adding in generic=>{} causes icmp to stop parsing icmp packets.  FIXME.


my $USAGEMSG = <<USAGE;
Usage tcpsed [options] Field=Newvalue
Available fields to change
IPversion, IPtos, IPtot_len, IPid, IPfrag_off, IPttl, IPprotocol, IPsaddr, IPdaddr
TCPsource, TCPdest, TCPseq, TCPack_seq, TCPdoff, TCPres1, TCPres2, TCPurg, TCPack, TCPpsh, TCPrst, TCPsyn, TCPfin, TCPwindow, TCPurg_ptr, TCPdata
ICMPtype, ICMPcode, ICMPgateway, ICMPid, ICMPsequence, ICMPunused, ICMPmtu, ICMPdata
UDPsource, UDPdest, UDPlen, UDPdata
GENERICdata

The following are ignored:
IPihl, IPcheck, TCPcheck, UDPcheck, ICMPcheck
USAGE

my $Timeout =		-1;

my $Param;
my $FieldName;
my $FieldValue;

#Command line settable
my $Device =			"eth0";
my $BPFilter =			'';
my $PcapInputFile =		'';
my $PcapOutputFile =		'';
my $Snaplen =			1500;
my $PacketsToProcess =		-1;				#All


die "$USAGEMSG" unless GetOptions(	'count|c=i' =>		\$PacketsToProcess,
					'device|i=s' =>		\$Device,
					'filter=s' =>		\$BPFilter,
					'read|r=s' =>		\$PcapInputFile,
					'snaplen|s=i' =>	\$Snaplen
				);

#File writing doesn't work - it seems Net::RawIP doesn't support writes at all, and I'll need to install Net::Pcap as well.
#perl -MCPAN -e 'install Net::Pcap'
#					'write|w=s' =>		\$PcapOutputFile


#We won't set IPcheck, IPihl, TCPcheck, UDPcheck, ICMPcheck
if ($Param = shift) {
	($FieldName, $FieldValue) = split(/=/, $Param, 2);
	if (($FieldName ne 'IPversion') &&
	    ($FieldName ne 'IPtos') &&
	    ($FieldName ne 'IPtot_len') &&
	    ($FieldName ne 'IPid') &&
	    ($FieldName ne 'IPfrag_off') &&
	    ($FieldName ne 'IPttl') &&
	    ($FieldName ne 'IPprotocol') &&
	    ($FieldName ne 'IPsaddr') &&
	    ($FieldName ne 'IPdaddr') &&
	    ($FieldName ne 'TCPsource') &&
	    ($FieldName ne 'TCPdest') &&
	    ($FieldName ne 'TCPseq') &&
	    ($FieldName ne 'TCPack_seq') &&
	    ($FieldName ne 'TCPdoff') &&
	    ($FieldName ne 'TCPres1') &&
	    ($FieldName ne 'TCPres2') &&
	    ($FieldName ne 'TCPurg') &&
	    ($FieldName ne 'TCPack') &&
	    ($FieldName ne 'TCPpsh') &&
	    ($FieldName ne 'TCPrst') &&
	    ($FieldName ne 'TCPsyn') &&
	    ($FieldName ne 'TCPfin') &&
	    ($FieldName ne 'TCPwindow') &&
	    ($FieldName ne 'TCPurg_ptr') &&
	    ($FieldName ne 'TCPdata') &&
	    ($FieldName ne 'ICMPtype') &&
	    ($FieldName ne 'ICMPcode') &&
	    ($FieldName ne 'ICMPgateway') &&
	    ($FieldName ne 'ICMPid') &&
	    ($FieldName ne 'ICMPsequence') &&
	    ($FieldName ne 'ICMPunused') &&
	    ($FieldName ne 'ICMPmtu') &&
	    ($FieldName ne 'ICMPdata') &&
	    ($FieldName ne 'UDPsource') &&
	    ($FieldName ne 'UDPdest') &&
	    ($FieldName ne 'UDPlen') &&
	    ($FieldName ne 'UDPdata') &&
	    ($FieldName ne 'GENERICdata') ) {
		die "Don't know how to handle $FieldName.\n";
	}
	if (defined($FieldValue)) {
		print "Changing $FieldName to $FieldValue\n";
	} else {
		die "Missing value for $FieldName.\n";
	}
} else {
	die "What, no changes?.\n";
}

my $pcap;
if ($PcapInputFile ne '') {
	$pcap = $RawPacket->pcapinit_offline($PcapInputFile);
} else {
	$pcap = $RawPacket->pcapinit($Device,$BPFilter,$Snaplen,$Timeout);
}

##my $Dump_handle;
#my $DumpFileDumper;
#if ($PcapOutputFile ne '') {
#	#Hmm.  This entire approach doesn't work
#	#$Dump_handle = Net::Pcap::pcapinit_offline($PcapOutputFile) || die "$!";
#
#	$DumpFileDumper = Net::Pcap::dump_open($pcap, $PcapOutputFile) || die "$!";
#	#unless (ref($DumpFileDumper) eq "GLOB") { print "Not a fh ref\n" . ref($DumpFileDumper); }
#}


loop $pcap, $PacketsToProcess, \&CreateNew, $RawPacket;

sub CreateNew {
	$RawPacket->bset(substr($_[2],14));

	my $User_Data = shift;
	my $hdr = shift;
	my $pkt = shift;

	my %PF;		#Features of the current Packet

	($PF{IPversion}, $PF{IPihl}, $PF{IPtos}, $PF{IPtot_len}, $PF{IPid}, $PF{IPfrag_off}, $PF{IPttl}, $PF{IPprotocol}, $PF{IPcheck}, $PF{IPsaddr}, $PF{IPdaddr}) =
	$RawPacket->get({ ip => [qw(version ihl tos tot_len id frag_off ttl protocol check saddr daddr)] });

	if ($PF{IPprotocol} == 6) {
		my $OldTcpPacket = new Net::RawIP({tcp => {} });
		$OldTcpPacket->bset(substr($pkt,14));
		my $NewPacket = new Net::RawIP({tcp => {} });

		($PF{TCPsource}, $PF{TCPdest}, $PF{TCPseq}, $PF{TCPack_seq}, $PF{TCPdoff}, $PF{TCPres1}, $PF{TCPres2}, $PF{TCPurg}, $PF{TCPack}, $PF{TCPpsh}, $PF{TCPrst}, $PF{TCPsyn}, $PF{TCPfin}, $PF{TCPwindow}, $PF{TCPcheck}, $PF{TCPurg_ptr}, $PF{TCPdata}) =
		 $OldTcpPacket->get({ tcp => [qw(source dest seq ack_seq doff res1 res2 urg ack psh rst syn fin window check urg_ptr data)]});

		$PF{$FieldName} = $FieldValue;

		$NewPacket -> set ( { ip => { version=>$PF{IPversion}, tos=>$PF{IPtos}, tot_len=>$PF{IPtot_len}, id=>$PF{IPid}, frag_off=>$PF{IPfrag_off}, ttl=>$PF{IPttl}, protocol=>$PF{IPprotocol}, saddr=>$PF{IPsaddr}, daddr=>$PF{IPdaddr} },
		 tcp => { source=>$PF{TCPsource}, dest=>$PF{TCPdest}, seq=>$PF{TCPseq}, ack_seq=>$PF{TCPack_seq}, doff=>$PF{TCPdoff}, res1=>$PF{TCPres1}, res2=>$PF{TCPres2}, urg=>$PF{TCPurg}, ack=>$PF{TCPack}, psh=>$PF{TCPpsh}, rst=>$PF{TCPrst}, syn=>$PF{TCPsyn}, fin=>$PF{TCPfin}, window=>$PF{TCPwindow}, urg_ptr=>$PF{TCPurg_ptr}, data=>$PF{TCPdata} } } );

#		if ($PcapOutputFile ne '') {
#			Net::RawIP::dump($DumpFileDumper, \%hdr, $NewPacket) || die "$!";
#		} else {
			$NewPacket -> send;
			$NewPacket -> DESTROY;
#		}
	} elsif ($PF{IPprotocol} == 17) {
		my $OldUdpPacket = new Net::RawIP({udp => {} });
		$OldUdpPacket->bset(substr($pkt,14));
		my $NewPacket = new Net::RawIP({udp => {} });

		($PF{UDPsource}, $PF{UDPdest}, $PF{UDPlen}, $PF{UDPcheck}, $PF{UDPdata}) =
		$OldUdpPacket->get({ udp => [qw(source dest len check data)]});

		$PF{$FieldName} = $FieldValue;

		$NewPacket -> set ( { ip => { version=>$PF{IPversion}, tos=>$PF{IPtos}, tot_len=>$PF{IPtot_len}, id=>$PF{IPid}, frag_off=>$PF{IPfrag_off}, ttl=>$PF{IPttl}, protocol=>$PF{IPprotocol}, saddr=>$PF{IPsaddr}, daddr=>$PF{IPdaddr} },
		 udp => { source=>$PF{UDPsource}, dest=>$PF{UDPdest}, len=>$PF{UDPlen}, data=>$PF{UDPdata} } } );

#		if ($PcapOutputFile ne '') {
#			$Dump_handle -> dump(\$pkt, $NewPacket);
#		} else {
			$NewPacket -> send;
			$NewPacket -> DESTROY;
#		}
	} elsif ($PF{IPprotocol} == 1) {
		my $OldIcmpPacket = new Net::RawIP({icmp => {} });
		$OldIcmpPacket->bset(substr($pkt,14));
		my $NewPacket = new Net::RawIP({icmp => {} });

		($PF{ICMPtype}, $PF{ICMPcode}, $PF{ICMPcheck}, $PF{ICMPgateway}, $PF{ICMPid}, $PF{ICMPsequence}, $PF{ICMPunused}, $PF{ICMPmtu}, $PF{ICMPdata}) =
		$OldIcmpPacket->get({ icmp => [qw(type code check gateway id sequence unused mtu data)]});

		print "Type " . $PF{ICMPtype} . ", Code " . $PF{ICMPcode} . ".\n";

		$PF{$FieldName} = $FieldValue;

		$NewPacket -> set ( { ip => { version=>$PF{IPversion}, tos=>$PF{IPtos}, tot_len=>$PF{IPtot_len}, id=>$PF{IPid}, frag_off=>$PF{IPfrag_off}, ttl=>$PF{IPttl}, protocol=>$PF{IPprotocol}, saddr=>$PF{IPsaddr}, daddr=>$PF{IPdaddr} },
		 icmp => {type=>$PF{ICMPtype}, code=>$PF{ICMPcode}, gateway=>$PF{ICMPgateway}, id=>$PF{ICMPid}, sequence=>$PF{ICMPsequence}, unused=>$PF{ICMPunused}, mtu=>$PF{ICMPmtu}, data=>$PF{ICMPdata} } } );

#		if ($PcapOutputFile ne '') {
#			$Dump_handle -> dump(\$pkt, $NewPacket);
#		} else {
			$NewPacket -> send;
			$NewPacket -> DESTROY;
#		}
	} else {
		my $OldGenericPacket = new Net::RawIP({generic => {} });
		$OldGenericPacket->bset(substr($pkt,14));
		my $NewPacket = new Net::RawIP({generic => {} });

		$PF{GENERICdata} = $OldGenericPacket->get({ generic => [qw(data)]});

		$PF{$FieldName} = $FieldValue;

		$NewPacket -> set ( { ip => { version=>$PF{IPversion}, tos=>$PF{IPtos}, tot_len=>$PF{IPtot_len}, id=>$PF{IPid}, frag_off=>$PF{IPfrag_off}, ttl=>$PF{IPttl}, protocol=>$PF{IPprotocol}, saddr=>$PF{IPsaddr}, daddr=>$PF{IPdaddr} },
		 generic => { data=>$PF{GENERICdata} } } );
	
#		if ($PcapOutputFile ne '') {
#			$Dump_handle -> dump(\$pkt, $NewPacket);
#		} else {
			$NewPacket -> send;
			$NewPacket -> DESTROY;
#		}
	}
}



#Graveyard
#print "Daddr is $PF{IPdaddr}, FieldName $FieldName, FieldValue is $FieldValue\n";
#print "Daddr is $PF{IPdaddr}\n";
		#print $PF{TCPsource}," ",$PF{TCPdest} . "\n";
		#print $PF{TCPsource}," ",$PF{TCPdest}," ",$PF{TCPseq}, $PF{TCPack_seq}, $PF{TCPdoff}, $PF{TCPres1}, $PF{TCPres2}, $PF{TCPurg}, $PF{TCPack}, $PF{TCPpsh}, $PF{TCPrst}, $PF{TCPsyn}, $PF{TCPfin}, $PF{TCPwindow}, $PF{TCPcheck}, $PF{TCPurg_ptr}, $PF{TCPdata} . "\n";











##Start Main()
#my $USAGEMSG = <<USAGE;
#Usage freedups.pl [options]
#Options (default value in parentheses; 1=Enabled, 0=Disabled):
#  --actuallylink|-a		Actually link the files, otherwise, just report on potential savings and preload the md5sum cache. ($ActuallyLink)
#  --cachefile=<cache file>	File that holds cached queries and responses ($CacheFile) *
#  --datesequal|-d		Require that the modification dates and times be equal before linking ($DatesEqual)
#  --filenamesequal|-f		Require that the two (pathless) filenames be equal before linking ($FileNamesEqual)
#  --help|-h			This help message
#  --mafiles			Maximum number of files to remember for a given inode, reduct to save memory ($MaxFiles)
#  --minsize|-m=<minimum size>	Only consider files larger than this number of bytes ($MinSize)
#  --paranoid|-p			Recheck all file stats and completely compare every byte of the files just before linking.  This should definitely be left on unless you are _positive_ that the md5 checksum cache is correct and there's no chance that files will be modified behind freedups' back. ($Paranoid)
#  --quiet|-q			Show almost nothing; forces verbosity to 0.
#  --verbose|-v			Show more detail (Default verbosity=$Verbosity)
#* For security reasons, this file must be created before starting freedups or it will not be used at all.
#
#
#Examples:
#To report on what files could be linked under any kernel source trees and preload the md5sum cache, but not actually link them:
#  freedups /usr/src/linux-*
#To link identical files in those trees:
#  freedups -a /usr/src/linux-*
#To be more strict; the modification time and filename need to be equal before two files can be linked:
#  freedups -a --datesequal=yes -f /usr/doc /usr/share/doc
#Only link files with 1001 or more bytes.
#  freedups --actuallylink=yes -m 1000 /usr/src/linux-* /usr/src/pcmcia-*
#USAGE
#
##Load command line params.  Directories to be scanned are left in ARGV so we can pull them with shift in a moment.
#die "$USAGEMSG" unless GetOptions(	'actuallylink|a!'	=> \$ActuallyLink,
#					'cachefile=s'		=> \$CacheFile,
#					'datesequal|d!'		=> \$DatesEqual,
#					'filenamesequal|f!'	=> \$FileNamesEqual,
#					'help|h'		=> \$Help,
#					'maxfiles=i'		=> \$MaxFiles,
#					'minsize|m=i'		=> \$MinSize,
#					'paranoid|p!'		=> \$Paranoid,
#					'quiet|q'		=> sub { $Verbosity = 0 },
#					'verbose|v+'		=> \$Verbosity );
#
#die "$USAGEMSG" if $Help;
#
#if ($MaxFiles <= 0) {
#	$MaxFiles=1
#}