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

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


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

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

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

		#OK, shoot me.  I should be able to do just:    $$FieldName = $FieldValue;    But nothing gets set.
		if ($FieldName eq 'IPdaddr') {
			$IPdaddr = $FieldValue;
		} elsif ($FieldName eq 'IPsaddr') {
			$IPsaddr = $FieldValue;
		}
		#print "Daddr is $IPdaddr\n";

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

		$NewPacket -> send;

		$NewPacket -> DESTROY;
#	} elsif ($IPprotocol == 17) {
#		my $NewPacket = new Net::RawIP({udp => {} });
#
#	} elsif ($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
#	
	}
}