view release on metacpan or  search on metacpan

bin/netdisco-web  view on Meta::CPAN

#!/usr/bin/env perl

use strict;
use warnings;

our $home;

BEGIN {
  use FindBin;
  FindBin::again();

  my $me = File::Spec->catfile($FindBin::RealBin, $FindBin::RealScript);
  my $uid = (stat($me))[4] || 0;

  $home = ($ENV{NETDISCO_HOME} || (getpwuid($uid))[7] || $ENV{HOME});

  # try to find a localenv if one isn't already in place.
  if (!exists $ENV{PERL_LOCAL_LIB_ROOT}) {
      use File::Spec;
      my $localenv = File::Spec->catfile($FindBin::Bin, 'localenv');
      exec($localenv, $0, @ARGV) if -f $localenv;
      $localenv = File::Spec->catfile($home, 'perl5', 'bin', 'localenv');
      exec($localenv, $0, @ARGV) if -f $localenv;

      die "Sorry, can't find libs required for App::Netdisco.\n"
        if !exists $ENV{PERLBREW_PERL};
  }
}

BEGIN {
  use Path::Class;

  # stuff useful locations into @INC and $PATH
  unshift @INC,
    dir($FindBin::RealBin)->parent->subdir('lib')->stringify,
    dir($FindBin::RealBin, 'lib')->stringify;

  use Config;
  $ENV{PATH} = $FindBin::RealBin . $Config{path_sep} . $ENV{PATH};
}

use Daemon::Control;
use Filesys::Notify::Simple;
use IO::File;
use File::Copy;

use Getopt::Long;
Getopt::Long::Configure ("pass_through");

my ($logfiles, $logsize) = (8,10);
my $result = GetOptions(
  'logfiles=i' => \$logfiles,
  'logsize=i'  => \$logsize,
);

use App::Netdisco::Environment;
my $config = ($ENV{PLACK_ENV} || $ENV{DANCER_ENVIRONMENT}) .'.yml';

# make sure there is a config file in place
my $template_config = file($ENV{DANCER_CONFDIR}, 'environments', $config);
my $app_config = file($ENV{DANCER_ENVDIR}, $config);
if (! -e $app_config and -e $template_config) {
  copy $template_config, $app_config;
}
if (! -e $app_config) {
  die "error: cannot find Netdisco config at $template_config or $app_config\n";
}

my $netdisco = file($FindBin::RealBin, 'netdisco-web-fg');
my @args = (scalar @ARGV > 1 ? @ARGV[1 .. $#ARGV] : ());

if (exists $ENV{PORT} and 0 == scalar grep { $_ =~ m/port/ } @args) {
    push @args, "--port=$ENV{PORT}";
}

my $foreground = (@ARGV and $ARGV[0] eq 'foreground');

my $uid = (stat($netdisco->stringify))[4] || 0;
my $gid = (stat($netdisco->stringify))[5] || 0;

# only drop privileges if we are root; otherwise we cannot setuid anyway
# and Daemon::Control / starman would emit a misleading
# "Operation not permitted" warning under e.g. OpenShift random UIDs.
my $can_drop_priv = ($> == 0);

my $log_dir = dir($home, 'logs');
my $log_file;
if (!$foreground) {
  mkdir $log_dir if ! -d $log_dir;
  chown $uid, $gid, $log_dir;
  $log_file = file($log_dir, 'netdisco-web.log');
}

my $pid_file = file($home, 'netdisco-web.pid');

# change ownership of key files to be netdisco user
foreach my $file ($pid_file, ($foreground ? () : $log_file)) {
    unless (-e $file) {
        sysopen my $fh, $file, O_WRONLY|O_CREAT|O_NONBLOCK|O_NOCTTY;
        print $fh '0' if $file eq $pid_file;
        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',
    ($can_drop_priv ? ('--user', $uid, '--group', $gid) : ()),
    @args, $netdisco->stringify
  ],
  pid_file => $pid_file,
  ($foreground ? () : (
    stderr_file => $log_file,
    stdout_file => $log_file,
  )),
  redirect_before_fork => 0,
  (($can_drop_priv and 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},
    ($foreground ? () : $log_dir),
  ]);