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.

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 <<EOM;
@@ -53,7 +48,7 @@ is($?, 0, 'daemonized 1st process');
 chomp($to_kill{u1} = slurp("$tmpdir/u.pid"));
 like($to_kill{u1}, qr/\A\d+\z/s, 'read pid file');
 
-chomp(my $worker_pid = readline($unix_req->($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. <CAO47=rJa=zRcLn_Xm4v2cHPr6c0UswaFC_omYFEH+baSxHOWKQ@mail.gmail.com>
-$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 $/;