#!/usr/bin/perl -Tw
#
# largely from the perlipc man page
#
# intended to be used in front of an apache, that is under flood attack,
# but the attackers don't actually send data...
# btw, you may want to turn off KeepAlive in your Apache for the duration of the attack.
# 
# this could use select/poll/whatever constructs and avoid a couple of forks...
# prove of concept only, anyways.
# use at your own risk...
# 
#	2005-10-27, Lars Ellenberg
#
use strict;
use Socket;
use Carp;

sub spawn;  # forward declaration
sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }

my $apache_ip = '127.0.0.1';
my $apache_port = 80;                   # <<<=== MOVE IT to where you moved your apache

my $apache_addr = sockaddr_in($apache_port, inet_aton($apache_ip));

my $P_port = 8070;			# <<<=== MOVE IT to where apache normally listens
my $proto = getprotobyname('tcp');

socket(Server, PF_INET, SOCK_STREAM, $proto)	    || die "socket: $!";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
				    pack("l", 1))   || die "setsockopt: $!";
bind(Server, sockaddr_in($P_port, INADDR_ANY))	      || die "bind: $!";
listen(Server,SOMAXCONN)			    || die "listen: $!";

logmsg "server started on port $P_port";

my $waitedpid = 0;
my $paddr;

use POSIX ":sys_wait_h";
sub REAPER {
    my $child;
    while (($waitedpid = waitpid(-1,WNOHANG)) > 0) {
	logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
    }
    $SIG{CHLD} = \&REAPER;  # loathe sysV
}

$SIG{CHLD} = \&REAPER;

my ($iaddr,$c_port);
for ( $waitedpid = 0;
      ($paddr = accept(Client,Server)) || $waitedpid;
      $waitedpid = 0, close Client # still open in forked kids...
    )
{
    next if $waitedpid and not $paddr;
    ($c_port,$iaddr) = sockaddr_in($paddr);

    #my $name = gethostbyaddr($iaddr,AF_INET);
    #logmsg "connection from $name [",
    #	     inet_ntoa($iaddr), "]
    #	     at port $c_port";
    logmsg "connect ",inet_ntoa($iaddr),":$c_port";

    spawn \&proxy
}

sub spawn {
    my $coderef = shift;

    unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
	confess "usage: spawn CODEREF";
    }

    my $pid;
    if (!defined($pid = fork)) {
	logmsg "cannot fork: $!";
	return;
    } elsif ($pid) {
	logmsg "begat $pid";
	return; # I'm the parent
    }
    # else I'm the child -- go spawn

    exit (&$coderef() || 0);
}


sub proxy() {
	# could use some select()
	#my ($rout,$rin,$wout,$win,$eout,$ein);
	#vec($rin,fileno(Client),1) = 1;
	#vec($win,fileno(Client),1) = 1;
	#$ein = $rin | $win;
	# select(..., timeout)
	# but don't bother...

	# wait for initial request data to be sent
	eval {
		local $SIG{ALRM} = sub { die "timed out\n"; };
		alarm 3;
		sysread Client,$_,10;
		alarm 0;
	};
	if (length($_) < 5 or $@ eq "timed out\n")
	{
		# think about the condition in the if above...
		# try to avoid false positives
		# well. handle it somehow, log it, iptable it
		# don't forget to whitelist yourself, if you iptable it
		# don't log the received data directly!
		die(sprintf "timed out: %s, %u byte read\n", inet_ntoa($iaddr), length($_));
	}

	# connect to real apache
	socket(APACHE, PF_INET, SOCK_STREAM, $proto)  || die "socket APACHE: $!";
	connect(APACHE, $apache_addr)	 || die "connect APACHE: $!";

	my $pid;
	if (!defined($pid = fork)) {
		logmsg "cannot fork: $!";
		shutdown APACHE,2;
		return 0;
	} elsif ($pid) {
		# reader, forward to apache
		# maybe some timeout again?
		select APACHE; $| = 1; select STDOUT;
		eval {
			local $SIG{ALRM} = sub { die "timed out\n" if length($_) <= 200; };
			alarm 5;
			print APACHE $_;
			while (sysread Client,$_,4096) {
				alarm 5; # extend period
				print APACHE $_ or last;
			}
		};
		alarm 0;
		shutdown APACHE,1;
		# shutdown Client,0; # XXX really? now?
		# if he is an attacker, we don't care,
		# and if he is legit, this might confuse a client that expects
		# a "keepalive" type connection.
		# will close when the last of read/writer exits...
		return 1; # reader done
	}
	# writer, forward to client
	# maybe some timeout again?
	select Client; $| = 1; select STDOUT;
	while (defined($_ = <APACHE>)) {
		print Client $_ or last;
	}
	shutdown APACHE,0;
	shutdown Client,1;
	return 2;
}