diff options
Diffstat (limited to 'web/server/h2o/libh2o/misc/p5-Server-Starter/t')
23 files changed, 1038 insertions, 0 deletions
diff --git a/web/server/h2o/libh2o/misc/p5-Server-Starter/t/00-base.t b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/00-base.t new file mode 100644 index 00000000..4e4dbb0a --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/00-base.t @@ -0,0 +1,8 @@ +use strict; +use warnings; + +use Test::More tests => 1; + +BEGIN { + use_ok('Server::Starter'); +} diff --git a/web/server/h2o/libh2o/misc/p5-Server-Starter/t/01-starter-echod.pl b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/01-starter-echod.pl new file mode 100755 index 00000000..f35d200d --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/01-starter-echod.pl @@ -0,0 +1,35 @@ +#! /usr/bin/perl + +use strict; +use warnings; + +use lib qw(blib/lib lib); + +use IO::Socket::INET; +use Server::Starter qw(server_ports); + +my $sigfn = shift @ARGV; +open my $sigfh, '>', $sigfn + or die "could not open file:$sigfn:$!"; + +$SIG{TERM} = $SIG{USR1} = sub { + my $signame = shift; + print $sigfh $signame; + sleep 2; + exit 0; +}; + +my $listener = IO::Socket::INET->new( + Proto => 'tcp', +); +$listener->fdopen((values %{server_ports()})[0], 'w') + or die "failed to bind listening socket:$!"; + +while (1) { + if (my $conn = $listener->accept) { + my $buf; + while ($conn->sysread($buf, 1048576) > 0) { + $conn->syswrite("$$:$buf"); + } + } +} diff --git a/web/server/h2o/libh2o/misc/p5-Server-Starter/t/01-starter.t b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/01-starter.t new file mode 100644 index 00000000..f4b0d416 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/01-starter.t @@ -0,0 +1,82 @@ +use strict; +use warnings; + +use File::Temp (); +use Test::TCP; +use Test::More tests => 28; + +use Server::Starter qw(start_server); + +$SIG{PIPE} = sub {}; + +my $tempdir = File::Temp::tempdir(CLEANUP => 1); + +for my $signal_on_hup ('TERM', 'USR1') { + + test_tcp( + server => sub { + my $port = shift; + start_server( + port => $port, + exec => [ + $^X, qw(t/01-starter-echod.pl), "$tempdir/signame", + ], + status_file => "$tempdir/status", + ($signal_on_hup ne 'TERM' + ? (signal_on_hup => $signal_on_hup) : ()), + ); + }, + client => sub { + my ($port, $server_pid) = @_; + my $buf; + #sleep 1; + my $sock = IO::Socket::INET->new( + PeerAddr => "127.0.0.1:$port", + Proto => 'tcp', + ); + ok($sock, 'connect'); + # check response and get pid + is($sock->syswrite("hello"), 5, 'write'); + ok($sock->sysread($buf, 1048576), 'read'); + undef $sock; + like($buf, qr/^\d+:hello$/, 'read'); + $buf =~ /^(\d+):/; + my $worker_pid = $1; + # switch to next gen + sleep 3; + my $status = get_status(); + like(get_status(), qr/^1:\d+\n$/s, 'status before restart'); + kill 'HUP', $server_pid; + sleep 2; + like(get_status(), qr/^1:\d+\n2:\d+$/s, 'status during restart'); + sleep 2; + like(get_status(), qr/^2:\d+\n$/s, 'status after restart'); + is( + do { + open my $fh, '<', "$tempdir/signame" + or die $!; + <$fh>; + }, + $signal_on_hup, + 'signal sent on hup', + ); + $sock = IO::Socket::INET->new( + PeerAddr => "127.0.0.1:$port", + Proto => 'tcp', + ); + ok($sock, 'reconnect'); + is($sock->syswrite("hello"), 5, 'write after switching'); + ok($sock->sysread($buf, 1048576), 'read after switching'); + like($buf, qr/^\d+:hello$/, 'read after swiching (format)'); + isnt($buf, "$worker_pid:hello", 'pid should have changed'); + }, + ); + + ok ! -e "$tempdir/status", 'no more status file'; +} + +sub get_status { + open my $fh, '<', "$tempdir/status" + or die "failed to open file:$tempdir/status:$!"; + do { undef $/; <$fh> }; +} diff --git a/web/server/h2o/libh2o/misc/p5-Server-Starter/t/02-startfail-server.pl b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/02-startfail-server.pl new file mode 100755 index 00000000..6913bc8e --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/02-startfail-server.pl @@ -0,0 +1,32 @@ +#! /usr/bin/perl + +use strict; +use warnings; + +use lib qw(blib/lib lib); + +use IO::Socket::INET; +use Server::Starter qw(server_ports); + +$SIG{TERM} = sub { + exit 0; +}; + +my $gen = $ENV{SERVER_STARTER_GENERATION}; + +if ($gen == 1 || 3 <= $gen && $gen < 5) { + # emulate startup failure + exit 1; +} + +my $listener = IO::Socket::INET->new( + Proto => 'tcp', +); +$listener->fdopen((values %{server_ports()})[0], 'w') + or die "failed to bind listening socket:$!"; + +while (1) { + if (my $conn = $listener->accept) { + $conn->syswrite($gen); + } +} diff --git a/web/server/h2o/libh2o/misc/p5-Server-Starter/t/02-startfail.t b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/02-startfail.t new file mode 100644 index 00000000..0985534b --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/02-startfail.t @@ -0,0 +1,61 @@ +use strict; +use warnings; + +use Test::TCP; +use Test::More tests => 9; + +use Server::Starter qw(start_server); + +test_tcp( + server => sub { + my $port = shift; + start_server( + port => $port, + exec => [ $^X, qw(t/02-startfail-server.pl) ], + ); + }, + client => sub { + my ($port, $server_pid) = @_; + my $buf; + sleep 3; + { + my $sock = IO::Socket::INET->new( + PeerAddr => "127.0.0.1:$port", + Proto => 'tcp', + ); + ok($sock, 'connect'); + # check generation + ok($sock->sysread($buf, 1048576), 'read'); + is($buf, 2, 'check generation'); + } + # request restart, that will fail + kill 'HUP', $server_pid; + sleep 1; + { + my $sock = IO::Socket::INET->new( + PeerAddr => "127.0.0.1:$port", + Proto => 'tcp', + ); + ok($sock, 'connect'); + ok( + $sock->sysread($buf, 1048576), + 'read while worker is failing to reboot', + ); + is($buf, 2, 'check generation'); + } + # wait until server succeds in reboot + sleep 5; + { + my $sock = IO::Socket::INET->new( + PeerAddr => "127.0.0.1:$port", + Proto => 'tcp', + ); + ok($sock, 'connect'); + ok( + $sock->sysread($buf, 1048576), + 'read after worker succeeds to reboot', + ); + is($buf, 5, 'check generation'); + } + }, +); diff --git a/web/server/h2o/libh2o/misc/p5-Server-Starter/t/03-starter-unix-echod.pl b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/03-starter-unix-echod.pl new file mode 100644 index 00000000..a5467747 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/03-starter-unix-echod.pl @@ -0,0 +1,22 @@ +#! /usr/bin/perl + +use strict; +use warnings; + +use lib qw(blib/lib lib); + +use IO::Socket::UNIX; +use Server::Starter qw(server_ports); + +my $listener = IO::Socket::UNIX->new() + or die "failed to create unix socket:$!"; +$listener->fdopen((values %{server_ports()})[0], 'w') + or die "failde to bind to listening socket:$!"; + +while (1) { + if (my $conn = $listener->accept) { + while ($conn->sysread(my $buf, 1048576) > 0) { + $conn->syswrite($buf); + } + } +} diff --git a/web/server/h2o/libh2o/misc/p5-Server-Starter/t/03-starter-unix.t b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/03-starter-unix.t new file mode 100644 index 00000000..965de6b6 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/03-starter-unix.t @@ -0,0 +1,40 @@ +use strict; +use warnings; + +use File::Temp (); +use IO::Socket::UNIX; +use Test::More tests => 4; +use Test::SharedFork; + +use Server::Starter qw(start_server); + +$SIG{PIPE} = sub {}; + +my $sockfile = File::Temp::tmpnam(); + +my $pid = fork; +die "fork failed: $!" + unless defined $pid; +if ($pid == 0) { + # child + start_server( + path => $sockfile, + exec => [ $^X, qw(t/03-starter-unix-echod.pl) ], + ); + exit 0; +} else { + # parent + sleep 1 + until -e $sockfile; + my $sock = IO::Socket::UNIX->new( + Peer => $sockfile, + ) or die "failed to connect to unix socket:$!"; + is $sock->syswrite('hello', 5), 5, 'write'; + is $sock->sysread(my $buf, 5), 5, 'read length'; + is $buf, 'hello', 'read data'; + kill 'TERM', $pid; + while (wait != $pid) {} + ok ! -e $sockfile, 'socket file removed after shutdown'; +} + +unlink $sockfile; diff --git a/web/server/h2o/libh2o/misc/p5-Server-Starter/t/04-starter-dir.t b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/04-starter-dir.t new file mode 100644 index 00000000..5f1b3968 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/04-starter-dir.t @@ -0,0 +1,54 @@ +use strict; +use warnings; + +use File::Temp (); +use Test::More tests => 1; +use Net::EmptyPort qw/empty_port/; +use IO::Select; +use Server::Starter qw(start_server); + +$SIG{PIPE} = sub {}; + +pipe my $logrh, my $logwh + or die "Died: failed to create pipe:$!"; +my $port = empty_port + or die "could not get any port"; +my $tempdir = File::Temp::tempdir(CLEANUP => 0); +open(my $fh, '>', "$tempdir/dir_status") or die "$!"; +close($fh); + +my $pid = fork; + +if ( ! defined $pid ) { + die "Died: fork failed: $!"; +} +elsif ( $pid == 0 ) { + close $logrh; + open STDOUT, '>&', $logwh + or die "Died: failed to redirect STDOUT"; + close $logwh; + start_server( + port => $port, #not use + exec => [ + $^X, '-e', 'printf "%s\n", -f "dir_status" ? "OK" : "NG"; sleep(1)' + ], + dir => $tempdir + ); + exit(255); +} + +close $logwh; +my $result; +my $s = IO::Select->new($logrh); +my @ready = $s->can_read(10); +die "could not read logs from pipe" unless @ready; +sysread($logrh, my $buf, 65536); +like($buf, qr/OK\W/); + +kill 'TERM', $pid; +while (wait != $pid) {} + +unlink "$tempdir/status"; +rmdir $tempdir; + + diff --git a/web/server/h2o/libh2o/misc/p5-Server-Starter/t/05-killolddelay-echod.pl b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/05-killolddelay-echod.pl new file mode 100755 index 00000000..5b48ca55 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/05-killolddelay-echod.pl @@ -0,0 +1,35 @@ +#! /usr/bin/perl + +use strict; +use warnings; + +use lib qw(blib/lib lib); + +use IO::Socket::INET; +use Server::Starter qw(server_ports); + +my $sigfn = shift @ARGV; +open my $sigfh, '>', $sigfn + or die "could not open file:$sigfn:$!"; + +$SIG{TERM} = $SIG{USR1} = sub { + my $signame = shift; + print $sigfh $signame; + sleep 1; + exit 0; +}; + +my $listener = IO::Socket::INET->new( + Proto => 'tcp', +); +$listener->fdopen((values %{server_ports()})[0], 'w') + or die "failed to bind listening socket:$!"; + +while (1) { + if (my $conn = $listener->accept) { + my $buf; + while ($conn->sysread($buf, 1048576) > 0) { + $conn->syswrite("$$:$buf"); + } + } +} diff --git a/web/server/h2o/libh2o/misc/p5-Server-Starter/t/05-killolddelay.t b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/05-killolddelay.t new file mode 100644 index 00000000..19856af5 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/05-killolddelay.t @@ -0,0 +1,87 @@ +use strict; +use warnings; + +use File::Temp (); +use Test::TCP; +use Test::More tests => 28; + +use Server::Starter qw(start_server); + +$SIG{PIPE} = sub {}; + +my $tempdir = File::Temp::tempdir(CLEANUP => 1); + +for my $signal_on_hup ('TERM', 'USR1') { + + test_tcp( + server => sub { + my $port = shift; + start_server( + port => $port, + exec => [ + $^X, qw(t/05-killolddelay-echod.pl), "$tempdir/signame", + ], + status_file => "$tempdir/status", + enable_auto_restart => 0, + kill_old_delay => 3, + ($signal_on_hup ne 'TERM' + ? (signal_on_hup => $signal_on_hup) : ()), + ); + }, + client => sub { + my ($port, $server_pid) = @_; + my $buf; + #sleep 1; + my $sock = IO::Socket::INET->new( + PeerAddr => "127.0.0.1:$port", + Proto => 'tcp', + ); + ok($sock, 'connect'); + # check response and get pid + is($sock->syswrite("hello"), 5, 'write'); + ok($sock->sysread($buf, 1048576), 'read'); + undef $sock; + like($buf, qr/^\d+:hello$/, 'read'); + $buf =~ /^(\d+):/; + my $worker_pid = $1; + # switch to next gen + sleep 2; + my $status = get_status(); + like(get_status(), qr/^1:\d+\n$/s, 'status before restart'); + kill 'HUP', $server_pid; + sleep 4; + like(get_status(), qr/^1:\d+\n2:\d+$/s, 'status during restart'); + # Child process has finished in 2 seconds but the parent + # checks and calls waitpid every second, so wait for an + # additional 1 second. + sleep 3; + like(get_status(), qr/^2:\d+\n$/s, 'status after restart'); + is( + do { + open my $fh, '<', "$tempdir/signame" + or die $!; + <$fh>; + }, + $signal_on_hup, + 'signal sent on hup', + ); + $sock = IO::Socket::INET->new( + PeerAddr => "127.0.0.1:$port", + Proto => 'tcp', + ); + ok($sock, 'reconnect'); + is($sock->syswrite("hello"), 5, 'write after switching'); + ok($sock->sysread($buf, 1048576), 'read after switching'); + like($buf, qr/^\d+:hello$/, 'read after swiching (format)'); + isnt($buf, "$worker_pid:hello", 'pid should have changed'); + }, + ); + + ok ! -e "$tempdir/status", 'no more status file'; +} + +sub get_status { + open my $fh, '<', "$tempdir/status" + or die "failed to open file:$tempdir/status:$!"; + do { undef $/; <$fh> }; +} diff --git a/web/server/h2o/libh2o/misc/p5-Server-Starter/t/06-autorestart-echod.pl b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/06-autorestart-echod.pl new file mode 100755 index 00000000..2d71a654 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/06-autorestart-echod.pl @@ -0,0 +1,34 @@ +#! /usr/bin/perl + +use strict; +use warnings; + +use lib qw(blib/lib lib); + +use IO::Socket::INET; +use Server::Starter qw(server_ports); + +my $sigfn = shift @ARGV; +open my $sigfh, '>', $sigfn + or die "could not open file:$sigfn:$!"; + +$SIG{TERM} = $SIG{USR1} = sub { + my $signame = shift; + print $sigfh $signame; + exit 0; +}; + +my $listener = IO::Socket::INET->new( + Proto => 'tcp', +); +$listener->fdopen((values %{server_ports()})[0], 'w') + or die "failed to bind listening socket:$!"; + +while (1) { + if (my $conn = $listener->accept) { + my $buf; + while ($conn->sysread($buf, 1048576) > 0) { + $conn->syswrite("$$:$buf"); + } + } +} diff --git a/web/server/h2o/libh2o/misc/p5-Server-Starter/t/06-autorestart.t b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/06-autorestart.t new file mode 100644 index 00000000..1e1f8658 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/06-autorestart.t @@ -0,0 +1,84 @@ +use strict; +use warnings; + +use File::Temp (); +use Test::TCP; +use Test::More tests => 28; + +use Server::Starter qw(start_server); + +$SIG{PIPE} = sub {}; + +my $tempdir = File::Temp::tempdir(CLEANUP => 1); + +for my $signal_on_hup ('TERM', 'USR1') { + + test_tcp( + server => sub { + my $port = shift; + start_server( + port => $port, + exec => [ + $^X, qw(t/05-killolddelay-echod.pl), "$tempdir/signame", + ], + status_file => "$tempdir/status", + enable_auto_restart => 1, + auto_restart_interval => 6, + kill_old_delay => 2, + ($signal_on_hup ne 'TERM' + ? (signal_on_hup => $signal_on_hup) : ()), + ); + }, + client => sub { + my ($port, $server_pid) = @_; + my $buf; + #sleep 1; + my $sock = IO::Socket::INET->new( + PeerAddr => "127.0.0.1:$port", + Proto => 'tcp', + ); + ok($sock, 'connect'); + # check response and get pid + is($sock->syswrite("hello"), 5, 'write'); + ok($sock->sysread($buf, 1048576), 'read'); + undef $sock; + like($buf, qr/^\d+:hello$/, 'read'); + $buf =~ /^(\d+):/; + my $worker_pid = $1; + # switch to next gen + sleep 2; + my $status = get_status(); + like(get_status(), qr/^1:\d+\n$/s, 'status before auto-restart'); + sleep 7; # new worker spawn at 7 (since start, interval(1) + auto_restart_interval(6)), status updated at 8 (7 + interval(1)), old dies at 11 (8 + kill_old_delay(2) + sleep(1) in the child source code) + like(get_status(), qr/^1:\d+\n2:\d+$/s, 'status during transient state'); + sleep 3; + like(get_status(), qr/^2:\d+\n$/s, 'status after auto-restart'); + is( + do { + open my $fh, '<', "$tempdir/signame" + or die $!; + <$fh>; + }, + $signal_on_hup, + 'signal sent on hup', + ); + $sock = IO::Socket::INET->new( + PeerAddr => "127.0.0.1:$port", + Proto => 'tcp', + ); + ok($sock, 'reconnect'); + is($sock->syswrite("hello"), 5, 'write after switching'); + ok($sock->sysread($buf, 1048576), 'read after switching'); + like($buf, qr/^\d+:hello$/, 'read after swiching (format)'); + isnt($buf, "$worker_pid:hello", 'pid should have changed'); + }, + ); + + ok ! -e "$tempdir/status", 'no more status file'; +} + +sub get_status { + open my $fh, '<', "$tempdir/status" + or die "failed to open file:$tempdir/status:$!"; + do { undef $/; <$fh> }; +} diff --git a/web/server/h2o/libh2o/misc/p5-Server-Starter/t/07-envdir-print.pl b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/07-envdir-print.pl new file mode 100755 index 00000000..22cb01af --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/07-envdir-print.pl @@ -0,0 +1,29 @@ +#! /usr/bin/perl + +use strict; +use warnings; + +use lib qw(blib/lib lib); + +use IO::Socket::INET; +use Server::Starter qw(server_ports); + +$SIG{TERM} = $SIG{USR1} = sub { + exit 0; +}; + +my $listener = IO::Socket::INET->new( + Proto => 'tcp', +); +$listener->fdopen((values %{server_ports()})[0], 'w') + or die "failed to bind listening socket:$!"; + +while (1) { + if (my $conn = $listener->accept) { + my $s = ""; + for my $envkey (keys %ENV) { + $s .= $envkey . "=" . $ENV{$envkey} . "\n"; + } + $conn->syswrite($s); + } +} diff --git a/web/server/h2o/libh2o/misc/p5-Server-Starter/t/07-envdir.t b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/07-envdir.t new file mode 100644 index 00000000..f10fbade --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/07-envdir.t @@ -0,0 +1,77 @@ +use strict; +use warnings; + +use File::Temp (); +use Test::TCP; +use Test::More tests => 4; + +use Server::Starter qw(start_server); + +$SIG{PIPE} = sub {}; + +my $tempdir = File::Temp::tempdir(CLEANUP => 1); + +# Prepare envdir +mkdir "$tempdir/env" or die $!; +open my $envfh, ">", "$tempdir/env/FOO" or die $!; +print $envfh "foo-value1"; +close $envfh; +undef $envfh; +sleep 1; + +test_tcp( + server => sub { + my $port = shift; + start_server( + port => $port, + exec => [ + $^X, qw(t/07-envdir-print.pl), + ], + status_file => "$tempdir/status", + envdir => "$tempdir/env", + ); + }, + client => sub { + my ($port, $server_pid) = @_; + #sleep 1; + my $fetch_env = sub { + my $sock = IO::Socket::INET->new( + PeerAddr => "127.0.0.1:$port", + Proto => 'tcp', + ) or die $!; + my $buf; + $sock->sysread($buf, 1048576) + or die $!; + undef $sock; + $buf; + }; + my $restart = sub { + sleep 1; + kill "HUP", $server_pid; + sleep 2; + }; + # Initial worker does not read envdir + my $buf = $fetch_env->(); + ok($buf !~ qr/^FOO=foo-value1$/m, 'changed env'); + # rewrite envdir + open my $envfh, ">", "$tempdir/env/FOO" or die $!; + print $envfh "foo-value2"; + close $envfh; + undef $envfh; + # switch to next gen + $restart->(); + # new worker reads the rewritten envdir + $buf = $fetch_env->(); + ok($buf =~ /^FOO=foo-value2$/m, 'changed env'); + # remove the env file and check that the removal gets reflected + unlink "$tempdir/env/FOO" + or die $!; + # switch to next gen + $restart->(); + # new worker reads the rewritten envdir + $buf = $fetch_env->(); + ok($buf !~ /^FOO=foo-value2$/m, 'removed env'); + }, +); + +ok ! -e "$tempdir/status", 'no more status file'; diff --git a/web/server/h2o/libh2o/misc/p5-Server-Starter/t/08-wait3.t b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/08-wait3.t new file mode 100644 index 00000000..e13b6e8b --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/08-wait3.t @@ -0,0 +1,39 @@ +use strict; +use warnings; +use Test::More; +use Server::Starter; + +my $gotsig = 0; +Server::Starter::_set_sighandler('USR1', sub { + warn "got SIGUSR1"; + ++$gotsig; +}); + +my $pid = fork; +die "fork failed:$!" + unless defined $pid; +if ($pid == 0) { + # child process, send signal twice + sleep 1; + kill 'USR1', getppid; + sleep 1; + kill 'USR1', getppid; + sleep 10; + die "child process not killed"; +} + +my @r = Server::Starter::_wait3(0); +ok ! @r, "nonblocking wait returns without pid"; + +for (my $i = 1; $i <= 2; ++$i) { + @r = Server::Starter::_wait3(1); + is $gotsig, $i, "woke up after signal (count: $i)"; + ok ! @r, "child is alive"; +} + +kill 'KILL', $pid; +@r = Server::Starter::_wait3(1); +is $gotsig, 2, "did not receive signal"; +is $r[0], $pid, "child died"; + +done_testing; diff --git a/web/server/h2o/libh2o/misc/p5-Server-Starter/t/09-guard.t b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/09-guard.t new file mode 100644 index 00000000..a51903a4 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/09-guard.t @@ -0,0 +1,31 @@ +use strict; +use warnings; +use Test::More; + +use_ok("Server::Starter::Guard"); + +subtest "guard is called when it goes out of scope" => sub { + my $cnt = 0; + + my $guard = Server::Starter::Guard->new(sub { + $cnt++; + }); + + is $cnt, 0; + undef $guard; + is $cnt, 1; +}; + +subtest "guard can be dismissed" => sub { + my $cnt = 0; + + my $guard = Server::Starter::Guard->new(sub { + $cnt++; + }); + + $guard->dismiss; + undef $guard; + is $cnt, 0; +}; + +done_testing; diff --git a/web/server/h2o/libh2o/misc/p5-Server-Starter/t/10-bindaddr-server.pl b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/10-bindaddr-server.pl new file mode 100755 index 00000000..279c5967 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/10-bindaddr-server.pl @@ -0,0 +1,26 @@ +#! /usr/bin/perl + +use strict; +use warnings; + +use lib qw(blib/lib lib); + +use IO::Socket::INET; +use Server::Starter qw(server_ports); + +$SIG{TERM} = $SIG{USR1} = sub { + exit 0; +}; +$SIG{HUP} = sub {}; + +my $listener = IO::Socket::INET->new( + Proto => 'tcp', +); +$listener->fdopen((values %{server_ports()})[0], 'w') + or die "failed to bind listening socket:$!"; + +while (1) { + if (my $conn = $listener->accept) { + close $conn; + } +} diff --git a/web/server/h2o/libh2o/misc/p5-Server-Starter/t/10-bindaddr.t b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/10-bindaddr.t new file mode 100644 index 00000000..16a76768 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/10-bindaddr.t @@ -0,0 +1,55 @@ +use strict; +use warnings; +use Test::More; +use Test::Requires qw(IO::Socket::IP); +use Net::EmptyPort qw(can_bind empty_port); +use Server::Starter qw(start_server); + +plan skip_all => 'IPv6 not available' + unless can_bind('::1'); + +my $port = empty_port; + +sub doit { + my ($bind_addr, $other_addr) = @_; + my $pid = fork; + die "fork failed:$!" + unless defined $pid; + if ($pid == 0) { + # server + start_server( + port => "[$bind_addr]:$port", + exec => [ + $^X, qw(t/10-bindaddr-server.pl), + ], + ); + exit 0; + } + # client + sleep 1; + my $sock = IO::Socket::IP->new( + PeerHost => $bind_addr, + PeerPort => $port, + Proto => 'tcp', + ); + ok($sock, "connected to bindaddr"); + $sock->sysread(my $buf, 1024); # wait for disconnect + undef $sock; + $sock = IO::Socket::IP->new( + PeerHost => $other_addr, + PeerPort => $port, + Proto => 'tcp', + ); + ok ! defined $sock, "cannot connect to other addr"; + kill 'TERM', $pid; + wait(); +} + +subtest "v4" => sub { + doit("127.0.0.1", "::1"); +}; +subtest "v6" => sub { + doit("::1", "127.0.0.1"); +}; + +done_testing; diff --git a/web/server/h2o/libh2o/misc/p5-Server-Starter/t/11-specified-fd-server.pl b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/11-specified-fd-server.pl new file mode 100644 index 00000000..f05282ee --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/11-specified-fd-server.pl @@ -0,0 +1,25 @@ +#! /usr/bin/perl +use strict; +use warnings; + +use lib qw(blib/lib lib); + +use IO::Socket::INET; +use Server::Starter qw(server_ports); + +die "fd must be zero" unless ((values %{server_ports()})[0]) eq 0; + +my $listener = IO::Socket::INET->new( + Proto => 'tcp', +); +$listener->fdopen(0, 'w') + or die "failed to bind listening socket:$!"; + +while (1) { + if (my $conn = $listener->accept) { + my $buf; + while ($conn->sysread($buf, 1048576) > 0) { + $conn->syswrite("$$:$buf"); + } + } +} diff --git a/web/server/h2o/libh2o/misc/p5-Server-Starter/t/11-specified-fd.t b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/11-specified-fd.t new file mode 100644 index 00000000..7e3b820b --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/11-specified-fd.t @@ -0,0 +1,40 @@ +use strict; +use warnings; + +use File::Temp (); +use Test::TCP; +use Test::More tests => 4; + +use Server::Starter qw(start_server); + +$SIG{PIPE} = sub {}; + +test_tcp( + server => sub { + my $port = shift; + start_server( + port => "$port=0", + exec => [ + $^X, qw(t/11-specified-fd-server.pl) + ], + ); + exit 0; + }, + client => sub { + my ($port, $server_pid) = @_; + my $buf; + #sleep 1; + my $sock = IO::Socket::INET->new( + PeerAddr => "127.0.0.1:$port", + Proto => 'tcp', + ); + ok($sock, 'connect'); + # check response and get pid + is($sock->syswrite("hello"), 5, 'write'); + ok($sock->sysread($buf, 1048576), 'read'); + undef $sock; + like($buf, qr/^\d+:hello$/, 'read'); + kill $server_pid; + }, +); + diff --git a/web/server/h2o/libh2o/misc/p5-Server-Starter/t/12-stop-server.pl b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/12-stop-server.pl new file mode 100755 index 00000000..ace7e5db --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/12-stop-server.pl @@ -0,0 +1,24 @@ +#! /usr/bin/perl + +use strict; +use warnings; + +use lib qw(blib/lib lib); + +use IO::Socket::INET; +use Server::Starter qw(server_ports); + +my $listener = IO::Socket::INET->new( + Proto => 'tcp', +); +$listener->fdopen((values %{server_ports()})[0], 'w') + or die "failed to bind listening socket:$!"; + +while (1) { + if (my $conn = $listener->accept) { + my $buf; + while ($conn->sysread($buf, 1048576) > 0) { + $conn->syswrite("$$:$buf"); + } + } +} diff --git a/web/server/h2o/libh2o/misc/p5-Server-Starter/t/12-stop.t b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/12-stop.t new file mode 100644 index 00000000..6d40c25f --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/12-stop.t @@ -0,0 +1,50 @@ +use strict; +use warnings; +use utf8; +use Test::More; +use Server::Starter qw(start_server restart_server stop_server); +use File::Temp qw(tempdir); +use Test::TCP; + +plan tests => 2; + +my $dir = tempdir( CLEANUP => 1 ); +my $pidfile = "$dir/pid"; + +test_tcp( + server => sub { + my $port = shift; + + start_server( + pid_file => $pidfile, + daemonize => 1, + port => $port, + exec => [ $^X, 't/12-stop-server.pl' ], + ); + exit 0; + }, + client => sub { + my $port = shift; + + while (!-s $pidfile) { + note 'pid file is not available'; + sleep 1; # wait pid file + } + + my $pid = do { + open my $fh, '<', $pidfile + or die "Cannot open $pidfile: $!"; + local $/; + <$fh>; + }; + note "PID=$pid"; + is(kill(0, $pid), 1, 'there is a process'); + + stop_server( + pid_file => $pidfile, + port => $port, + ); + ok((!-e $pidfile), 'pid file was unlinked'); + }, +); + diff --git a/web/server/h2o/libh2o/misc/p5-Server-Starter/t/13-unix-daemonize.t b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/13-unix-daemonize.t new file mode 100644 index 00000000..ab401dc3 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-Server-Starter/t/13-unix-daemonize.t @@ -0,0 +1,68 @@ +use strict; +use warnings; +use utf8; +use Test::More; +use Server::Starter qw(start_server stop_server); +use Server::Starter::Guard; +use File::Temp qw(tempdir); + +plan tests => 1; + +my $dir = tempdir( CLEANUP => 1 ); +my $pidfile = "$dir/pid"; +my $sockfile = "$dir/server.sock"; + +fork_ok( + child => sub { + start_server( + pid_file => $pidfile, + daemonize => 1, + path => $sockfile, + exec => [ $^X, qw(t/03-starter-unix-echod.pl) ], + ); + }, + + parent => sub { + my $guard = Server::Starter::Guard->new(sub { + stop_server( pid_file => $pidfile ); + }); + + wait_for(sub { -e $pidfile }) + or BAIL_OUT("Pidfile '$pidfile' was not created in a timely fashion"); + + wait_for(sub { -e $sockfile }) + or BAIL_OUT("Socket '$sockfile' was not created in a timely fashion"); + + ok(-e $sockfile, 'there is a socket'); + }, +) or die "fork failed: $!"; + +sub fork_ok { + my (%args) = @_; + + my $pid = fork; + return unless defined $pid; + if ($pid == 0) { + $args{child}->(); + } + else { + $args{parent}->($pid); + } + + return 1; +} + +sub wait_for { + my ($code, %opts) = @_; + + my $times = $opts{times} || 10; + my $every = $opts{every} || 1; + + while ( $times > 0 ) { + return 1 if $code->(); + $times--; + sleep $every; + } + + return 0; +} |