From 0dcd8bd569813a175ad43837db3ab07019a95b99 Mon Sep 17 00:00:00 2001 From: Eric Wong Date: Mon, 5 Jun 2023 10:12:43 +0000 Subject: [PATCH 14/23] tests: consistent tcp_start and unix_start across Perl 5 tests I'll be using Unix sockets more in tests since there's no risk of system-wide conflicts with TCP port allocation. Furthermore, curl supports `--unix-socket' nowadays; so there's little reason to rely on TCP sockets and the conflicts they bring in tests. --- t/active-unix-socket.t | 13 ++++--------- t/integration.t | 28 ++++++++++++++-------------- t/lib.perl | 30 ++++++++++++++++-------------- 3 files changed, 34 insertions(+), 37 deletions(-) diff --git a/t/active-unix-socket.t b/t/active-unix-socket.t index c132dc2..8723137 100644 --- a/t/active-unix-socket.t +++ b/t/active-unix-socket.t @@ -10,11 +10,6 @@ my %to_kill; END { kill('TERM', values(%to_kill)) if keys %to_kill } my $u1 = "$tmpdir/u1.sock"; my $u2 = "$tmpdir/u2.sock"; -my $unix_req = sub { - my $s = IO::Socket::UNIX->new(Peer => shift, Type => SOCK_STREAM); - print $s @_, "\r\n\r\n"; - $s; -}; { open my $fh, '>', "$tmpdir/u1.conf.rb"; print $fh <($u1, 'GET /pid'))); +chomp(my $worker_pid = readline(unix_start($u1, 'GET /pid'))); like($worker_pid, qr/\A\d+\z/s, 'captured worker pid'); ok(kill(0, $worker_pid), 'worker is kill-able'); @@ -65,7 +60,7 @@ isnt($?, 0, 'conflicting PID file fails to start'); chomp(my $pidf = slurp("$tmpdir/u.pid")); is($pidf, $to_kill{u1}, 'pid file contents unchanged after start failure'); -chomp(my $pid2 = readline($unix_req->($u1, 'GET /pid'))); +chomp(my $pid2 = readline(unix_start($u1, 'GET /pid'))); is($worker_pid, $pid2, 'worker PID unchanged'); @@ -73,7 +68,7 @@ is($worker_pid, $pid2, 'worker PID unchanged'); unicorn('-c', "$tmpdir/u3.conf.rb", @uarg)->join; isnt($?, 0, 'conflicting UNIX socket fails to start'); -chomp($pid2 = readline($unix_req->($u1, 'GET /pid'))); +chomp($pid2 = readline(unix_start($u1, 'GET /pid'))); is($worker_pid, $pid2, 'worker PID still unchanged'); chomp($pidf = slurp("$tmpdir/u.pid")); @@ -101,7 +96,7 @@ is($pidf, $to_kill{u1}, 'pid file contents unchanged after 2nd start failure'); chomp($to_kill{u1} = slurp("$tmpdir/u.pid")); like($to_kill{u1}, qr/\A\d+\z/s, 'read pid file'); - chomp($pid2 = readline($unix_req->($u1, 'GET /pid'))); + chomp($pid2 = readline(unix_start($u1, 'GET /pid'))); like($pid2, qr/\A\d+\z/, 'worker running'); ok(kill('TERM', delete $to_kill{u1}), 'SIGTERM restarted daemon'); diff --git a/t/integration.t b/t/integration.t index 939dc24..b33e3c3 100644 --- a/t/integration.t +++ b/t/integration.t @@ -70,7 +70,7 @@ EOM my ($c, $status, $hdr); # response header tests -$c = start_req($srv, 'GET /rack-2-newline-headers HTTP/1.0'); +$c = tcp_start($srv, 'GET /rack-2-newline-headers HTTP/1.0'); ($status, $hdr) = slurp_hdr($c); like($status, qr!\AHTTP/1\.[01] 200\b!, 'status line valid'); my $orig_200_status = $status; @@ -89,7 +89,7 @@ SKIP: { # Date header check }; -$c = start_req($srv, 'GET /rack-3-array-headers HTTP/1.0'); +$c = tcp_start($srv, 'GET /rack-3-array-headers HTTP/1.0'); ($status, $hdr) = slurp_hdr($c); is_deeply([ grep(/^x-r3: /, @$hdr) ], [ 'x-r3: a', 'x-r3: b', 'x-r3: c' ], @@ -97,7 +97,7 @@ is_deeply([ grep(/^x-r3: /, @$hdr) ], SKIP: { eval { require JSON::PP } or skip "JSON::PP missing: $@", 1; - my $c = start_req($srv, 'GET /env_dump'); + my $c = tcp_start($srv, 'GET /env_dump'); my $json = do { local $/; readline($c) }; unlike($json, qr/^Connection: /smi, 'no connection header for 0.9'); unlike($json, qr!\AHTTP/!s, 'no HTTP/1.x prefix for 0.9'); @@ -107,17 +107,17 @@ SKIP: { } # cf. -$c = start_req($srv, 'GET /nil-header-value HTTP/1.0'); +$c = tcp_start($srv, 'GET /nil-header-value HTTP/1.0'); ($status, $hdr) = slurp_hdr($c); is_deeply([grep(/^X-Nil:/, @$hdr)], ['X-Nil: '], 'nil header value accepted for broken apps') or diag(explain($hdr)); if ('TODO: ensure Rack::Utils::HTTP_STATUS_CODES is available') { - $c = start_req($srv, 'POST /tweak-status-code HTTP/1.0'); + $c = tcp_start($srv, 'POST /tweak-status-code HTTP/1.0'); ($status, $hdr) = slurp_hdr($c); like($status, qr!\AHTTP/1\.[01] 200 HI\b!, 'status tweaked'); - $c = start_req($srv, 'POST /restore-status-code HTTP/1.0'); + $c = tcp_start($srv, 'POST /restore-status-code HTTP/1.0'); ($status, $hdr) = slurp_hdr($c); is($status, $orig_200_status, 'original status restored'); } @@ -130,12 +130,12 @@ SKIP: { } if ('bad requests') { - $c = start_req($srv, 'GET /env_dump HTTP/1/1'); + $c = tcp_start($srv, 'GET /env_dump HTTP/1/1'); ($status, $hdr) = slurp_hdr($c); like($status, qr!\AHTTP/1\.[01] 400 \b!, 'got 400 on bad request'); - $c = tcp_connect($srv); - print $c 'GET /'; + $c = tcp_start($srv); + print $c 'GET /';; my $buf = join('', (0..9), 'ab'); for (0..1023) { print $c $buf } print $c " HTTP/1.0\r\n\r\n"; @@ -143,7 +143,7 @@ if ('bad requests') { like($status, qr!\AHTTP/1\.[01] 414 \b!, '414 on REQUEST_PATH > (12 * 1024)'); - $c = tcp_connect($srv); + $c = tcp_start($srv); print $c 'GET /hello-world?a'; $buf = join('', (0..9)); for (0..1023) { print $c $buf } @@ -152,7 +152,7 @@ if ('bad requests') { like($status, qr!\AHTTP/1\.[01] 414 \b!, '414 on QUERY_STRING > (10 * 1024)'); - $c = tcp_connect($srv); + $c = tcp_start($srv); print $c 'GET /hello-world#a'; $buf = join('', (0..9), 'a'..'f'); for (0..63) { print $c $buf } @@ -173,7 +173,7 @@ SKIP: { my $ck_hash = sub { my ($sub, $path, %opt) = @_; seek($rh, 0, SEEK_SET); - $c = tcp_connect($srv); + $c = tcp_start($srv); $c->autoflush(0); $PUT{$sub}->($rh, $c, $path, %opt); $c->flush or die $!; @@ -235,11 +235,11 @@ EOM $wpid =~ s/\Apid=// or die; ok(CORE::kill(0, $wpid), 'worker PID retrieved'); - $c = start_req($srv, $req); + $c = tcp_start($srv, $req); ($status, $hdr) = slurp_hdr($c); like($status, qr!\AHTTP/1\.[01] 200\b!, 'minimal request succeeds'); - $c = start_req($srv, 'GET /xxxxxx HTTP/1.0'); + $c = tcp_start($srv, 'GET /xxxxxx HTTP/1.0'); ($status, $hdr) = slurp_hdr($c); like($status, qr!\AHTTP/1\.[01] 413\b!, 'big request fails'); } diff --git a/t/lib.perl b/t/lib.perl index 315ef2d..1d6e78d 100644 --- a/t/lib.perl +++ b/t/lib.perl @@ -10,8 +10,8 @@ use IO::Socket::INET; use POSIX qw(dup2 _exit setpgid :signal_h SEEK_SET F_SETFD); use File::Temp 0.19 (); # 0.19 for ->newdir our ($tmpdir, $errfh); -our @EXPORT = qw(unicorn slurp tcp_server tcp_connect unicorn $tmpdir $errfh - SEEK_SET tcp_host_port start_req which spawn check_stderr); +our @EXPORT = qw(unicorn slurp tcp_server tcp_start unicorn $tmpdir $errfh + SEEK_SET tcp_host_port which spawn check_stderr unix_start); my ($base) = ($0 =~ m!\b([^/]+)\.[^\.]+\z!); $tmpdir = File::Temp->newdir("unicorn-$base-XXXX", TMPDIR => 1); @@ -55,26 +55,28 @@ sub tcp_host_port { } } -sub tcp_connect { - my ($dest, %opt) = @_; - my $addr = tcp_host_port($dest); - my $s = ref($dest)->new( +sub unix_start ($@) { + my ($dst, @req) = @_; + my $s = IO::Socket::UNIX->new(Peer => $dst, Type => SOCK_STREAM) or + BAIL_OUT "unix connect $dst: $!"; + $s->autoflush(1); + print $s @req, "\r\n\r\n" if @req; + $s; +} + +sub tcp_start ($@) { + my ($dst, @req) = @_; + my $addr = tcp_host_port($dst); + my $s = ref($dst)->new( Proto => 'tcp', Type => SOCK_STREAM, PeerAddr => $addr, - %opt, ) or BAIL_OUT "failed to connect to $addr: $!"; $s->autoflush(1); + print $s @req, "\r\n\r\n" if @req; $s; } -sub start_req { - my ($srv, @req) = @_; - my $c = tcp_connect($srv); - print $c @req, "\r\n\r\n"; - $c; -} - sub slurp { open my $fh, '<', $_[0]; local $/;