#!/usr/bin/perl

use IO::Socket;
use Symbol;
use POSIX;
use strict;
use vars qw($PREFORK $MAX_HITS_PER_CHILD %children $children $hits $errors %cfg);

die "usage: ./pounder (host) (path) (auth string)" unless (@ARGV == 3);

($cfg{host},$cfg{path},$cfg{auth}) = @ARGV;

$PREFORK		= 10;
$MAX_HITS_PER_CHILD	= 100;
%children		= ();
$children		= 0;

sub REAPER {
	$SIG{CHLD} = \&REAPER;
	my $pid = wait;
	$children--;
	delete $children{$pid};
}

sub HUNTSMAN {
	local($SIG{CHLD}) = 'IGNORE';
	kill 'INT' => keys %children;
	exit;
}

for (1 .. $PREFORK) {
	make_new_child();
}

$SIG{CHLD} = \&REAPER;
$SIG{INT} = \&HUNTSMAN;

while (1) {
	sleep;
	my $i;
	for ($i = $children; $i < $PREFORK;$i++) {
		warn "forking a new chilun...\n";
		make_new_child();
	}
}

sub make_new_child {
	my $pid;
	my $sigset;

	$sigset = POSIX::SigSet->new(SIGINT);
	sigprocmask(SIG_BLOCK, $sigset) 
		or die "can't block SIGINT for fork: $!\n";

	die "fork: $!\n" unless defined($pid = fork);

	if ($pid) {
		sigprocmask(SIG_UNBLOCK, $sigset)
			or die "can't unblock SIGINT for fork: $!\n";
		$children{$pid} = 1;
		$children++;
		return;
	} else {
		$SIG{INT} = 'DEFAULT';

		sigprocmask(SIG_UNBLOCK, $sigset)
			or die "can't unblock SIGINT for fork: $!\n";

		my $i;
		for ($i=0;$i<$MAX_HITS_PER_CHILD;$i++) {
			my $socket = &connect_to_server;
			my $response;

			my $n = (int(rand(5)) +1);
			print $socket "GET $cfg{url} HTTP/1.1\r\n";
			print $socket "Host: ethreads.com\r\n";
			print $socket "User-Agent: eAuthPounder/0.0\r\n";
			print $socket "Authorization: Basic $cfg{auth}\r\n\r\n";

			GET_RESPONSE: while (<$socket>) {
				$response .= $_;
				warn $_ if (/^HTTP/);
				last if ($_ eq"\r\n");
			}

			my $time = time;
			$hits++;

			if ($response =~ m!HTTP/1.1 500! || $response =~ m!HTTP/1.1 401!) {
				print "$time: GONZO!!!!\n";
				$errors++;
			}

			$socket->close;
			undef $socket;
		}

		exit;
	}
}

sub connect_to_server {
	my $socket = IO::Socket::INET->new(
        PeerAddr        => '$cfg{host}',
        PeerPort        => '80',
        Proto           => "tcp",
        Type            => SOCK_STREAM,
        Timeout         => 5
	) or die "socket open: $$ : $!\n";
	return $socket;
}