view release on metacpan or  search on metacpan

bin/netdisco-web  view on Meta::CPAN

        close $fh;
    }
    chown $uid, $gid, $file;
}

# clean old web sessions
my $sdir = dir($home, 'netdisco-web-sessions')->stringify;
unlink glob file($sdir, '*');

Daemon::Control->new({
  name => 'Netdisco Web',
  program  => \&restarter,
  program_args => [
    '--disable-keepalive',
    '--user', $uid, '--group', $gid,
    @args, $netdisco->stringify
  ],
  pid_file => $pid_file,
  stderr_file => $log_file,
  stdout_file => $log_file,
  redirect_before_fork => 0,
  ((scalar grep { $_ =~ m/port/ } @args) ? ()
                                         : (uid => $uid, gid => $gid)),
})->run;

# the guts of this are borrowed from Plack::Loader::Restarter - many thanks!!

sub restarter {
  my ($daemon, @program_args) = @_;

  my $child = fork_and_start($daemon, @program_args);
  exit(1) unless $child;

  my $watcher = Filesys::Notify::Simple->new([$ENV{DANCER_ENVDIR}, $log_dir]);
  warn "config watcher: watching $ENV{DANCER_ENVDIR} for updates.\n";

  # TODO: starman also supports TTIN,TTOU,INT,QUIT
  local $SIG{HUP}  = sub { signal_child('HUP',  $child); };
  local $SIG{TERM} = sub { signal_child('TERM', $child); exit(0); };

  while (1) {
      my @restart;

      # this is blocking
      $watcher->wait(sub {
          my @events = @_;
          @events = grep {$_->{path} eq $log_file or
                          file($_->{path})->basename eq $config} @events;
          return unless @events;
          @restart = @events;
      });

      my ($hupit, $rotate) = (0, 0);
      next unless @restart;

      foreach my $f (@restart) {
          if ($f->{path} eq $log_file) {
              ++$rotate;
          }
          else {
              warn "-- $f->{path} updated.\n";
              ++$hupit;
          }
      }

      rotate_logs($child) if $rotate;
      if ($hupit) {
          signal_child('TERM', $child);
          warn "successfully terminated! Restarting the web server process.\n";
          $child = fork_and_start($daemon, @program_args);
          return unless $child;
      }
  }
}

sub fork_and_start {
  my ($daemon, @starman_args) = @_;
  my $pid = fork;
  die "Can't fork: $!" unless defined $pid;

  if ($pid == 0) { # child
      $daemon->redirect_filehandles;
      exec( 'starman', @starman_args );
  }
  else {
      return $pid;
  }
}

sub signal_child {
  my ($signal, $pid) = @_;
  return unless $signal and $pid;
  warn "config watcher: sending $signal to the web server (pid:$pid)...\n";
  kill $signal => $pid;
  waitpid($pid, 0);
}

sub rotate_logs {
  my $child = shift;

  return unless (-f $log_file) and
    ((-s $log_file) > ($logsize * 1024768));

  my @files = grep { /$log_file\.\d+/ } glob file($log_dir, '*');
  foreach my $f (sort { $b cmp $a } @files) {
      next unless $f =~ m/$log_file\.(\d+)$/;
      my $pos = $1;
      unlink $f if $pos == ($logfiles - 1);
      my $next = $pos + 1;
      (my $newf = $f) =~ s/\.$pos$/.$next/;
      rename $f, $newf;
  }

  # if the log file's about 10M then the race condition in copy/truncate
  # has a low risk of data loss. if the file's larger, then we rename and
  # kill.
  if ((-s $log_file) > (12 * 1024768)) {
      rename $log_file, $log_file .'.1';
      signal_child('HUP', $child);
  }
  else {