diff --git a/Changes b/Changes index 5164014..2e3ad55 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,9 @@ Revision history for Perl extension Starman + - Made READ_TIMEOUT configurable, allowing Starman to sit nicely + behind balancer keeping backend connections open for a long time + (Yann Kerherve) + 0.29_90 Thu Dec 1 19:40:52 PST 2011 - Changed the way server handles HUP and QUIT signals HUP will just restart all the workers gracefully diff --git a/bin/starman b/bin/starman index 9b17f76..27f1d29 100755 --- a/bin/starman +++ b/bin/starman @@ -154,6 +154,17 @@ with idle clients. Defaults to 1. +=item --read-timeout + +The number of seconds Starman will wait to read one request headers. +Setting this to a high value is beneficial if Starman sits behind +a load balancer pre-opening connections (like Perlbal with connect-ahead +option set). On the other hand, if you don't have such balancer, it can DOS +your application if enough slow clients connect at the same time and starve +your workers. + +Defaults to 5. + =item --user To listen on a low-numbered (E1024) port, it will be necessary to diff --git a/lib/Starman/Server.pm b/lib/Starman/Server.pm index 2b50d9b..01767bf 100644 --- a/lib/Starman/Server.pm +++ b/lib/Starman/Server.pm @@ -13,9 +13,9 @@ use Symbol; use Plack::Util; use Plack::TempBuffer; -use constant DEBUG => $ENV{STARMAN_DEBUG} || 0; -use constant CHUNKSIZE => 64 * 1024; -use constant READ_TIMEOUT => 5; +use constant DEBUG => $ENV{STARMAN_DEBUG} || 0; +use constant CHUNKSIZE => 64 * 1024; +use constant DEFAULT_READ_TIMEOUT => 5; my $null_io = do { open my $io, "<", \""; $io }; @@ -47,6 +47,17 @@ sub run { $options->{keepalive_timeout} = 1; } + if (! exists $options->{read_timeout}) { + $options->{read_timeout} = DEFAULT_READ_TIMEOUT; + } + else { + my $read_timeout = $options->{read_timeout}; + if (! $read_timeout or $read_timeout < 0) { + warn "invalid --read-timeout=$read_timeout. ignoring\n"; + $options->{read_timeout} = DEFAULT_READ_TIMEOUT; + } + } + my($host, $port, $proto); for my $listen (@{$options->{listen} || [ "$options->{host}:$options->{port}" ]}) { if ($listen =~ /:/) { @@ -301,7 +312,7 @@ sub _read_headers { eval { local $SIG{ALRM} = sub { die "Timed out\n"; }; - alarm( READ_TIMEOUT ); + alarm( $self->{options}{read_timeout} ); while (1) { # Do we have a full header in the buffer? diff --git a/t/read_timeout.t b/t/read_timeout.t new file mode 100644 index 0000000..d10947e --- /dev/null +++ b/t/read_timeout.t @@ -0,0 +1,31 @@ +use Test::TCP; +use FindBin; +use Test::More; +use IO::Socket ':crlf'; +use Time::HiRes qw(tv_interval gettimeofday); + +for my $timeout (qw(1 2 5)) { + my $s = Test::TCP->new( + code => sub { + my $port = shift; + exec "$^X bin/starman --read-timeout=$timeout --port $port --workers=1 $FindBin::Bin/rand.psgi"; + }, + ); + + my $port = $s->port; + my $sock = IO::Socket::INET->new("localhost:$port"); + my $t0 = [gettimeofday]; + print $sock "GET /incomplete_headers HTTP/1.0$CRLF"; + my $nr = read $sock, my $response, 1024; + my $iv = tv_interval($t0); + is $response, '', 'no data back'; + if ($!) { + skip 2, "I/O error"; + } + ok(defined($nr) && $nr == 0, 'no data back'); + my $error_margin = sprintf "%.3f", abs($iv - $timeout) / $iv; + my $is_close = $error_margin < 0.05 ? 1 : 0; + ok $is_close, "timeout roughly $timeout ($error_margin)"; +} + +done_testing;