t/active-unix-socket.t

   1 #!perl -w
   2 # Copyright (C) unicorn hackers <unicorn-public@yhbt.net>
   3 # License: GPL-3.0+ <https://www.gnu.org/licenses/gpl-3.0.txt>
   4
   5 use v5.14; BEGIN { require './t/lib.perl' };
   6 use IO::Socket::UNIX;
   7 use autodie;
   8 no autodie 'kill';
   9 my %to_kill;
  10 END { kill('TERM', values(%to_kill)) if keys %to_kill }
  11 my $u1 = "$tmpdir/u1.sock";
  12 my $u2 = "$tmpdir/u2.sock";
  13 my $unix_req = sub {
  14         my $s = IO::Socket::UNIX->new(Peer => shift, Type => SOCK_STREAM);
  15         print $s @_, "\r\n\r\n";
  16         $s;
  17 };
  18 {
  19         open my $fh, '>', "$tmpdir/u1.conf.rb";
  20         print $fh <<EOM;
  21 pid "$tmpdir/u.pid"
  22 listen "$u1"
  23 stderr_path "$tmpdir/err1.log"
  24 EOM
  25         close $fh;
  26
  27         open $fh, '>', "$tmpdir/u2.conf.rb";
  28         print $fh <<EOM;
  29 pid "$tmpdir/u.pid"
  30 listen "$u2"
  31 stderr_path "$tmpdir/err2.log"
  32 EOM
  33         close $fh;
  34
  35         open $fh, '>', "$tmpdir/u3.conf.rb";
  36         print $fh <<EOM;
  37 pid "$tmpdir/u3.pid"
  38 listen "$u1"
  39 stderr_path "$tmpdir/err3.log"
  40 EOM
  41         close $fh;
  42 }
  43
  44 my @uarg = qw(-D -E none t/integration.ru);
  45
  46 # this pipe will be used to notify us when all daemons die:
  47 pipe(my $p0, my $p1);
  48 fcntl($p1, POSIX::F_SETFD, 0);
  49
  50 # start the first instance
  51 unicorn('-c', "$tmpdir/u1.conf.rb", @uarg)->join;
  52 is($?, 0, 'daemonized 1st process');
  53 chomp($to_kill{u1} = slurp("$tmpdir/u.pid"));
  54 like($to_kill{u1}, qr/\A\d+\z/s, 'read pid file');
  55
  56 chomp(my $worker_pid = readline($unix_req->($u1, 'GET /pid')));
  57 like($worker_pid, qr/\A\d+\z/s, 'captured worker pid');
  58 ok(kill(0, $worker_pid), 'worker is kill-able');
  59
  60
  61 # 2nd process conflicts on PID
  62 unicorn('-c', "$tmpdir/u2.conf.rb", @uarg)->join;
  63 isnt($?, 0, 'conflicting PID file fails to start');
  64
  65 chomp(my $pidf = slurp("$tmpdir/u.pid"));
  66 is($pidf, $to_kill{u1}, 'pid file contents unchanged after start failure');
  67
  68 chomp(my $pid2 = readline($unix_req->($u1, 'GET /pid')));
  69 is($worker_pid, $pid2, 'worker PID unchanged');
  70
  71
  72 # 3rd process conflicts on socket
  73 unicorn('-c', "$tmpdir/u3.conf.rb", @uarg)->join;
  74 isnt($?, 0, 'conflicting UNIX socket fails to start');
  75
  76 chomp($pid2 = readline($unix_req->($u1, 'GET /pid')));
  77 is($worker_pid, $pid2, 'worker PID still unchanged');
  78
  79 chomp($pidf = slurp("$tmpdir/u.pid"));
  80 is($pidf, $to_kill{u1}, 'pid file contents unchanged after 2nd start failure');
  81
  82 { # teardown initial process via SIGKILL
  83         ok(kill('KILL', delete $to_kill{u1}), 'SIGKILL initial daemon');
  84         close $p1;
  85         vec(my $rvec = '', fileno($p0), 1) = 1;
  86         is(select($rvec, undef, undef, 5), 1, 'timeout for pipe HUP');
  87         is(my $undef = <$p0>, undef, 'process closed pipe writer at exit');
  88         ok(-f "$tmpdir/u.pid", 'pid file stayed after SIGKILL');
  89         ok(-S $u1, 'socket stayed after SIGKILL');
  90         is(IO::Socket::UNIX->new(Peer => $u1, Type => SOCK_STREAM), undef,
  91                 'fail to connect to u1');
  92         ok(!kill(0, $worker_pid), 'worker gone after parent dies');
  93 }
  94
  95 # restart the first instance
  96 {
  97         pipe($p0, $p1);
  98         fcntl($p1, POSIX::F_SETFD, 0);
  99         unicorn('-c', "$tmpdir/u1.conf.rb", @uarg)->join;
 100         is($?, 0, 'daemonized 1st process');
 101         chomp($to_kill{u1} = slurp("$tmpdir/u.pid"));
 102         like($to_kill{u1}, qr/\A\d+\z/s, 'read pid file');
 103
 104         chomp($pid2 = readline($unix_req->($u1, 'GET /pid')));
 105         like($pid2, qr/\A\d+\z/, 'worker running');
 106
 107         ok(kill('TERM', delete $to_kill{u1}), 'SIGTERM restarted daemon');
 108         close $p1;
 109         vec(my $rvec = '', fileno($p0), 1) = 1;
 110         is(select($rvec, undef, undef, 5), 1, 'timeout for pipe HUP');
 111         is(my $undef = <$p0>, undef, 'process closed pipe writer at exit');
 112         ok(!-f "$tmpdir/u.pid", 'pid file gone after SIGTERM');
 113         ok(-S $u1, 'socket stays after SIGTERM');
 114 }
 115
 116 my @log = slurp("$tmpdir/err.log");
 117 diag("@log") if $ENV{V};
 118 done_testing;