#!/usr/local/bin/perl -Tw
#
#   $Id: wwwkill,v 1.3 1999/06/21 05:53:01 dgregor Exp $
#
# Originally written by Steve Neruda for perl 4.
#
# Updated for Perl 5 by D.J. Gregor.

use IO::Socket;
use IO::File;;
use Getopt::Std;

# b64encode hacked from:
# base64.pl -- A perl package to handle MIME-style BASE64 encoding
# A. P. Barrett <barrett@ee.und.ac.za>, October 1993
sub b64encode
{
    local ($_) = @_;
    local ($chunk);
    local ($result) = "";

    $base64_alphabet = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
                       'abcdefghijklmnopqrstuvwxyz'.
                       '0123456789+/';
    $base64_pad = '=';
 
    $uuencode_alphabet = q|`!"#$%&'()*+,-./0123456789:;<=>?|.
                       '@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_'; # double that '\\'!


    # Build some strings for use in tr/// commands.
    # Some uuencodes use " " and some use "`", so we handle both.
    # We also need to protect backslashes.
    ($tr_uuencode = " ".$uuencode_alphabet) =~ s/\\/\\\\/;
    $tr_base64 = "A".$base64_alphabet;
 
    # break into chunks of 45 input chars, use perl's builtin
    # uuencoder to convert each chunk to uuencode format,
    # then kill the leading "M", translate to the base64 alphabet,
    # and finally append a newline.
    while (s/^((.|\n){45})//) {
        #warn "in:$&:\n";
        $chunk = substr(pack("u", $&), $[+1, 60);
        #warn "packed    :$chunk:\n";
        eval qq{
            \$chunk =~ tr|$tr_uuencode|$tr_base64|;
        };
        #warn "translated:$chunk:\n";
        $result .= $chunk . "\n";
    }
 
    # any leftover chars go onto a shorter line
    # with uuencode padding converted to base64 padding
    if ($_ ne "") {
        #warn "length ".length($_)." \$_:$_:\n";
        #warn "enclen ", int((length($_)+2)/3)*4 - (45-length($_))%3, "\n";
        $chunk = substr(pack("u", $_), $[+1,
                        int((length($_)+2)/3)*4 - (45-length($_))%3);
        #warn "chunk:$chunk:\n";
        eval qq{
            \$chunk =~ tr|$tr_uuencode|$tr_base64|;
        };
        #warn "translated:$chunk:\n";
        $result .= $chunk . ($base64_pad x ((60 - length($chunk)) % 4)) . "\n";
    }
 
    # return result
    $result;
}


sub dokill {
	if ($$ == $parentpid) {
		kill 15, @children; 	# die, please.
		sleep(1);
		kill 9, @children; 	# die, die, die!!!
		exit();
	}
}

sub proxy_auth {
	if (!defined($authfile)) {
		$authfile = new IO::File($opt_A, "r") ||
			die "Could not open \"$opt_A\": $!\n";
	}

	# Check for EOF and go back to the beginning if so
	# XXX I don't check for errors
	$authfile->seek(0,0) if ($authfile->eof());

	# get a line and chomp it.
	# XXX Need to check for errors.
	die "Could not read line from \"$opt_A\": $!\n"
		unless ($authline = $authfile->getline());
	chomp($authline);

	@authinfo = split(/:/, $authline);

	die "Syntax error in \"$opt_A\": \"$authline\"\n"
		unless (@authinfo > 1);

	$authstring = b64encode($authinfo[0] . ":" . $authinfo[1]);
	$authstring =~ s/[\r\n]+//g;

	return "Proxy-authorization: Basic " . $authstring;
}

sub gatherdata {
	local($skipsleep) = 0;

	if ($skipsleep) {
		print "wwwkill[$$]: already received signal: skipping sleep\n"
			if defined($opt_d);
	} else {
		print "wwwkill[$$]: into sleep\n" if defined($opt_d);
		sleep();
		print "wwwkill[$$]: out of sleep\n" if defined($opt_d);
	}

	for ($loop = 0; defined($opt_i) ? ($loop < $opt_i) : 1 ; $loop++) {
		$socket = new IO::Socket::INET (
		        PeerAddr => $opt_h,
		        PeerPort => $opt_p,
		        Proto => 'tcp',
	        ) || do { warn "could not open socket: $!\n"; next; };

		$socket->autoflush(1);

		$command = "GET $opt_U HTTP/1.0\r\n";
		$command .= proxy_auth() . "\r\n" if defined($opt_A);
		$command .= "User-Agent: $opt_u\r\n" if defined($opt_u);
		$command .= "\r\n";

		$socket->print($command);
		STDERR->print($command) if defined($opt_d);

		$begindate = time();

		$status = $socket->getline() || do {
			warn "Could not read HTTP status: $!\n"; return;
		};
		$status =~ s/[\n\r]+//g;

		LOSEHEADERS:
		while (defined($line = $socket->getline())) {
		        $line =~ s/[\n\r]+//g;
			last LOSEHEADERS if $line =~ m/^$/;
		}

		if ($status =~ m/HTTP\/1\.\d+\s+200/) {
			$statusmsg = "OK";
			$verbosestatusmsg = "size=" .
				length(join('', $socket->getlines()));
		} else {
			$statusmsg = $status;
			$errormsg = join('', $socket->getlines());

			$errormsg =~ s/\r/\\r/g;
			$errormsg =~ s/\n/\\n/g;
			$errormsg =~ s/\0000/\\0000/g;

			$verbosestatusmsg = "error=" . $errormsg;
		}

		$enddate = time();
		$date = localtime($enddate);

		@transfertime = gmtime($enddate - $begindate);
		if ($statusmsg eq "OK") {
			$statusfh = \*STDOUT;
		} else {
			$statusfh = \*STDERR;
		}
		print $statusfh "wwwkill[$$] loop=$loop, date=$date, status=$statusmsg, xfertime=" . ($transfertime[2] * 60 * 60 + $transfertime[1] * 60 + $transfertime[0]) . ", $verbosestatusmsg\n";
	}
}
# end gatherdata

#
# main routine
#

$opt_A = undef;	# file with basic auth strings, one per line, userid:passwd
$opt_n = 1;	# default number of children to start
$opt_p = 80;	# default port number to which to connect
$opt_d = undef;	# debug
$opt_u = undef;	# user-agent
$opt_U = undef;	# URL; must be specified
$opt_h = undef;	# host; must be specified
$opt_l = undef;	# run time
$opt_i = undef;	# iterations

getopt('AnpuUhli');

die "You must specify \"-U <url_to_request>\"\n" unless defined($opt_U);
die "You must specify \"-h <host>\"\n" unless defined($opt_h);

if (defined($opt_A)) {
	die "Cannot read auth file \"$opt_A\": $!\n" unless (-r $opt_A);
}

# Store the parent PID for use in dokill later...
$parentpid = $$;

$SIG{'INT'} = 'dokill';
$SIG{'TERM'} = 'dokill';
$SIG{'HUP'} = 'dokill';

$SIG{'USR2'} = sub { $skipsleep = 1; $SIG{'USR2'} = 'DEFAULT'; };

# start up the children.
for ($tmp = 1; $tmp <= $opt_n; $tmp++) {
	print STDERR "Starting instance number $tmp\r" if defined($opt_v);
	$childid = fork();
	if ($childid == 0) {  #this is the child
		gatherdata();
		exit();
	} elsif ($childid > 0) {	# this is the parent
		push(@children, $childid);
	} else {
		warn "Error starting child $tmp: $!\n";
	}
}

print "\n" if defined($opt_v);

print "All daemons started\n" if defined($opt_v);

$SIG{'USR2'} = 'DEFAULT';

# send SIGUSR2 to children so they wake up
print "Waking up children\n" if defined($opt_v);
kill('USR2', @children) || die "could not kill children: $!\n";

print "*** Hit control C to end test *** \n" if defined($opt_v);

if (defined($opt_l)) {
	print "Run time is $opt_l seconds\n" if defined($opt_v);
	sleep($opt_l);
} else {
	wait();
}

dokill();