diff options
Diffstat (limited to 'test/benchmark')
-rwxr-xr-x | test/benchmark/uconnect.perl | 66 |
1 files changed, 66 insertions, 0 deletions
diff --git a/test/benchmark/uconnect.perl b/test/benchmark/uconnect.perl new file mode 100755 index 0000000..230445e --- /dev/null +++ b/test/benchmark/uconnect.perl @@ -0,0 +1,66 @@ +#!/usr/bin/perl -w +# Benchmark script to spawn some processes and hammer a local unicorn +# to test accept loop performance. This only does Unix sockets. +# There's plenty of TCP benchmarking tools out there, and TCP port reuse +# has predictability problems since unicorn can't do persistent connections. +# Written in Perl for the same reason: predictability. +# Ruby GC is not as predictable as Perl refcounting. +use strict; +use Socket qw(AF_UNIX SOCK_STREAM sockaddr_un); +use POSIX qw(:sys_wait_h); +use Getopt::Std; +# -c / -n switches stolen from ab(1) +my $usage = "$0 [-c CONCURRENCY] [-n NUM_REQUESTS] SOCKET_PATH\n"; +our $opt_c = 2; +our $opt_n = 1000; +getopts('c:n:') or die $usage; +my $unix_path = shift or die $usage; +use constant REQ => "GET / HTTP/1.1\r\nHost: example.com\r\n\r\n"; +use constant REQ_LEN => length(REQ); +use constant BUFSIZ => 8192; +$^F = 99; # don't waste syscall time with FD_CLOEXEC + +my %workers; # pid => worker num +die "-n $opt_n not evenly divisible by -c $opt_c\n" if $opt_n % $opt_c; +my $n_per_worker = $opt_n / $opt_c; +my $addr = sockaddr_un($unix_path); + +for my $num (1..$opt_c) { + defined(my $pid = fork) or die "fork failed: $!\n"; + if ($pid) { + $workers{$pid} = $num; + } else { + work($n_per_worker); + } +} + +reap_worker(0) while scalar keys %workers; +exit; + +sub work { + my ($n) = @_; + my ($buf, $x); + for (1..$n) { + socket(S, AF_UNIX, SOCK_STREAM, 0) or die "socket: $!"; + connect(S, $addr) or die "connect: $!"; + defined($x = syswrite(S, REQ)) or die "write: $!"; + $x == REQ_LEN or die "short write: $x != ".REQ_LEN."\n"; + do { + $x = sysread(S, $buf, BUFSIZ); + unless (defined $x) { + next if $!{EINTR}; + die "sysread: $!\n"; + } + } until ($x == 0); + } + exit 0; +} + +sub reap_worker { + my ($flags) = @_; + my $pid = waitpid(-1, $flags); + return if !defined $pid || $pid <= 0; + my $p = delete $workers{$pid} || '(unknown)'; + warn("$pid [$p] exited with $?\n") if $?; + $p; +} |