#!/usr/bin/perl -w
# 
# delay-net.pl: insert arbitrary packet delay
# (c) Copyright 2005, Daniel Berrange, based on:
#
# countertrace, a traceroute faker
# (c) Copyright  2002 Michael C. Toren <mct@toren.net>
#
# Released under the terms of the GNU General Public Liense, version 2.
# Alternate licensing may be available if you have a specific need;
# please send mail to mct@toren.net with details describing you unique
# situation.
# 
# Updates are available from http://michael.toren.net/code/countertrace/

use strict;
use warnings;
use IPTables::IPv4::IPQueue qw(:constants);
use Digest::MD5 qw(md5_base64);
use Time::HiRes qw(gettimeofday);

my @queue;
my $delay = shift @ARGV;
$delay = 250 unless defined $delay;
my $debug = shift @ARGV;
$debug = 0 unless defined $debug;

my $id = 0;
my %seen;
$delay = $delay / 1000;

print "Delay by $delay seconds\n";

$| = 1;

my $ipq = new IPTables::IPv4::IPQueue
		(copy_mode => IPQ_COPY_PACKET, copy_range => 2000)
	or die "Could not initialize IPQ: ", IPTables::IPv4::IPQueue->errstr, "\n";

&process();

exit 0;

sub process {
    while (1)
    {
	print "Tick ", time, "\n" if $debug > 1;
	
	# process oustanding queued packets
	my $now1 = gettimeofday;
	@queue = grep {
	    if ($now1 + 0.003 >= $_->{time}) {
		print "Deliver: ", $_->{msg}->packet_id, "\n";
		$ipq->set_verdict($_->{msg}->packet_id, NF_ACCEPT);
		0;
	    } else {
		1;
	    }
	} @queue;
	
	# set the timeout for when the next packet is due to go off, or 60 seconds
	my ($nap) = (sort { $a->{time} <=> $b->{time} } @queue, { time => $now1 + 60 });
	$nap = $nap->{time} - gettimeofday;
	
	# Get next message off the queue, timing out after $nap u-seconds
	my $msg = $ipq->get_message($nap * 1_000_000);
	
	unless (defined $msg) {
	    die "ipq: [", IPTables::IPv4::IPQueue->errstr, "]\n"
		unless (IPTables::IPv4::IPQueue->errstr =~ /^timeout/i);
	    next;
	}
	
	unless ($msg->data_len) {
	    print "Ignoring zero-length ipq message\n" if $debug;
	    next;
	}

	my $pid = $msg->packet_id;

	print "In: ", md5_base64($msg->payload), "\n";
	# process the received message
	my $now = gettimeofday;
	
	# Figure out when it needs to go back out...
	my $alarm = $now + $delay;
	
	# Queue if for the future
	print "Queue: ", $msg->packet_id, "\n";
	push @queue, { time => $delay + $now, msg => $msg };
    }

}