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

#FIXME in NetPacket:
#DF flag handling, checksums.


#Settable fields:
#ip.ver		The IP version number of this packet.
#ip.flags	The IP header flags for this packet.
#ip.foffset	The IP fragment offset for this packet.
#ip.tos		The type of service for this IP packet.
#ip.id		The identification (sequence) number for this IP packet.
#ip.ttl		The time to live value for this packet.
#ip.proto	The IP protocol number for this packet.
#ip.src_ip	The source IP address for this packet in dotted quad notation.
#ip.dest_ip	The destination IP address for this packet in dotted quad notation.
#ip.options	Any IP options for this packet.

#tcp.src_port	The source TCP port for the packet.
#tcp.dest_port	The destination TCP port for the packet.
#tcp.seqnum	The TCP sequence number for this packet.
#tcp.acknum	The TCP acknowledgement number for this packet.
#tcp.reserved	The 6 bit reserved space in the TCP header.
#tcp.flags	Contains the urg, ack, psh, rst, syn, fin, ece and cwr flags for this packet.

#Not yet, have to do all flags at the moment.
#tcp.ece
#tcp.cwr
#tcp.urg
#tcp.ack
#tcp.psh
#tcp.rst
#tcp.syn
#tcp.fin

#tcp.winsize	The TCP window size for this packet.
#tcp.urg	The TCP urgent pointer.
#tcp.options	Any TCP options for this packet in binary form.
#tcp.data	The encapsulated data (payload) for this packet.

#udp.src_port	The source UDP port for the datagram.
#udp.dest_port	The destination UDP port for the datagram.
#udp.data	The encapsulated data (payload) for this packet.

#icmp.type	The ICMP message type of this packet.
#icmp.code	The ICMP message code of this packet.
#icmp.data	The encapsulated data (payload) for this packet.


#Ignored fields:
#ip.hlen	The IP header length of this packet.
#ip.len		The length (including length of header) in bytes for this packet.
#ip.cksum	The IP checksum value for this packet.
#ip.data	The encapsulated data (payload) for this IP packet.
#tcp.cksum	The TCP checksum.
#tcp.hlen	The header length for this packet.
#udp.cksum	The checksum value for this packet.
#udp.len	The length (including length of header) in bytes for this packet.
#icmp.cksum	The checksum for this packet.


#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 modules Net::Pcap and NetPacket;
#see http://www.cpan.org for #source.  Easy install as root:
#perl -MCPAN -e 'install Net::Pcap'
#perl -MCPAN -e 'install Net::NetPacket'

use strict;
use warnings;

use Net::Pcap;
use NetPacket::Ethernet;
use NetPacket::IP;
use NetPacket::TCP;
use NetPacket::UDP;
use NetPacket::ICMP;
use Getopt::Long;



my $USAGEMSG = <<USAGE;
Replaces fields in packets read from a pcap file.
Usage:
  tcpsed [options] Field=Newvalue [Field=NewValue]...
Available fields to change:
  ip.ver, ip.flags, ip.foffset, ip.tos, ip.id, ip.ttl, ip.proto, ip.src_ip
  ip.dest_ip, ip.options	
  tcp.src_port, tcp.dest_port, tcp.seqnum, tcp.acknum, tcp.reserved
  tcp.flags, tcp.winsize, tcp.urg, tcp.options, tcp.data
  udp.src_port, udp.dest_port, udp.data
  icmp.type, icmp.code, icmp.data

If you leave off the "protocol.", tcpsed will figure out which protocols
you want, or tell you if it cannot.

Options:
  -r|--read PcapInputFile (required)
  -w|--write PcapOutputFile (required)
USAGE
#Later: tcp.ece, tcp.cwr, tcp.urg, tcp.ack, tcp.psh, tcp.rst, tcp.syn, tcp.fin


my $Timeout =		-1;

my $Err;
my $PacketsProcessed =	0;

my @IPField;
my @IPNewValue;
my @TCPField;
my @TCPNewValue;
my @UDPField;
my @UDPNewValue;
my @ICMPField;
my @ICMPNewValue;
my $TotalChanges = -1;

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


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

die "$USAGEMSG" if $Help;


while (my $Param = shift) {
	my ($FieldName, $FieldValue) = split(/=/, $Param, 2);
	if (! defined($FieldValue)) {
		print "Warning, missing value for $FieldName.\n";
	}

	     if ($FieldName eq 'ip.ver') {
	} elsif ($FieldName eq 'ver') {
		$FieldName = 'ip.ver';
	} elsif ($FieldName eq 'ip.flags') {
	} elsif ($FieldName eq 'flags') {
		die "'flags' is ambiguous, please use 'ip.flags' or 'tcp.flags'.\n";
	} elsif ($FieldName eq 'ip.foffset') {
	} elsif ($FieldName eq 'foffset') {
		$FieldName = 'ip.foffset';
	} elsif ($FieldName eq 'ip.tos') {
	} elsif ($FieldName eq 'tos') {
		$FieldName = 'ip.tos';
	} elsif ($FieldName eq 'ip.id') {
	} elsif ($FieldName eq 'id') {
		$FieldName = 'ip.id';
	} elsif ($FieldName eq 'ip.ttl') {
	} elsif ($FieldName eq 'ttl') {
		$FieldName = 'ip.ttl';
	} elsif ($FieldName eq 'ip.proto') {
	} elsif ($FieldName eq 'proto') {
		$FieldName = 'ip.proto';
	} elsif ($FieldName eq 'ip.src_ip') {
	} elsif ($FieldName eq 'src_ip') {
		$FieldName = 'ip.src_ip';
	} elsif ($FieldName eq 'ip.dest_ip') {
	} elsif ($FieldName eq 'dest_ip') {
		$FieldName = 'ip.dest_ip';
	} elsif ($FieldName eq 'ip.options') {
	} elsif ($FieldName eq 'options') {
		die "'options' is ambiguous, please use 'ip.options' or 'tcp.options'.\n";
	} elsif ($FieldName eq 'tcp.src_port') {
	} elsif ($FieldName eq 'src_port') {
	} elsif ($FieldName eq 'tcp.dest_port') {
	} elsif ($FieldName eq 'dest_port') {
	} elsif ($FieldName eq 'tcp.seqnum') {
	} elsif ($FieldName eq 'seqnum') {
		$FieldName = 'tcp.seqnum';
	} elsif ($FieldName eq 'tcp.acknum') {
	} elsif ($FieldName eq 'acknum') {
		$FieldName = 'tcp.acknum';
	} elsif ($FieldName eq 'tcp.reserved') {
	} elsif ($FieldName eq 'reserved') {
		$FieldName = 'tcp.reserved';
	} elsif ($FieldName eq 'tcp.flags') {
	#} elsif ($FieldName eq 'tcp.ece') {
	#} elsif ($FieldName eq 'ece') {
	#	$FieldName = 'tcp.';
	#} elsif ($FieldName eq 'tcp.cwr') {
	#} elsif ($FieldName eq 'cwr') {
	#	$FieldName = 'tcp.';
	#} elsif ($FieldName eq 'tcp.urg') {	#FIXME, org already taken.
	#} elsif ($FieldName eq 'urg') {
	#	$FieldName = 'tcp.';
	#} elsif ($FieldName eq 'tcp.ack') {
	#} elsif ($FieldName eq 'ack') {
	#	$FieldName = 'tcp.';
	#} elsif ($FieldName eq 'tcp.psh') {
	#} elsif ($FieldName eq 'psh') {
	#	$FieldName = 'tcp.';
	#} elsif ($FieldName eq 'tcp.rst') {
	#} elsif ($FieldName eq 'rst') {
	#	$FieldName = 'tcp.';
	#} elsif ($FieldName eq 'tcp.syn') {
	#} elsif ($FieldName eq 'syn') {
	#	$FieldName = 'tcp.';
	#} elsif ($FieldName eq 'tcp.fin') {
	#} elsif ($FieldName eq 'fin') {
	#	$FieldName = 'tcp.';
	} elsif ($FieldName eq 'tcp.winsize') {
	} elsif ($FieldName eq 'winsize') {
		$FieldName = 'tcp.winsize';
	} elsif ($FieldName eq 'tcp.urg') {
	} elsif ($FieldName eq 'urg') {
		$FieldName = 'tcp.urg';
	} elsif ($FieldName eq 'tcp.options') {
	} elsif ($FieldName eq 'tcp.data') {
	} elsif ($FieldName eq 'data') {
	} elsif ($FieldName eq 'udp.src_port') {
	} elsif ($FieldName eq 'udp.dest_port') {
	} elsif ($FieldName eq 'udp.data') {
	} elsif ($FieldName eq 'icmp.type') {
	} elsif ($FieldName eq 'type') {
		$FieldName = 'icmp.type';
	} elsif ($FieldName eq 'icmp.code') {
	} elsif ($FieldName eq 'code') {
		$FieldName = 'icmp.code';
	} elsif ($FieldName eq 'icmp.data') {
	#} elsif ($FieldName eq 'ip.hlen') {
	#} elsif ($FieldName eq 'hlen') {
	#	$FieldName = 'ip.';
	#} elsif ($FieldName eq 'ip.len') {
	#} elsif ($FieldName eq 'len') {
	#	$FieldName = 'ip.';
	#} elsif ($FieldName eq 'ip.cksum') {
	#} elsif ($FieldName eq 'cksum') {
	#	$FieldName = 'ip.';
	#} elsif ($FieldName eq 'ip.data') {
	#} elsif ($FieldName eq 'data') {
	#	$FieldName = 'ip.';
	#} elsif ($FieldName eq 'tcp.cksum') {
	#} elsif ($FieldName eq 'cksum') {
	#	$FieldName = 'tcp.';
	#} elsif ($FieldName eq 'tcp.hlen') {
	#} elsif ($FieldName eq 'hlen') {
	#	$FieldName = 'tcp.';
	#} elsif ($FieldName eq 'udp.cksum') {
	#} elsif ($FieldName eq 'cksum') {
	#	$FieldName = 'udp.';
	#} elsif ($FieldName eq 'udp.len') {
	#} elsif ($FieldName eq 'len') {
	#	$FieldName = 'udp.';
	#} elsif ($FieldName eq 'icmp.cksum') {
	#} elsif ($FieldName eq 'cksum') {
	#	$FieldName = 'icmp.';
	} else {
		die "Unrecognized Field Name $FieldName\n";
	}

	my ($FieldProto, $ChangeField) = split(/\./, $FieldName, 2);
	#First, check if this is one of the FieldNames that could apply to multiple protocols and set all.
	     if ($FieldName eq 'src_port') { #udp and tcp
		$TotalChanges++;
		$TCPField[$TotalChanges] = $FieldName;
		$TCPNewValue[$TotalChanges] = $FieldValue;
		$UDPField[$TotalChanges] = $FieldName;
		$UDPNewValue[$TotalChanges] = $FieldValue;
	} elsif ($FieldName eq 'dest_port') { #udp and tcp
		$TotalChanges++;
		$TCPField[$TotalChanges] = $FieldName;
		$TCPNewValue[$TotalChanges] = $FieldValue;
		$UDPField[$TotalChanges] = $FieldName;
		$UDPNewValue[$TotalChanges] = $FieldValue;
	} elsif ($FieldName eq 'data') { #tcp udp and icmp
		$TotalChanges++;
		$TCPField[$TotalChanges] = $FieldName;
		$TCPNewValue[$TotalChanges] = $FieldValue;
		$UDPField[$TotalChanges] = $FieldName;
		$UDPNewValue[$TotalChanges] = $FieldValue;
		$ICMPField[$TotalChanges] = $FieldName;
		$ICMPNewValue[$TotalChanges] = $FieldValue;
	} elsif ($FieldProto eq 'ip') {
		$TotalChanges++;
		$IPField[$TotalChanges] = $ChangeField;
		$IPNewValue[$TotalChanges] = $FieldValue;
	} elsif ($FieldProto eq 'tcp') {
		$TotalChanges++;
		$TCPField[$TotalChanges] = $ChangeField;
		$TCPNewValue[$TotalChanges] = $FieldValue;
	} elsif ($FieldProto eq 'udp') {
		$TotalChanges++;
		$UDPField[$TotalChanges] = $ChangeField;
		$UDPNewValue[$TotalChanges] = $FieldValue;
	} elsif ($FieldProto eq 'icmp') {
		$TotalChanges++;
		$ICMPField[$TotalChanges] = $ChangeField;
		$ICMPNewValue[$TotalChanges] = $FieldValue;
	} else {
		die "Unknown protocol '$FieldProto'\n";
	}
}

if ($TotalChanges == -1) {
	print "Warning, no changes requested.\n";
}

my $ReadHandle;
#FIXME bpfilter
if ($PcapInputFile) {
	$ReadHandle = Net::Pcap::open_offline($PcapInputFile, \$Err) || die "Cant open input file: $Err";
} else {
	die "Direct read unimplemented at the moment.";
	#$ReadHandle = $RawPacket->pcapinit($Device,$BPFilter,$Snaplen,$Timeout);
}

my $WriteHandle;
if ($PcapOutputFile) {
	$WriteHandle = Net::Pcap::dump_open($ReadHandle, $PcapOutputFile) || die "Cant open output file: " . Net::Pcap::geterr($ReadHandle);
} else {
	die "Direct write unimplemented at the moment\n";
}

Net::Pcap::loop($ReadHandle, $PacketsToProcess, \&ProcessPacket, "");

Net::Pcap::close($ReadHandle);
Net::Pcap::dump_close($WriteHandle);
print "Processed $PacketsProcessed packets.\n";




sub ProcessPacket {
	my ($UserData, $Hdr, $Pkt) = @_;

	my $EthObj = NetPacket::Ethernet->decode($Pkt);
	my $IPObj = NetPacket::IP->decode($EthObj->{data});

	foreach my $OneChange (0..$TotalChanges) {
		if ($IPField[$OneChange]) {
			$IPObj->{$IPField[$OneChange]} = $IPNewValue[$OneChange];
		}
	}

	if ($IPObj->{proto} == 6) {		#TCP
		my $TCPObj = NetPacket::TCP->decode($IPObj->{data});
		my $Payload = $TCPObj->{data};

		foreach my $OneChange (0..$TotalChanges) {
			if ($TCPField[$OneChange]) {
				$TCPObj->{$TCPField[$OneChange]} = $TCPNewValue[$OneChange];
			}
		}

		$TCPObj->{data} = $Payload;
		$IPObj->{data} = $TCPObj -> encode;
	} elsif ($IPObj->{proto} == 17) {	#UDP
		my $UDPObj = NetPacket::UDP->decode($IPObj->{data});
		my $Payload = $UDPObj->{data};

		foreach my $OneChange (0..$TotalChanges) {
			if ($UDPField[$OneChange]) {
				$UDPObj->{$UDPField[$OneChange]} = $UDPNewValue[$OneChange];
			}
		}

		$UDPObj->{data} = $Payload;
		$IPObj->{data} = $UDPObj -> encode;
	} elsif ($IPObj->{proto} == 1) {	#ICMP
		my $ICMPObj = NetPacket::ICMP->decode($IPObj->{data});
		my $Payload = $ICMPObj->{data};

		foreach my $OneChange (0..$TotalChanges) {
			if ($ICMPField[$OneChange]) {
				$ICMPObj->{$ICMPField[$OneChange]} = $ICMPNewValue[$OneChange];
			}
		}

		$ICMPObj->{data} = $Payload;
		$IPObj->{data} = $ICMPObj -> encode;
	} else {				#Generic packets
		#my $Payload = $IPObj->{data};
		#
		#foreach my $OneChange (0..$TotalChanges) {
		#	if ($TCPField[$OneChange]) {
		#		$TCPObj->{$TCPField[$OneChange]} = $TCPNewValue[$OneChange];
		#	}
		#}
		#
		#Reassemble
		#$IPObj->{data} = $Payload;
	}

	if ($PcapOutputFile) {
		#Lovely.  NetPacket won't reassemble Ethernet frames.
		#We bindly hope this is actually ethernet, and just 
		#grab the 14 byte header from the original packet and 
		#prepend it to the new.
		my $NewPkt = substr($Pkt, 0, 14) . $IPObj -> encode;
		Net::Pcap::dump($WriteHandle, $Hdr, $NewPkt);
	} else {
		die "Direct write unimplemented at the moment.\n";
	}
	$PacketsProcessed++;
}