ljr/wcmtools/spud/bin/gatherer

441 lines
14 KiB
Plaintext
Raw Normal View History

2019-02-05 21:49:12 +00:00
#!/usr/bin/perl
#
# Danga's Statistics Gatherer
# Gathers statistics using plugins.
#
# Command line options:
#
# --conf STRING set what config file to use for options
# --server STRING set what server to point at
# --port INT the port of the server to use
# --foreground if present, tell the server to force to the foreground
#
# Configuration file format:
#
# server = STRING location of statistics server
# port = INT port number server listens on
#
# job: plugin(parameter, parameter)
# job2: plugin
# helperplugin(parameter, parameter)
# ...
#
# Copyright 2004, Danga Interactive
#
# Authors:
# Mark Smith <marksmith@danga.com>
#
# License:
# undecided.
#
use strict;
use lib "$ENV{LJHOME}/cgi-bin";
use Getopt::Long;
use POSIX qw(:sys_wait_h);
use Danga::Daemon;
# config
my $path = "$ENV{LJHOME}/bin/spud";
my $plugins_path = "$path/plugins";
# command line config
my %opts;
GetOptions \%opts, qw/ conf=s server=s port=i /;
# reverse mapping; ( pid => job-name )
my %pids;
# mapping of what we expect to die soon
my %todie;
# called if we die
sub fail {
foreach my $pid (keys %pids) {
kill 15, $pid;
}
$_[0] ||= 'no reason provided';
die "shutdown detected: $_[0]\n";
}
# now daemonize
Danga::Daemon::daemonize(
\&worker,
{
interval => 1,
listenport => 13500,
chdir => $path,
shutdowncode => \&fail,
},
);
# ( plugin-name =>
# {
# modtime => int, # last modified time of plugin file (for reload detection)
# children => [ pid, pid, pid, ... ], # pids of workers doing this plugin
# file => str, # filename
# reload => bool, # if on, reload_plugins() will reload this plugin
# registered => bool, # if on, this plugin has registered correctly and is good to go
# code => {
# register => sub { ... },
# worker => sub { ... },
# },
# }
# );
my %plugins;
# ( job-name =>
# {
# plugin => plugin-name,
# respawn_with => plugin-name,
# pid => pid,
# options => [ option, option, option, ... ], # list of options from config file
# reload => bool, # if on, reload_plugins() will reload this job
# active => bool, # if on, this is active per the config file
# }
# );
my %jobs;
# array of plugins that want to help us out; array of [ pluginname, [ opts ] ]
my @helpers;
# cached socket to our stat server
my $sock;
sub set {
# sends a statistic up to the stat server
$sock ||= IO::Socket::INET->new(PeerAddr => $opts{server},
PeerPort => $opts{port},);
fail("can't create socket: $!")
unless $sock;
# send this on up to the server
while (scalar(@_) >= 2) {
$sock->print("QSET $_[0] $_[1]\r\n");
shift @_; shift @_;
}
}
# keeps track of whether or not this is the first worker run
sub worker {
# step 1: check through plugins directory to see what plugins have changed (or are new)
check_plugin_modtimes();
# step 2: check for a changed config file and load/reload as necessary
check_config();
# step 3: now that we know exactly what's changed, call master reloader
reload();
# step 4: run through any defined helpers so they can, well, help
foreach my $helpref (@helpers) {
my ($plugin, $opts) = @$helpref;
next unless $plugins{$plugin} && $plugins{$plugin}->{registered} &&
$plugins{$plugin}->{code}->{helper};
eval {
$plugins{$plugin}->{code}->{helper}->($opts);
};
debug($@) if $@;
}
}
sub check_plugin_modtimes {
opendir DIR, $plugins_path
or fail("Unable to open plugins directory for reading");
foreach my $file (readdir(DIR)) {
next if $file =~ /^\./;
next unless $file =~ /^(.+)\.pl$/;
my $plugin = $1;
# create an empty record if this is the first time we've found this plugin
$plugins{$plugin} ||= {
modtime => 0,
reload => 1,
registered => 0,
children => [],
file => "$plugins_path/$file",
};
# compare modtime and mark for reload if necessary
my $mt = (stat($plugins{$plugin}->{file}))[9];
$plugins{$plugin}->{reload} = 1
if $mt > $plugins{$plugin}->{modtime};
$plugins{$plugin}->{modtime} = $mt;
}
closedir DIR;
}
sub check_config {
fail("Config file not found")
unless -e $opts{conf};
my $mt = (stat($opts{conf}))[9];
$opts{config_modtime} ||= 0;
reload_config()
if $mt > $opts{config_modtime};
$opts{config_modtime} = $mt;
}
sub reload_config {
debug("");
debug("configuration file reloading");
# we mark all jobs as inactive, so they get marked as active below
foreach (keys %jobs) {
$jobs{$_}->{active} = 0
unless $jobs{$_}->{respawn_with};
}
# clear out all helpers, as they should get readded. they aren't in
# separate threads so it doesn't matter if we readd them every time.
@helpers = ();
open FILE, "<$opts{conf}"
or fail("Unable to open config file: $!");
foreach my $line (<FILE>) {
# ignore comments and clean surrounding whitespace
next if $line =~ /^\s*#/;
$line =~ s/^\s+//;
$line =~ s/[\s\r\n]+$//;
next unless length $line;
# shortcut; set some options
if ($line =~ /^(\w+)\s*=\s*(.+)$/) {
$opts{$1} = $2;
next;
}
# extract any options contained in (...) and going to the end of the line
my $optionstr;
if ($line =~ s/(?:\((.*)\))$//) {
$optionstr = $1;
}
my @options =
map { (s/^\s+//, s/\s$//, 1) ? $_ : undef } # now trim whitespace front and back
split(/,/, $optionstr); # split option string on commas
# now see if it has a job + plugin left, or just a plugin
if ($line =~ /^([-\w:.]+)\s*:\s*(\w+)$/) {
# this is a job definition
my ($job, $plugin) = ($1, $2);
fail("Error adding $job to job list")
unless add_job($job, $plugin, \@options);
} elsif ($line =~ /^(\w+)$/) {
# this is just a helper plugin
fail("Plugin $1 not defined")
unless $plugins{$1};
# push name of plugin on helper list
debug("helper from plugin $1 added");
push @helpers, [ $1, \@options ];
} else {
fail("Unknown format: $line($optionstr)");
}
}
close FILE;
debug("configuration file reloaded");
}
# main processor that goes through everything we have and reloads as necessary. this
# also handles reaping our children.
sub reload {
# iterate over any dead children we might have picked up
while ((my $pid = waitpid(-1, WNOHANG)) > 0) {
if (my $job = delete($pids{$pid})) {
if ($jobs{$job}->{active}) {
debug("[$job] dead; pid = $pid; marking to reload; unexpected!");
$jobs{$job}->{reload} = 1;
$jobs{$job}->{pid} = 0;
} else {
debug("[$job] dead; pid = $pid; inactive job, NOT reloading");
delete $jobs{$job};
}
} else {
if (delete $todie{$pid}) {
debug("child death; pid = $pid; expected death, already reloaded");
} else {
debug("ERROR: $pid died but we have no record of it");
}
}
}
# iterate over plugins and reload as necessary
foreach my $plugin (sort keys %plugins) {
next unless $plugins{$plugin}->{reload};
debug("reloading plugin: $plugin");
# now require the file
my $file = $plugins{$plugin}->{file};
unless (my $ret = do $file) {
if ($@) {
warn "couldn't parse $file: $@\n";
} elsif (! defined $ret) {
warn "couldn't do $file: $!\n";
} else {
warn "couldn't run $file\n";
}
next;
}
# now mark any jobs with this plugin to reload
foreach my $job (keys %jobs) {
$jobs{$job}->{reload} = 1
if $jobs{$job}->{plugin} eq $plugin ||
$jobs{$job}->{respawn_with} eq $plugin;
}
}
# now that we know all the plugins are loaded, iterate over jobs so we can get
# the plugins spawned and doing something
foreach my $job (sort keys %jobs) {
my $plugin = $plugins{$jobs{$job}->{plugin}};
fail("can't add job for plugin with no worker code: job = $job; plugin = $jobs{$job}->{plugin}")
unless ref $plugin->{code}->{worker};
# see if we need to kill off this job
unless ($jobs{$job}->{active}) {
debug("killing job: $job");
if ($jobs{$job}->{pid}) {
kill 15, $jobs{$job}->{pid};
} else {
delete $pids{$jobs{$job}->{pid}};
delete $jobs{$job};
}
next;
}
# now, the following path does a reload of this job if necessary
next unless $jobs{$job}->{reload} && $plugin->{registered};
debug("reloading job: $job");
# kill off this child if we had one
if ($jobs{$job}->{pid}) {
kill 15, $jobs{$job}->{pid};
delete $pids{$jobs{$job}->{pid}};
$todie{$jobs{$job}->{pid}} = 1;
debug("[$job] killing child; pid = $jobs{$job}->{pid}");
$jobs{$job}->{pid} = 0;
}
# bust out a child for this job
my $pid = fork;
fail("can't fork child: $!") if !defined $pid;
unless ($pid) {
# child path; do some basic setup and then call the worker
$0 .= " [$jobs{$job}->{plugin}: $job]";
$SIG{INT} = undef; # in case parent is in the foreground
$SIG{TERM} = undef; # no special handling for this
# call the child which should do all the work and return when it's done
$plugin->{code}->{worker}->($job, $jobs{$job}->{options});
# when the above returns, the worker is done, so we exit
exit 0;
}
# if we get here we're a parent, which means we need to mark this child as
# run and that we don't need to do anything more
$jobs{$job}->{pid} = $pid;
$jobs{$job}->{reload} = 0;
$pids{$pid} = $job;
}
}
# called by plugins to let us know that they want to be active. they have to provide a
# certain set of minimum functionality which we use. we also import some things into
# their namespace.
sub register_plugin {
my ($plugin, $package, $opts) = @_;
return unless $plugin && $package && $plugins{$plugin} && $opts;
# make sure they gave us enough functions
unless (ref $opts->{register} && (ref $opts->{worker} || ref $opts->{helper})) {
debug("${plugin} did not provide minimum functionality: register and either worker or helper");
return;
}
# now create some aliases in their package so they can get to debug and set
eval "*${package}::debug = *main::debug;";
eval "*${package}::set = *main::set;";
eval "*${package}::add_job = *main::add_job;";
eval "*${package}::get_var = *main::get_var;";
eval "*${package}::mark_inactive_by_plugin = *main::mark_inactive_by_plugin;";
# call the plugin's register function so that it knows we've acknowledged its presence
unless ($opts->{register}->()) {
debug("${plugin}::register() didn't return true");
return;
}
# done reloading, mark as reloaded (so we don't reload next time)
$plugins{$plugin}->{code} = $opts;
$plugins{$plugin}->{reload} = 0;
$plugins{$plugin}->{registered} = 1;
}
# called by us and by helpers to add jobs to the list. if called by a plugin, $respawn_with
# must be specified and should be set to the name of the plugin. otherwise, this job will
# die the next time the config file is changed.
sub add_job {
my ($job, $plugin, $options, $respawn_with) = @_;
fail("Bad input to add_job: job = $job, plugin = $plugin")
unless $job && $plugin;
$options ||= [];
# now print out debugging info
#debug("found config: $job: $plugin(" . join(', ', @$options) . ")");
# make sure this plugin exists
fail("Plugin $plugin not defined")
unless $plugins{$plugin};
# default %jobs setup
$jobs{$job} ||= {
plugin => $plugin,
pid => 0,
reload => 1,
options => $options,
respawn_with => $respawn_with,
};
$jobs{$job}->{active} = 1; # on unconditionally
# now determine if this job needs reloading
$jobs{$job}->{reload} = 1 unless $jobs{$job}->{pid};
if (scalar(@$options) == scalar(@{$jobs{$job}->{options}})) {
# compare options one by one, reload if any have changed
for (my $i = 0; $i < scalar(@$options); $i++) {
$jobs{$job}->{reload} = 1
if $options->[$i] ne $jobs{$job}->{options}->[$i];
}
} else {
# number of options changed, reload them all
$jobs{$job}->{reload} = 1;
}
# if reload, copy in new options just in case
if ($jobs{$job}->{reload}) {
@{$jobs{$job}->{options}} = @$options;
}
return 1;
}
# called by helpers to mark everything they've spawned as inactive before
# they begin another round of adding jobs. this is basically a way to say
# to the gatherer that a process is dead. if it's not re-added immediately
# by the helper, it gets killed off in the next round of reaping.
sub mark_inactive_by_plugin {
my $plugin = shift;
foreach my $job (keys %jobs) {
$jobs{$job}->{active} = 0
if $jobs{$job}->{respawn_with} eq $plugin;
}
}
# used by plugins to get access to variables set in the config file
sub get_var {
return $opts{$_[0] || ''};
}