#!/usr/bin/perl 
#
# $Id: httpbench.pl 1292 2017-01-24 13:15:59Z phil $
#
# httpbench: a simple http/https benchmark
# author, (c): Philippe Kueck <projects at unixadm dot org>
#

use strict;
use warnings;
use Time::HiRes qw(time);
use IO::Socket::INET;
my $have_ssl; BEGIN{$have_ssl = eval {require IO::Socket::SSL; 1} // 0}
use Getopt::Long;
use Pod::Usage;
use threads;
use threads::shared;

use constant iprx => qr/^(?:(?:\d|[1-9]\d|1\d\d|2[0-4]\d|25[0-5])\.){3}(?:\d|[1-9]\d|1\d\d|2[0-4]\d|25[0-5])$/;
use constant urlrx => qr/^(?<prot>https?):\/\/(?<host>[a-z0-9_.-]+?)(?::(?<port>\d+))?(?<qs>\/.*)?$/i;

$|++;

my $opts;
my @stats = (
	'started', # start time
	'connected', # tcp connect complete
	# ssl handshake complete, for future use
	'request_sent', # request sent
	'ttfb', # first byte received
	'closed', # connection closed
	'bytes', # bytes received
	'rate' # transfer rate in KB/s
);

sub benchmark {
	my ($s, $f);
	$s->{'success'} = 0;
	$s->{$stats[$f++]} = time();

	# connect
	my $sock;
	if ($opts->{'ssl'}) {
		$sock = new IO::Socket::SSL(
			'PeerHost' => $opts->{'ip'},
			'PeerPort' => $opts->{'port'},
			'SSL_hostname' => $opts->{'host'},
			'SSL_verify_mode' => 0
		) or die $@
	} else {
		$sock = new IO::Socket::INET(
			'PeerAddr' => $opts->{'ip'},
			'PeerPort' => $opts->{'port'},
			'Protocol' => 'tcp'
		) or die $@
	}
	$s->{$stats[$f++]} = time() - $s->{$stats[0]};
	
	# send request
	print $sock sprintf "GET %s HTTP/1.1\r\nHost: %s\r\nConnection: close\r\n\r\n",
		$opts->{'query_string'}, $opts->{'host'};
	$s->{$stats[$f++]} = time() - $s->{$stats[0]};
	
	# time to first byte
	my ($read, $data);
	$s->{'bytes'} = read($sock, $data, 1);
	$s->{$stats[$f++]} = time() - $s->{$stats[0]};
	
	# full page retrieved and connection closed
	$s->{'bytes'} += $read while $read = read($sock, $data, 65535);
	$s->{$stats[$f++]} = time() - $s->{$stats[0]};
	$sock->close;
	$s->{'success'}++;
	$s
}

Getopt::Long::Configure("no_ignore_case");
GetOptions(
	'i|ip=s' => sub {
		unless ($_[1] =~ iprx) {
			printf STDERR "invalid ip: %s\n", $_[1]; exit 1
		}
		$opts->{'ip'} = $_[1]
	},
	'csv' => \$opts->{'csv'},
	'a|average' => \$opts->{'avg'},
	'c|concurrency=i' => \$opts->{'concurrency'},
	'n|requests=i' => \$opts->{'requests'},
	'h|help' => sub {pod2usage({'-exitval' => 3, '-verbose' => 2})}
) or pod2usage({'-exitval' => 3, '-verbose' => 0});
pod2usage({'-exitval' => 3, '-verbose' => 0}) unless $ARGV[0];
$opts->{'concurrency'} //= 1;
$opts->{'requests'} //= 1;

if ($ARGV[0] =~ urlrx) {
	$opts->{'ssl'} = ($+{prot} eq "https")?1:0;
	$opts->{'port'} = $+{port} // ($+{prot} eq "https"?443:80);
	$opts->{'host'} = $+{host};
	$opts->{'query_string'} = $+{qs} // '/';
	unless ($opts->{'ip'}) {
		my @ips = gethostbyname($+{host});
		@ips = map {inet_ntoa $_} @ips[4 .. $#ips];
		$opts->{'ip'} = $ips[rand @ips];
		unless ($opts->{'ip'}) {
			printf STDERR "cannot resolve hostname %s\n", $+{host};
			exit 1
		}
	}
} else {
	printf STDERR "invalid url: %s\n", $ARGV[0];
	exit 1
}

if ($opts->{'ssl'} && !$have_ssl) {
	printf STDERR "need IO::Socket::SSL for https\n";
	exit 1
}

my @sem :shared;
my $semwatcher = new threads(sub {
	$SIG{'ALRM'} = sub {
		lock @sem;
		push @sem, 1 if scalar @sem < $opts->{'concurrency'}
	};
	sleep while 1
});
$semwatcher->detach;
my @threads = map {
	new threads(sub {
		$semwatcher->kill('SIGALRM');
		my $ret = benchmark;
		lock @sem; pop @sem;
		$ret
	}, $_)
} 1..$opts->{'requests'};

my $avg;
foreach (@threads) {
	my $res = $_->join;
	next unless $res->{'success'};
	$res->{'rate'} = $res->{'bytes'} / ($res->{'closed'}-$res->{'ttfb'}) / 1024;
	if ($opts->{'avg'}) {
		$avg->{$_} += $res->{$_} for @stats;
		$avg->{'n'}++
	}
	if ($opts->{'csv'}) {printf "%s\n", join ";", map {$res->{$_}} @stats}
	else {
		foreach (@stats) {
			if ($_ eq "started") {
				printf "%-12s: %s\n", "started on", scalar localtime $res->{$_}
			} elsif ($_ eq "rate") {
				printf "%-12s: % 10.2f KiB/s\n", $_, $res->{$_}
			} elsif ($_ eq "bytes") {
				printf "%-12s: % 10.2f KiB\n", $_, $res->{$_}/1024
			} else {
				printf "%-12s: % 10.2f ms\n", $_, $res->{$_}*1000
			}
		}
	}
}

printf "%s;avg\n", join ";", map {$avg->{$_} / $avg->{'n'}} @stats if $opts->{'avg'}


__END__

=head1 NAME

httpbench

=head1 VERSION

$Revision: 1292 $

=head1 SYNOPSIS

 httpbench [OPTIONS] <URL>

=head1 OPTIONS

=over 8

=item B<-i> I<IP>, B<--ip> I<IP>

override name resolving and force I<IP>.

=item B<-c> I<RUNS>, B<--concurrency> I<RUNS>

run I<RUNS> concurrent requests.

=item B<-n> I<REQS>, B<--requests> I<REQS>

run a total of I<REQS> requests.

=item B<-a>, B<--average>

print averages.

=item B<--csv>

print results as csv:

 start time as unix timestamp
 time to complete tcp or ssl connection
 time until request is sent
 time to first byte received
 time to connection closed
 bytes received
 transfer rate in KiB/s

=back

=head1 DESCRIPTION

This script measures the connection time, the time until the request was sent, the time to first byte (ttfb) and the total time of a given url.

The url can be specified as

 http://host.example
 https://host.example/my/document.html
 http://host.example:8080
 https://host.example:8443/my/document.html
 ...


=head1 DEPENDENCIES

=over 8

=item L<Time::HiRes>

=item L<IO::Socket::INET>

=item L<IO::Socket::SSL>

=item L<Getopt::Long>

=item L<Pod::Usage>

=back

=head1 AUTHOR

Philippe Kueck <projects at unixadm dot org>

=cut