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