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