Mojo::Server::Hypnotoad - ALL GLORY TO THE HYPNOTOAD!

  use Mojo::Server::Hypnotoad;

  my $toad = Mojo::Server::Hypnotoad->new;
  $toad->run('./myapp.pl', './hypnotoad.conf');

  % hypnotoad myapp.pl

  # hypnotoad.conf
  {listen => ['http://*:3000', 'http://*:4000'], workers => 10};

  accepts => 100

  backlog => 128

  clients => 100

  graceful_timeout => 15

  group => 'staff'

  heartbeat_interval => 3

  heartbeat_timeout => 5

  keep_alive_requests => 50

  keep_alive_timeout => 10

  listen => ['http://*:80']

  lock_file => '/tmp/hypnotoad.lock'

  pid_file => '/var/run/hypnotoad.pid'

  proxy => 1

  upgrade_timeout => 15

  user => 'sri'

  websocket_timeout => 150

  workers => 10

  $toad->run('script/myapp', 'hypnotoad.conf');

  HYPNOTOAD_DEBUG=1

package Mojo::Server::Hypnotoad;
use Mojo::Base -base;

use Carp 'croak';
use Cwd 'abs_path';
use Fcntl ':flock';
use File::Basename 'dirname';
use File::Spec;
use IO::File;
use IO::Poll 'POLLIN';
use List::Util 'shuffle';
use Mojo::Server::Daemon;
use POSIX qw/setsid WNOHANG/;
use Scalar::Util 'weaken';

# Preload
use Mojo::UserAgent;

use constant DEBUG => $ENV{HYPNOTOAD_DEBUG} || 0;

sub DESTROY {
  my $self = shift;

  # Worker
  return if $ENV{HYPNOTOAD_WORKER};

  # Manager
  return unless my $file = $self->{_config}->{pid_file};
  unlink $file if -f $file;
}

# "Marge? Since I'm not talking to Lisa,
#  would you please ask her to pass me the syrup?
#  Dear, please pass your father the syrup, Lisa.
#  Bart, tell Dad I will only pass the syrup if it won't be used on any meat
#  product.
#  You dunkin' your sausages in that syrup homeboy?
#  Marge, tell Bart I just want to drink a nice glass of syrup like I do
#  every morning.
#  Tell him yourself, you're ignoring Lisa, not Bart.
#  Bart, thank your mother for pointing that out.
#  Homer, you're not not-talking to me and secondly I heard what you said.
#  Lisa, tell your mother to get off my case.
#  Uhhh, dad, Lisa's the one you're not talking to.
#  Bart, go to your room."
sub run {
  my ($self, $app, $config) = @_;

  # No windows support
  die "Hypnotoad not available for Windows.\n"
    if $^O eq 'MSWin32' || $^O =~ /cygwin/;

  # Application
  $ENV{HYPNOTOAD_APP} ||= abs_path $app;

  # Config
  $ENV{HYPNOTOAD_CONFIG} ||= abs_path $config;

  # This is a production server
  $ENV{MOJO_MODE} ||= 'production';

  # Executable
  $ENV{HYPNOTOAD_EXE} ||= $0;
  $0 = $ENV{HYPNOTOAD_APP};

  # Clean start
  exec $ENV{HYPNOTOAD_EXE} unless $ENV{HYPNOTOAD_REV}++;

  # Preload application
  my $daemon = $self->{_daemon} = Mojo::Server::Daemon->new;
  warn "APPLICATION $ENV{HYPNOTOAD_APP}\n" if DEBUG;
  $daemon->load_app($ENV{HYPNOTOAD_APP});

  # Load configuration
  $self->_config;

  # Testing
  die "Everything looks good!\n" if $ENV{HYPNOTOAD_TEST};

  # Prepare loop
  $daemon->prepare_ioloop;

  # Pipe for worker communication
  pipe($self->{_reader}, $self->{_writer})
    or croak "Can't create pipe: $!";
  $self->{_poll} = IO::Poll->new;
  $self->{_poll}->mask($self->{_reader}, POLLIN);

  # Daemonize
  if (!DEBUG && !$ENV{HYPNOTOAD_FOREGROUND}) {

    # Fork and kill parent
    die "Can't fork: $!" unless defined(my $pid = fork);
    exit 0 if $pid;
    setsid or die "Can't start a new session: $!";

    # Close file handles
    open STDIN,  '</dev/null';
    open STDOUT, '>/dev/null';
    open STDERR, '>&STDOUT';
  }

  # Manager signals
  my $c = $self->{_config};
  $SIG{INT} = $SIG{TERM} = sub { $self->{_done} = 1 };
  $SIG{CHLD} = sub {
    while ((my $pid = waitpid -1, WNOHANG) > 0) { $self->_reap($pid) }
  };
  $SIG{QUIT} = sub { $self->{_done} = $self->{_graceful} = 1 };
  $SIG{USR2} = sub { $self->{_upgrade} ||= time };
  $SIG{TTIN} = sub { $c->{workers}++ };
  $SIG{TTOU} = sub {
    return unless $c->{workers};
    $c->{workers}--;
    $self->{_workers}->{shuffle keys %{$self->{_workers}}}->{graceful}
      ||= time;
  };

  # Mainloop
  warn "MANAGER STARTED $$\n" if DEBUG;
  $self->_manage while 1;
}

sub _config {
  my $self = shift;

  # Load config file
  my $file = $ENV{HYPNOTOAD_CONFIG};
  warn "CONFIG $file\n" if DEBUG;
  my $c = {};
  if (-r $file) {
    unless ($c = do $file) {
      die qq/Can't load config file "$file": $@/ if $@;
      die qq/Can't load config file "$file": $!/ unless defined $c;
      die qq/Config file "$file" did not return a hashref.\n/
        unless ref $c eq 'HASH';
    }
  }
  $self->{_config} = $c;

  # Hypnotoad settings
  $c->{graceful_timeout}   ||= 30;
  $c->{heartbeat_interval} ||= 5;
  $c->{heartbeat_timeout}  ||= 2;
  $c->{lock_file}
    ||= File::Spec->catfile($ENV{MOJO_TMPDIR} || File::Spec->tmpdir,
    "hypnotoad.$$.lock");
  $c->{pid_file}
    ||= File::Spec->catfile(dirname($ENV{HYPNOTOAD_APP}), 'hypnotoad.pid');
  $c->{upgrade_timeout} ||= 30;
  $c->{workers}         ||= 4;

  # Daemon settings
  $ENV{MOJO_REVERSE_PROXY} = 1 if $c->{proxy};
  my $daemon = $self->{_daemon};
  $daemon->backlog($c->{backlog}) if defined $c->{backlog};
  $daemon->max_clients($c->{clients} || 1000);
  $daemon->group($c->{group}) if $c->{group};
  $daemon->max_requests($c->{keep_alive_requests}      || 25);
  $daemon->keep_alive_timeout($c->{keep_alive_timeout} || 5);
  $daemon->user($c->{user}) if $c->{user};
  $daemon->websocket_timeout($c->{websocket_timeout} || 300);
  $daemon->ioloop->max_accepts($c->{accepts} || 1000);
  my $listen = $c->{listen} || ['http://*:8080'];
  $listen = [$listen] unless ref $listen;
  $daemon->listen($listen);
}

sub _heartbeat {
  my $self = shift;

  # Poll for heartbeats
  my $poll = $self->{_poll};
  $poll->poll(1);
  return unless $poll->handles(POLLIN);
  return unless $self->{_reader}->sysread(my $chunk, 4194304);

  # Heartbeats
  while ($chunk =~ /(\d+)\n/g) {
    my $pid = $1;
    $self->{_workers}->{$pid}->{time} = time if $self->{_workers}->{$pid};
  }
}

sub _manage {
  my $self = shift;

  # Housekeeping
  my $c = $self->{_config};
  if (!$self->{_done}) {

    # Spawn more workers
    $self->_spawn while keys %{$self->{_workers}} < $c->{workers};

    # Check PID file
    $self->_pid;
  }

  # Shutdown
  elsif (!keys %{$self->{_workers}}) { exit 0 }

  # Upgraded
  if ($ENV{HYPNOTOAD_PID} && $ENV{HYPNOTOAD_PID} ne $$) {
    warn "STOPPING MANAGER $ENV{HYPNOTOAD_PID}\n" if DEBUG;
    kill 'QUIT', $ENV{HYPNOTOAD_PID};
  }
  $ENV{HYPNOTOAD_PID} = $$;

  # Check heartbeat
  $self->_heartbeat;

  # Upgrade
  if ($self->{_upgrade} && !$self->{_done}) {

    # Start
    unless ($self->{_new}) {

      # Fork
      warn "UPGRADING\n" if DEBUG;
      croak "Can't fork: $!" unless defined(my $pid = fork);
      $self->{_new} = $pid if $pid;

      # Fresh start
      exec $ENV{HYPNOTOAD_EXE} unless $pid;
    }

    # Timeout
    kill 'TERM', $self->{_new}
      if $self->{_upgrade} + $c->{upgrade_timeout} <= time;
  }

  # Workers
  while (my ($pid, $w) = each %{$self->{_workers}}) {

    # No heartbeat
    my $interval = $c->{heartbeat_interval};
    my $timeout  = $c->{heartbeat_timeout};
    if ($w->{time} + $interval + $timeout <= time) {

      # Try graceful
      warn "STOPPING WORKER $pid\n" if DEBUG;
      $w->{graceful} ||= time;
    }

    # Graceful stop
    $w->{graceful} ||= time if $self->{_graceful};
    if ($w->{graceful}) {

      # Kill
      warn "QUIT $pid\n" if DEBUG;
      kill 'QUIT', $pid;

      # Timeout
      $w->{force} = 1
        if $w->{graceful} + $c->{graceful_timeout} <= time;
    }

    # Normal stop
    if (($self->{_done} && !$self->{_graceful}) || $w->{force}) {

      # Kill
      warn "TERM $pid\n" if DEBUG;
      kill 'TERM', $pid;
    }
  }
}

sub _pid {
  my $self = shift;

  # Check PID file
  my $file = $self->{_config}->{pid_file};
  return if -e $file;
  warn "PID $file\n" if DEBUG;

  # Create one if it doesn't exist
  my $pid = IO::File->new($file, O_WRONLY | O_CREAT | O_EXCL, 0644)
    or croak qq/Can't create PID file "$file": $!/;
  print $pid $$;
}

# "Dear Mr. President, there are too many states nowadays.
#  Please eliminate three.
#  P.S. I am not a crackpot."
sub _reap {
  my ($self, $pid) = @_;

  # Cleanup failed upgrade
  if (($self->{_new} || '') eq $pid) {
    warn "UPGRADE FAILED\n" if DEBUG;
    delete $self->{_upgrade};
    delete $self->{_new};
  }

  # Cleanup worker
  else {
    warn "WORKER DIED $pid\n" if DEBUG;
    delete $self->{_workers}->{$pid};
  }
}

# "I hope this has taught you kids a lesson: kids never learn."
sub _spawn {
  my $self = shift;

  # Fork
  croak "Can't fork: $!" unless defined(my $pid = fork);

  # Manager
  return $self->{_workers}->{$pid} = {time => time} if $pid;

  # Worker
  $ENV{HYPNOTOAD_WORKER} = 1;
  my $daemon = $self->{_daemon};
  my $loop   = $daemon->ioloop;
  my $c      = $self->{_config};

  # Prepare lock file
  my $file = $c->{lock_file};
  my $lock = IO::File->new("> $file")
    or croak qq/Can't open lock file "$file": $!/;

  # Accept mutex
  $loop->on_lock(
    sub {

      # Blocking
      my $l;
      if ($_[1]) {
        eval {
          local $SIG{ALRM} = sub { die "alarm\n" };
          my $old = alarm 1;
          $l = flock $lock, LOCK_EX;
          alarm $old;
        };
        if ($@) {
          die $@ unless $@ eq "alarm\n";
          $l = 0;
        }
      }

      # Non blocking
      else { $l = flock $lock, LOCK_EX | LOCK_NB }

      $l;
    }
  );
  $loop->on_unlock(sub { flock $lock, LOCK_UN });

  # Heartbeat
  weaken $self;
  my $cb;
  $cb = sub {
    my $loop = shift;
    $loop->timer($c->{heartbeat} => $cb) if $loop->max_connections;
    $self->{_writer}->syswrite("$$\n") or exit 0;
  };
  $cb->($loop);
  weaken $cb;

  # Worker signals
  $SIG{INT} = $SIG{TERM} = $SIG{CHLD} = $SIG{USR2} = $SIG{TTIN} = $SIG{TTOU} =
    'DEFAULT';
  $SIG{QUIT} = sub { $loop->max_connections(0) };

  # Cleanup
  delete $self->{_reader};
  delete $self->{_poll};

  # User and group
  $daemon->setuidgid;

  # Start
  warn "WORKER STARTED $$\n" if DEBUG;
  $loop->start;

  # Shutdown
  exit 0;
}

1;
__END__