1#!/usr/bin/env perl
2
3use strict;
4use warnings;
5
6our $home;
7
8BEGIN {
9  use FindBin;
10  FindBin::again();
11
12  my $me = File::Spec->catfile($FindBin::RealBin, $FindBin::RealScript);
13  my $uid = (stat($me))[4] || 0;
14
15  $home = ($ENV{NETDISCO_HOME} || (getpwuid($uid))[7] || $ENV{HOME});
16
17  # try to find a localenv if one isn't already in place.
18  if (!exists $ENV{PERL_LOCAL_LIB_ROOT}) {
19      use File::Spec;
20      my $localenv = File::Spec->catfile($FindBin::Bin, 'localenv');
21      exec($localenv, $0, @ARGV) if -f $localenv;
22      $localenv = File::Spec->catfile($home, 'perl5', 'bin', 'localenv');
23      exec($localenv, $0, @ARGV) if -f $localenv;
24
25      die "Sorry, can't find libs required for App::Netdisco.\n"
26        if !exists $ENV{PERLBREW_PERL};
27  }
28}
29
30BEGIN {
31  use Path::Class;
32
33  # stuff useful locations into @INC and $PATH
34  unshift @INC,
35    dir($FindBin::RealBin)->parent->subdir('lib')->stringify,
36    dir($FindBin::RealBin, 'lib')->stringify;
37
38  use Config;
39  $ENV{PATH} = $FindBin::RealBin . $Config{path_sep} . $ENV{PATH};
40}
41
42use Daemon::Control;
43use Filesys::Notify::Simple;
44use IO::File;
45use File::Copy;
46
47use Getopt::Long;
48Getopt::Long::Configure ("pass_through");
49
50my ($logfiles, $logsize) = (8,10);
51my $result = GetOptions(
52  'logfiles=i' => \$logfiles,
53  'logsize=i'  => \$logsize,
54);
55
56use App::Netdisco::Environment;
57my $config = ($ENV{PLACK_ENV} || $ENV{DANCER_ENVIRONMENT}) .'.yml';
58
59# make sure there is a config file in place
60my $template_config = file($ENV{DANCER_CONFDIR}, 'environments', $config);
61my $app_config = file($ENV{DANCER_ENVDIR}, $config);
62if (! -e $app_config and -e $template_config) {
63  copy $template_config, $app_config;
64}
65if (! -e $app_config) {
66  die "error: cannot find Netdisco config at $template_config or $app_config\n";
67}
68
69my $netdisco = file($FindBin::RealBin, 'netdisco-web-fg');
70my @args = (scalar @ARGV > 1 ? @ARGV[1 .. $#ARGV] : ());
71
72my $uid = (stat($netdisco->stringify))[4] || 0;
73my $gid = (stat($netdisco->stringify))[5] || 0;
74
75my $log_dir = dir($home, 'logs');
76mkdir $log_dir if ! -d $log_dir;
77chown $uid, $gid, $log_dir;
78
79my $pid_file = file($home, 'netdisco-web.pid');
80my $log_file = file($log_dir, 'netdisco-web.log');
81
82# change ownership of key files to be netdisco user
83foreach my $file ($pid_file, $log_file) {
84    unless (-e $file) {
85        sysopen my $fh, $file, O_WRONLY|O_CREAT|O_NONBLOCK|O_NOCTTY;
86        print $fh '0' if $file eq $pid_file;
87        close $fh;
88    }
89    chown $uid, $gid, $file;
90}
91
92# clean old web sessions
93my $sdir = dir($home, 'netdisco-web-sessions')->stringify;
94unlink glob file($sdir, '*');
95
96Daemon::Control->new({
97  name => 'Netdisco Web',
98  program  => \&restarter,
99  program_args => [
100    '--disable-keepalive',
101    '--user', $uid, '--group', $gid,
102    @args, $netdisco->stringify
103  ],
104  pid_file => $pid_file,
105  stderr_file => $log_file,
106  stdout_file => $log_file,
107  redirect_before_fork => 0,
108  ((scalar grep { $_ =~ m/port/ } @args) ? ()
109                                         : (uid => $uid, gid => $gid)),
110})->run;
111
112# the guts of this are borrowed from Plack::Loader::Restarter - many thanks!!
113
114sub restarter {
115  my ($daemon, @program_args) = @_;
116
117  my $child = fork_and_start($daemon, @program_args);
118  exit(1) unless $child;
119
120  my $watcher = Filesys::Notify::Simple->new([$ENV{DANCER_ENVDIR}, $log_dir]);
121  warn "config watcher: watching $ENV{DANCER_ENVDIR} for updates.\n";
122
123  # TODO: starman also supports TTIN,TTOU,INT,QUIT
124  local $SIG{HUP}  = sub { signal_child('HUP',  $child); };
125  local $SIG{TERM} = sub { signal_child('TERM', $child); exit(0); };
126
127  while (1) {
128      my @restart;
129
130      # this is blocking
131      $watcher->wait(sub {
132          my @events = @_;
133          @events = grep {$_->{path} eq $log_file or
134                          file($_->{path})->basename eq $config} @events;
135          return unless @events;
136          @restart = @events;
137      });
138
139      my ($hupit, $rotate) = (0, 0);
140      next unless @restart;
141
142      foreach my $f (@restart) {
143          if ($f->{path} eq $log_file) {
144              ++$rotate;
145          }
146          else {
147              warn "-- $f->{path} updated.\n";
148              ++$hupit;
149          }
150      }
151
152      rotate_logs($child) if $rotate;
153      signal_child('HUP', $child) if $hupit;
154  }
155}
156
157sub fork_and_start {
158  my ($daemon, @starman_args) = @_;
159  my $pid = fork;
160  die "Can't fork: $!" unless defined $pid;
161
162  if ($pid == 0) { # child
163      $daemon->redirect_filehandles;
164      exec( 'starman', @starman_args );
165  }
166  else {
167      return $pid;
168  }
169}
170
171sub signal_child {
172  my ($signal, $pid) = @_;
173  return unless $signal and $pid;
174  warn "config watcher: sending $signal to the server (pid:$pid)...\n";
175  kill $signal => $pid;
176  waitpid($pid, 0);
177}
178
179sub rotate_logs {
180  my $child = shift;
181
182  return unless (-f $log_file) and
183    ((-s $log_file) > ($logsize * 1024768));
184
185  my @files = glob file($log_dir, '*');
186  foreach my $f (reverse sort @files) {
187      next unless $f =~ m/$log_file\.(\d)$/;
188      my $pos = $1;
189      unlink $f if $pos == ($logfiles - 1);
190      my $next = $pos + 1;
191      (my $newf = $f) =~ s/\.$pos$/.$next/;
192      rename $f, $newf;
193  }
194
195  # if the log file's about 10M then the race condition in copy/truncate
196  # has a low risk of data loss. if the file's larger, then we rename and
197  # kill.
198  if ((-s $log_file) > (12 * 1024768)) {
199      rename $log_file, $log_file .'.1';
200      signal_child('HUP', $child);
201  }
202  else {
203      copy $log_file, $log_file .'.1';
204      truncate $log_file, 0;
205  }
206}
207
208=head1 NAME
209
210netdisco-web - Web Application Server for Netdisco
211
212=head1 SEE ALSO
213
214=over 4
215
216=item *
217
218L<App::Netdisco>
219
220=back
221
222=cut
223