about summary refs log tree commit homepage
path: root/test/benchmark/uconnect.perl
diff options
context:
space:
mode:
Diffstat (limited to 'test/benchmark/uconnect.perl')
-rwxr-xr-xtest/benchmark/uconnect.perl66
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;
+}