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

#FIXME
#get and set ip options
#

#Note that this is under development.

#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);

my $OnePacket = new Net::RawIP({tcp => {}});	#icmp=>{} needed to extract icmp values from it later


my $Device =		"eth0";
my $BPFilter =		"proto \\tcp and host 1.2.3.4";
my $Snaplen =		1500;
my $Timeout =		-1;

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

#my $PacketsToProcess =	-1;	#All
my $PacketsToProcess =	3;	#Just one for the moment

if ($Param = shift) {
	($FieldName, $FieldValue) = split(/=/, $Param, 2);
	if (($FieldName ne 'IPsaddr') && ($FieldName ne 'IPdaddr')) {
		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 = $OnePacket->pcapinit($Device,$BPFilter,$Snaplen,$Timeout);

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

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

	my %PF;		#Fields of the current Packet

	#Available fields to change
	#my TCPsource, TCPdest, TCPseq, TCPack_seq, TCPdoff, TCPres1, TCPres2, TCPurg, TCPack, TCPpsh, TCPrst, TCPsyn, TCPfin, TCPwindow, TCPcheck, TCPurg_ptr, TCPdata;
	#my ICMPtype, ICMPcode, ICMPcheck, ICMPgateway, ICMPid, ICMPsequence, ICMPunused, ICMPmtu, ICMPdata;
	#my UDPsource, UDPdest, UDPlen, UDPcheck, UDPdata;
	#my GENERICdata;


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

	if ($PF{IPprotocol} == 6) {
		my $NewPacket = new Net::RawIP({tcp => {} });
		#print "Daddr is $PF{IPdaddr}, FieldName $FieldName, (doubleds) FieldName $$FieldName, FieldValue is $FieldValue\n";

		($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}) =
		 $OnePacket->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;

		#print "Daddr is $PF{IPdaddr}\n";

		#Not setting $PF{IPcheck}, $PF{IPihl}, $PF{TCPcheck}
		$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} } } );

		$NewPacket -> send;

		$NewPacket -> DESTROY;
#	} elsif ($PF{IPprotocol} == 17) {
#		my $NewPacket = new Net::RawIP({udp => {} });
#
#	} elsif ($PF{IPprotocol} == 1) {
#		my $NewPacket = new Net::RawIP({icmp => {} });
#		($Type, $Code, $Payload) = $OnePacket->get({ tcp => [qw(type code data)]});
#
#
		    #,icmp => { type => $Type, code => $Code, data => $Payload } } );
#	} else {
#		#generic
#	
	}
}