Support for randomized reqs-per-child

lib/Starman/Server.pm

@@ -157,13 +157,25 @@ 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}->();
     }
     $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;
 
@@ -516,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";
         });
 
@@ -530,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 {

script/starman

@@ -122,6 +122,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

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();
+
+

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;