168 lines
3.8 KiB
Perl
Executable File
168 lines
3.8 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
|
|
use strict;
|
|
use Getopt::Long;
|
|
use IO::Socket::INET;
|
|
use IO::Select;
|
|
use Time::HiRes qw(time ualarm);
|
|
use POSIX ();
|
|
|
|
my $opt_pidfile;
|
|
my $opt_stop;
|
|
my $opt_foreground;
|
|
|
|
exit 1 unless GetOptions('pidfile=s' => \$opt_pidfile,
|
|
'stop' => \$opt_stop,
|
|
'foreground' => \$opt_foreground,
|
|
);
|
|
|
|
$opt_pidfile ||= "/var/run/ljstatscasterd.pid";
|
|
|
|
$SIG{TERM} = sub {
|
|
unlink($opt_pidfile);
|
|
exit 1;
|
|
};
|
|
|
|
my $pid;
|
|
if (-e $opt_pidfile) {
|
|
open (PID, $opt_pidfile);
|
|
chomp ($pid = <PID>);
|
|
close PID;
|
|
if ($pid) {
|
|
if ($opt_stop) {
|
|
kill 15, $pid;
|
|
print "Stopped.\n";
|
|
exit;
|
|
}
|
|
if (kill(0,$pid)) {
|
|
die "Already running as pid: $pid\n";
|
|
}
|
|
}
|
|
}
|
|
|
|
if ($opt_stop) {
|
|
print "already stopped.\n";
|
|
exit;
|
|
}
|
|
|
|
require "$ENV{'LJHOME'}/cgi-bin/ljlib.pl";
|
|
|
|
my ($host, $port, $ipaddr, $portaddr, $sock);
|
|
my $TIMEOUT = 1.0; # transmit at least every 1 sec.
|
|
|
|
if ($LJ::FREECHILDREN_BCAST &&
|
|
$LJ::FREECHILDREN_BCAST =~ /^(\S+):(\d+)$/) {
|
|
($host, $port) = ($1, $2);
|
|
} else {
|
|
die "\$LJ::FREECHILDREN_BCAST not defined, nowhere to send";
|
|
}
|
|
|
|
die "Can't write to $opt_pidfile" unless open(PID, ">>$opt_pidfile");
|
|
close PID;
|
|
|
|
unless ($opt_foreground) {
|
|
fork && exit 0;
|
|
POSIX::setsid() or die "Couldn't become session leader: $!";
|
|
fork && exit 0;
|
|
}
|
|
|
|
# Parent, log pid and exit.
|
|
unless (open(PID, ">$opt_pidfile")) {
|
|
die "Couldn't open $opt_pidfile for writing: $!\n";
|
|
}
|
|
print PID $$;
|
|
close(PID);
|
|
print "Started with pid $$\n";
|
|
|
|
unless ($opt_foreground) {
|
|
# Change working dir to the filesystem root, clear the umask
|
|
chdir "/";
|
|
umask 0;
|
|
|
|
# Close standard file descriptors and reopen them to /dev/null
|
|
close STDIN && open STDIN, "</dev/null";
|
|
close STDOUT && open STDOUT, "+>&STDIN";
|
|
close STDERR && open STDERR, "+>&STDIN";
|
|
}
|
|
|
|
$sock = IO::Socket::INET->new(Proto => 'udp');
|
|
$sock->sockopt(SO_BROADCAST, 1);
|
|
$ipaddr = inet_aton($host);
|
|
$portaddr = sockaddr_in($port, $ipaddr);
|
|
|
|
my $insock = IO::Socket::INET->new(Proto=>'udp',
|
|
LocalAddr=>"127.0.0.1:$port");
|
|
or die "couldn't create socket\n";
|
|
$insock->blocking(0);
|
|
|
|
my $sel = IO::Select->new();
|
|
$sel->add($insock);
|
|
|
|
my ($buf, $last_message);
|
|
my $no_servers = 1; # true if there are no servers available
|
|
my $last_send;
|
|
my $last_free;
|
|
|
|
|
|
my ($type, $message);
|
|
|
|
sub transmit {
|
|
#print "transmitting...\n";
|
|
$sock->send($last_message, 0, $portaddr)
|
|
if $last_message;
|
|
}
|
|
|
|
my $MAXLEN = 512;
|
|
SEL:
|
|
while(1) {
|
|
my @ready = $sel->can_read($TIMEOUT);
|
|
unless (@ready) {
|
|
# we got here via a timeout. check to make sure apache-perl
|
|
# is still running before actually deciding to transmit more
|
|
open (PID, "/var/run/apache-perl.pid") or next; # debian-specific
|
|
my $pid = <PID>;
|
|
chomp $pid;
|
|
close PID;
|
|
if (readlink("/proc/$pid/exe") =~ /apache/) {
|
|
transmit();
|
|
}
|
|
next SEL;
|
|
}
|
|
|
|
# assume we shouldn't transmit, until we've decided we should
|
|
my $transmit = 0;
|
|
|
|
# only one handle selected, so we know it's the incoming UDP
|
|
my $message;
|
|
while ($sock->recv($message, $MAXLEN)) {
|
|
$last_message = $message if $message;
|
|
}
|
|
$message = $last_message;
|
|
|
|
$message =~ m!free=(\d+)\n!;
|
|
my $free = $1;
|
|
next SEL if $free == $last_free;
|
|
|
|
$now = time();
|
|
|
|
if (defined $free && $now > $last_send + 0.2) {
|
|
$transmit = 1;
|
|
} elsif (defined $free) {
|
|
my $new_no_servers = ($free == 0);
|
|
if ($no_servers != $new_no_servers) {
|
|
$transmit = 1;
|
|
$no_servers = $new_no_servers;
|
|
}
|
|
} elsif ($message =~ m!shutdown=1!) {
|
|
$transmit = 1;
|
|
}
|
|
|
|
if ($transmit) {
|
|
$last_send = $now;
|
|
$last_free = $free;
|
|
transmit();
|
|
}
|
|
|
|
}
|
|
|