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 File::Copy;
45
46use Getopt::Long;
47Getopt::Long::Configure ("pass_through");
48
49my ($logfiles, $logsize) = (8,10);
50my $result = GetOptions(
51  'logfiles=i' => \$logfiles,
52  'logsize=i'  => \$logsize,
53);
54
55use App::Netdisco::Environment;
56my $config = ($ENV{PLACK_ENV} || $ENV{DANCER_ENVIRONMENT}) .'.yml';
57
58# make sure there is a config file in place
59my $template_config = file($ENV{DANCER_CONFDIR}, 'environments', $config);
60my $app_config = file($ENV{DANCER_ENVDIR}, $config);
61if (! -e $app_config and -e $template_config) {
62  copy $template_config, $app_config;
63}
64if (! -e $app_config) {
65  die "error: cannot find Netdisco config at $template_config or $app_config\n";
66}
67
68my $netdisco = file($FindBin::RealBin, 'netdisco-backend-fg');
69my @args = (scalar @ARGV > 1 ? @ARGV[1 .. $#ARGV] : ());
70
71my $log_dir = dir($home, 'logs');
72mkdir $log_dir if ! -d $log_dir;
73my $log_file = file($log_dir, 'netdisco-backend.log');
74
75my $uid = (stat($netdisco->stringify))[4] || 0;
76my $gid = (stat($netdisco->stringify))[5] || 0;
77
78my $old_pid = file($home, 'netdisco-daemon.pid');
79my $new_pid = file($home, 'netdisco-backend.pid');
80if (-f $old_pid) { File::Copy::move( $old_pid, $new_pid ) }
81
82Daemon::Control->new({
83  name => 'Netdisco Backend',
84  program  => \&restarter,
85  program_args => [@args],
86  pid_file => $new_pid,
87  stderr_file => $log_file,
88  stdout_file => $log_file,
89  redirect_before_fork => 0,
90  uid => $uid, gid => $gid,
91})->run;
92
93# the guts of this are borrowed from Plack::Loader::Restarter - many thanks!!
94my $child = 0;
95
96sub restarter {
97  my ($daemon, @program_args) = @_;
98  $0 = 'netdisco-backend';
99
100  $child = fork_and_start($daemon, @program_args);
101  exit(1) unless $child;
102
103  my $watcher = Filesys::Notify::Simple->new([$ENV{DANCER_ENVDIR}, $log_dir]);
104  warn "config watcher: watching $ENV{DANCER_ENVDIR} for updates.\n";
105
106  local $SIG{TERM} = sub { $child = signal_child('TERM', $child); exit(0); };
107
108  while (1) {
109      my @restart;
110
111      # this is blocking
112      $watcher->wait(sub {
113          my @events = @_;
114          @events = grep {$_->{path} eq $log_file or
115                          file($_->{path})->basename eq $config} @events;
116          return unless @events;
117          @restart = @events;
118      });
119
120      my ($hupit, $rotate) = (0, 0);
121      next unless @restart;
122
123      foreach my $f (@restart) {
124          if ($f->{path} eq $log_file) {
125              ++$rotate;
126          }
127          else {
128              warn "-- $f->{path} updated.\n";
129              ++$hupit;
130          }
131      }
132
133      rotate_logs($child, $daemon, @program_args) if $rotate;
134      if ($hupit) {
135          signal_child('TERM', $child);
136          $child = fork_and_start($daemon, @program_args);
137          exit(1) unless $child;
138      }
139  }
140}
141
142sub fork_and_start {
143  my ($daemon, @daemon_args) = @_;
144  my $pid = fork;
145  die "Can't fork: $!" unless defined $pid;
146
147  if ($pid == 0) { # child
148      $daemon->redirect_filehandles;
149      exec( $netdisco->stringify, @daemon_args );
150  }
151  else {
152      return $pid;
153  }
154}
155
156sub signal_child {
157  my ($signal, $pid) = @_;
158  return unless $signal and $pid;
159  warn "config watcher: sending $signal to the server (pid:$pid)...\n";
160  kill $signal => $pid;
161  waitpid($pid, 0);
162}
163
164sub rotate_logs {
165  my $child = shift;
166
167  return unless (-f $log_file) and
168    ((-s $log_file) > ($logsize * 1024768));
169
170  my @files = glob file($log_dir, '*');
171  foreach my $f (reverse sort @files) {
172      next unless $f =~ m/$log_file\.(\d)$/;
173      my $pos = $1;
174      unlink $f if $pos == ($logfiles - 1);
175      my $next = $pos + 1;
176      (my $newf = $f) =~ s/\.$pos$/.$next/;
177      rename $f, $newf;
178  }
179
180  # if the log file's about 10M then the race condition in copy/truncate
181  # has a low risk of data loss. if the file's larger, then we rename and
182  # kill.
183  if ((-s $log_file) > (12 * 1024768)) {
184      rename $log_file, $log_file .'.1';
185      signal_child('TERM', $child);
186      $child = fork_and_start(@_);
187      exit(1) unless $child;
188  }
189  else {
190      copy $log_file, $log_file .'.1';
191      truncate $log_file, 0;
192  }
193}
194
195=head1 NAME
196
197netdisco-backend - Job Control Daemon for Netdisco
198
199=head1 SEE ALSO
200
201=over 4
202
203=item *
204
205L<App::Netdisco>
206
207=back
208
209=cut
210