From 1931b29e0e54b8133082707dd1c565cc2a2ca656 Mon Sep 17 00:00:00 2001 From: Masahiro Nagano Date: Mon, 27 Aug 2012 15:21:12 +0900 Subject: [PATCH 1/4] support for randomized reqs-per-child --- bin/starman | 5 +++++ lib/Starman/Server.pm | 6 ++++++ 2 files changed, 11 insertions(+) diff --git a/bin/starman b/bin/starman index 38afa4f..efd5a26 100755 --- a/bin/starman +++ b/bin/starman @@ -107,6 +107,11 @@ failover (see above). Number of the requests to process per one worker process. Defaults to 1000. +=item --min-requests + +if set, randomizes the number of requests handled by a single worker +process between the value and that supplied by --max-requests (default: none) + =item --preload-app This option lets Starman preload the specified PSGI application in the diff --git a/lib/Starman/Server.pm b/lib/Starman/Server.pm index b9f6b08..61f3201 100644 --- a/lib/Starman/Server.pm +++ b/lib/Starman/Server.pm @@ -141,6 +141,12 @@ sub run_parent { sub child_init_hook { my $self = shift; srand(); + + my $max_requests = $self->{server}->{max_requests}; + if ( my $min_requests = $self->{options}->{min_requests} ) { + $self->{server}->{max_requests} = $max_requests - int(($max_requests - $min_requests + 1) * rand); + } + if ($self->{options}->{psgi_app_builder}) { DEBUG && warn "[$$] Initializing the PSGI app\n"; $self->{app} = $self->{options}->{psgi_app_builder}->(); From 4c83234252fd6730cd5a853d9e5e446f94d2b927 Mon Sep 17 00:00:00 2001 From: Masahiro Nagano Date: Mon, 27 Aug 2012 16:46:27 +0900 Subject: [PATCH 2/4] test --- lib/Starman/Server.pm | 6 +++++ t/randomized_per_child.t | 48 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 54 insertions(+) create mode 100644 t/randomized_per_child.t diff --git a/lib/Starman/Server.pm b/lib/Starman/Server.pm index 61f3201..2a2d230 100644 --- a/lib/Starman/Server.pm +++ b/lib/Starman/Server.pm @@ -154,6 +154,12 @@ sub child_init_hook { $0 = "starman worker " . join(" ", @{$self->{options}{argv} || []}); } +sub child_finish_hook { + my $self = shift; + my $prop = $self->{'server'}; + $self->log(4, "Child leaving ($prop->{'max_requests'})"); +} + sub post_accept_hook { my $self = shift; diff --git a/t/randomized_per_child.t b/t/randomized_per_child.t new file mode 100644 index 0000000..334a457 --- /dev/null +++ b/t/randomized_per_child.t @@ -0,0 +1,48 @@ +use strict; +use warnings; +use Test::TCP; +use LWP::UserAgent; +use FindBin; +use Test::More; +use File::Temp qw/tempfile/; + +my $max = 5; +my $min = 3; +local $ENV{STARMAN_DEBUG} = 1; + +my ($error_fh , $error_log) = tempfile(CLEANUP=>0); +close $error_fh; + +my $s = Test::TCP->new( + code => sub { + my $port = shift; + open STDERR, '>>', $error_log; + exec "$^X bin/starman --port $port --max-requests=$max --min-requests=$min --workers=1 '$FindBin::Bin/rand.psgi'"; + }, +); + +my $ua = LWP::UserAgent->new; +for (1..100) { + $ua->get("http://localhost:" . $s->port); +} + +open( my $fh, $error_log) or die $!; +my ($req_min, $req_max) = ($min, $max); +my $n; +while ( my $log = <$fh> ) { + if ( $log =~ m!Child leaving \((\d+)\)! ) { + $n = $1; + $min = $n + if $n < $req_min; + $max = $n + if $n > $req_max; + } +} + +ok $n; +is $req_min, $min, "min"; +is $req_max, $max, "max"; +unlink $error_log; +done_testing(); + + From 156c0be122cff57cfbc304aee26af550d774276c Mon Sep 17 00:00:00 2001 From: Masahiro Nagano Date: Tue, 13 Aug 2013 14:37:41 +0900 Subject: [PATCH 3/4] ssl socket could not write content of 16KB or more in a single syswrite --- lib/Starman/Server.pm | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/lib/Starman/Server.pm b/lib/Starman/Server.pm index 4bed803..0e0efc1 100644 --- a/lib/Starman/Server.pm +++ b/lib/Starman/Server.pm @@ -528,7 +528,11 @@ sub _finalize_response { return unless $len; $buffer = sprintf( "%x", $len ) . $CRLF . $buffer . $CRLF; } - syswrite $conn, $buffer; + while ( length $buffer ) { + my $len = syswrite $conn, $buffer; + die "write error: $!" if ! defined $len; + substr( $buffer, 0, $len, ''); + } DEBUG && warn "[$$] Wrote " . length($buffer) . " bytes\n"; }); @@ -542,7 +546,11 @@ sub _finalize_response { return unless $len; $buffer = sprintf( "%x", $len ) . $CRLF . $buffer . $CRLF; } - syswrite $conn, $buffer; + while ( length $buffer ) { + my $len = syswrite $conn, $buffer; + die "write error: $!" if ! defined $len; + substr( $buffer, 0, $len, ''); + } DEBUG && warn "[$$] Wrote " . length($buffer) . " bytes\n"; }, close => sub { From 3bda2eaab3a1ea2c2ec0210483f8536106daeb14 Mon Sep 17 00:00:00 2001 From: Masahiro Nagano Date: Tue, 13 Aug 2013 14:46:05 +0900 Subject: [PATCH 4/4] add test for large body --- t/ssl_largebody.t | 54 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) create mode 100644 t/ssl_largebody.t diff --git a/t/ssl_largebody.t b/t/ssl_largebody.t new file mode 100644 index 0000000..a947dac --- /dev/null +++ b/t/ssl_largebody.t @@ -0,0 +1,54 @@ +use strict; +use Test::More; +use Test::Requires 'LWP::Protocol::https'; +use Test::TCP; +use LWP::UserAgent; +use FindBin '$Bin'; +use Starman::Server; + +# https://github.com/miyagawa/Starman/issues/78 + +my $host = 'localhost'; +my $ca_cert = "$Bin/ssl_ca.pem"; +my $server_pem = "$Bin/ssl_key.pem"; +my $body = 'x'x32*1024; # > 16KB + +my ($success, $status, $content); + +test_tcp( + client => sub { + my $port = shift; + + my $ua = LWP::UserAgent->new( + timeout => 2, + ssl_opts => { + verify_hostname => 1, + SSL_ca_file => $ca_cert, + }, + ); + + my $res = $ua->get("https://$host:$port"); + $success = $res->is_success; + $status = $res->status_line; + $content = $res->decoded_content; + }, + server => sub { + my $port = shift; + Starman::Server->new->run( + sub { [ 200, [], [$body] ] }, + { + host => $host, + port => $port, + ssl => 1, + ssl_key => $server_pem, + ssl_cert => $server_pem, + }, + ); + } +); + +ok $success, 'HTTPS connection succeeded'; +diag $status if not $success; +is $content, $body; + +done_testing;