hlstatsx/scripts/proxy-daemon.pl

457 lines
14 KiB
Perl
Raw Permalink Normal View History

2013-12-26 00:43:29 +01:00
#!/usr/bin/perl
# HLstatsX Community Edition - Real-time player and clan rankings and statistics
# Copyleft (L) 2008-20XX Nicholas Hastings (nshastings@gmail.com)
# http://www.hlxcommunity.com
#
# HLstatsX Community Edition is a continuation of
# ELstatsNEO - Real-time player and clan rankings and statistics
# Copyleft (L) 2008-20XX Malte Bayer (steam@neo-soft.org)
# http://ovrsized.neo-soft.org/
#
# ELstatsNEO is an very improved & enhanced - so called Ultra-Humongus Edition of HLstatsX
# HLstatsX - Real-time player and clan rankings and statistics for Half-Life 2
# http://www.hlstatsx.com/
# Copyright (C) 2005-2007 Tobias Oetzel (Tobi@hlstatsx.com)
#
# HLstatsX is an enhanced version of HLstats made by Simon Garner
# HLstats - Real-time player and clan rankings and statistics for Half-Life
# http://sourceforge.net/projects/hlstats/
# Copyright (C) 2001 Simon Garner
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
# For support and installation notes visit http://www.hlxcommunity.com
use strict;
use DBI;
use IO::Socket;
use IO::Select;
use Getopt::Long;
use Time::Local;
no strict 'vars';
##
## Settings
##
# $opt_configfile - Absolute path and filename of configuration file.
$opt_configfile = "./hlstats.conf";
# $opt_libdir - Directory to look in for local required files
# (our *.plib, *.pm files).
$opt_libdir = "./";
$heartbeat = 30;
##
##
################################################################################
## No need to edit below this line
##
require "$opt_libdir/ConfigReaderSimple.pm";
do "$opt_libdir/HLstats.plib";
$|=1;
Getopt::Long::Configure ("bundling");
binmode STDIN, ":utf8";
binmode STDOUT, ":utf8";
# Variables
my %srv_list = ();
my ($datagram,$flags);
my $oldtime = (time + $heartbeat);
$usage = <<EOT
Usage: hlstats.pl [OPTION]...
Collect statistics from one or more Half-Life2 servers for distribution
to sub-daemons (hlstats.pl).
-h, --help display this help and exit
-d, --debug enable debugging output (-dd for more)
-c, --configfile Specific configfile to use, settings in this file can't
be overided with commandline settings.
HLstatsX: Community Edition http://www.hlxcommunity.com
EOT
;
# Read Config File
if ($opt_configfile && -r $opt_configfile) {
$conf = ConfigReaderSimple->new($opt_configfile);
$conf->parse();
%directives = (
"DBHost", "db_host",
"DBUsername", "db_user",
"DBPassword", "db_pass",
"DBName", "db_name",
"BindIP", "s_ip",
"Port", "proxy_port",
"DebugLevel", "g_debug",
);
&doConf($conf, %directives);
} else {
&printEvent("CONFIG", "-- Warning: unable to open configuration file '$opt_configfile'", 1);
}
# Read Command Line Arguments
GetOptions(
"help|h" => \$opt_help,
"configfile|c=s" => \$configfile,
"debug|d+" => \$g_debug
) or die($usage);
if ($opt_help) {
print $usage;
exit(0);
}
if ($configfile && -r $configfile) {
$conf = '';
$conf = ConfigReaderSimple->new($configfile);
$conf->parse();
&doConf($conf, %directives);
}
#
# assignDaemon(string ipaddr, string ipport, hash daemon, hash srv_list)
#
# Round-Robin kind of way of spreading the load to different daemons.
#
sub assignDaemon
{
my ($ipaddr, $ipport, $daemon, $srv_list) = @_;
my $next = "";
if (defined($$srv_list{'rr-next'})) {
$next = $$srv_list{'rr-next'};
} else {
$next = 0;
}
my $max = keys %$daemon;
if (!defined($$srv_list{$ipaddr}{$ipport})) {
if ($next eq $max) {
$next = 1;
} else {
$next++;
}
$$srv_list{'rr-next'} = $next;
$$srv_list{$ipaddr}{$ipport}{'dest_ip'} = $$daemon{$next}{'ip'};
$$srv_list{$ipaddr}{$ipport}{'dest_port'} = $$daemon{$next}{'port'};
}
return;
}
#
# checkHeartbeat (hash daemon, string proxy_key)
#
# Prints and update the state of the perl daemons, if they are up or not.
#
sub checkHeartbeat
{
my ($daemon, $proxy_key) = @_;
my $state = '';
foreach my $key (keys(%$daemon)) {
my $value = $$daemon{$key};
my $socket = IO::Socket::INET->new( Proto=>"udp",
PeerHost=>$$daemon{$key}{'ip'},
PeerPort=>$$daemon{$key}{'port'}
);
$packet = "C;HEARTBEAT;";
$socket->send("PROXY Key=$proxy_key PROXY $packet");
if(IO::Select->new($socket)->can_read(4)) { # 4 second timeout
$socket->recv($msg,1024);
if ($msg =~ /Heartbeat OK/) {
$state = "up";
} else {
$state = "down";
}
}
if ($$daemon{$key}{'curstate'} eq "") {
$$daemon{$key}{'curstate'} = "n/a";
}
$$daemon{$key}{'oldstate'} = $$daemon{$key}{'curstate'};
$$daemon{$key}{'curstate'} = $state;
&printEvent("HEARTBEAT", "Sending HB to $$daemon{$key}{'ip'}:$$daemon{$key}{'port'}... state: $$daemon{$key}{'curstate'} (old: $$daemon{$key}{'oldstate'})", 1);
$state = '';
}
return;
}
#
# string retunrServerList(hash srv_list)
#
# Return a list of servers to requestor (udp package C;SERVERLIST).
#
sub returnServerList
{
my ($srv_list) = @_;
#$srv_list{$ipaddr}{$ipport}{'dest_ip'}
for my $ip (keys(%srv_list)) {
for my $port (keys(%{$srv_list{$ip}})) {
$msg = $msg . "$ip:$port -> $srv_list{$ip}{$port}{'dest_ip'}:$srv_list{$ip}{$port}{'dest_port'}\n";
}
}
return $msg;
}
#
# string theTime(int sec, int min, int hour, int mday, int year, int wday, int yday, int isdst)
#
# Makes a pretty timestampformat to output
#
sub theTime
{
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$year = $year + 1900;
$mon = $mon + 1;
if ($mon <= 9) { $mon = "0$mon"; }
if ($mday <= 9) { $mday = "0$mday"; }
if ($hour <= 9) { $hour = "0$hour"; }
if ($min <= 9) { $min = "0$min"; }
if ($sec <= 9) { $sec = "0$sec"; }
my $time = "[$year-$mon-$mday $hour:$min:$sec] ";
return $time;
}
#
# string reloadDaemon(hash daemon, string proxy_key)
#
# Sends reload package to all daemons specified in hlstats.Options.Proxy_Daemons
#
sub reloadDaemon
{
my ($daemon, $proxy_key) = @_;
my $fake_ip = "127.0.0.1";
my $fake_port = "30000";
my $msg = '';
$packet = "C;RELOAD;";
foreach my $key (keys(%$daemon)) {
if ($$daemon{$key}{'curstate'} eq "up") {
&printEvent("CONTROL", "Sending RELOAD packet to $$daemon{$key}{'ip'}:$$daemon{$key}{'port'}", 1);
$msg = $msg . &theTime() . "Sending RELOAD packet to $daemon{$key}{'ip'}:$daemon{$key}{'port'}\n";
# Sedning actual message to the daemon.
my $cmd = IO::Socket::INET->new( Proto=>"udp",
PeerHost=>$$daemon{$key}{'ip'},
PeerPort=>$$daemon{$key}{'port'}
);
$cmd->send("PROXY Key=$proxy_key PROXY $packet");
}
}
return $msg;
}
#
# string getProxyKey ()
#
# Get the value for Proxy_Key
#
sub getProxyKey
{
my $query = "SELECT `value` FROM hlstats_Options WHERE `keyname` = 'Proxy_Key'";
my $result = &doQuery($query);
my ($proxy_key) = $result->fetchrow_array;
$result->finish;
return $proxy_key;
}
sub is_number ($) { ( $_[0] ^ $_[0] ) eq '0' }
############## Main program ##############
$g_stdin = 0;
# Connect yo mysql DB to get required settings
&doConnect();
my $proxy_key = &getProxyKey();
# Get the daemons you will use
$query = "SELECT `value` FROM hlstats_Options WHERE `keyname` = 'Proxy_Daemons'";
$result = &doQuery($query);
my ($daemonlist) = $result->fetchrow_array;
$result->finish;
my @proxy_daemons = split(/,/, $daemonlist);
my $total_daemons = scalar(@proxy_daemons);
my %daemon = ();
my $i = 1;
while ($i <= $total_daemons) {
($daemon{$i}{'ip'}, $daemon{$i}{'port'}) = split(/:/, $proxy_daemons[$i-1]);
$daemon{$i}{'oldstate'} = "";
$daemon{$i}{'curstate'} = "";
$i++;
}
# Setting up the proxy port to listen on.
my $server = IO::Socket::INET->new( LocalPort=>$proxy_port,
Proto=>"udp"
) or die "Can't create UDP server: $@";
# It went ok, lets start recive messages...
&printEvent("DAEMON", "HlstatsX Proxy Daemon up and running on port: $proxy_port, key: $proxy_key", 1);
# Do initial heartbeat check.
&checkHeartbeat(\%daemon, $proxy_key);
# Reload all child daemons config
&reloadDaemon(\%daemon, $proxy_key);
while ($server->recv($datagram,1024,$flags)) {
my $control = 0;
# Checks the subdaemons every 30 sec if they are alive.
# the interval can be changed by modify $heartbeat value in beginning of script.
if (time > $oldtime) {
&checkHeartbeat(\%daemon, $proxy_key);
$oldtime = (time + $heartbeat);
}
my $ipaddr = $server->peerhost;
my $ipport = $server->peerport;
if ($ipaddr eq "127.0.0.1" && $datagram =~/C;HEARTBEAT;/) {
$control = 1;
$msg = '';
$msg = "Heartbeat OK";
&printEvent("CONTROL", "Sending Heartbeat to $ipaddr:$ipport", 1);
} elsif ($ipaddr eq "127.0.0.1" && $datagram =~/C;SERVERLIST;/) {
$control = 1;
$msg = '';
$msg = returnServerList($srv_list);
$msg = "ServerList\n$msg";
&printEvent("CONTROL", "Sending Serverlist to $ipaddr:$ipport", 1);
} elsif ($ipaddr eq "127.0.0.1" && $datagram =~/C;RELOAD;/) {
$control = 1;
$msg = '';
$msg = &reloadDaemon($daemon);
}
if ($ipaddr eq "127.0.0.1" && $control == 1) {
# Sending actual message to the daemon.
my $dest = sockaddr_in($ipport, inet_aton($ipaddr));
my $bytes = send($server, $msg, 0, $dest);
next;
}
if ($datagram =~ /PROXY Key=(.+) (.*)PROXY (.+)/) {
if ($proxy_key eq $1) {
if ($3 =~ /C;HEARTBEAT;/) {
$msg = '';
$msg = "Heartbeat OK";
&printEvent("CONTROL", "Sending Heartbeat to $ipaddr:$ipport", 1);
} elsif ($3 =~ /C;SERVERLIST;/) {
$msg = '';
$msg = returnServerList($srv_list);
$msg = "ServerList\n$msg";
&printEvent("CONTROL", "Sending Serverlist to $ipaddr:$ipport", 1);
&printEvent("CONTROL", $msg, 1);
} elsif ($3 =~ /C;RELOAD;/) {
$msg = '';
$msg = &reloadDaemon($daemon);
}
} else {
$msg = "FAILED PROXY REQUEST ($ipaddr:$ipport)\n";
&printEvent("E403", "Sending FAILED PROXY REQUEST to $ipaddr:$ipport", 1);
}
# Sedning actual message to the daemon.
my $dest = sockaddr_in($ipport, inet_aton($ipaddr));
my $bytes = send($server, $msg, 0, $dest);
next;
}
if (defined($srv_list{$ipaddr}{$ipport})) {
# Check the oldstate, curstate of your logging daemon
foreach my $key (keys %daemon) {
if ($srv_list{$ipaddr}{$ipport}{'dest_ip'} eq $daemon{$key}{'ip'} && $srv_list{$ipaddr}{$ipport}{'dest_port'} eq $daemon{$key}{'port'}) {;
if ($daemon{$key}{'curstate'} eq "up" && $daemon{$key}{'oldstate'} eq "down") {
# Recovering, should do a reload of some kind here.
%srv_list = ();
} elsif ($daemon{$key}{'curstate'} eq "down" && $daemon{$key}{'oldstate'} eq "up") {
# Daemon died, assing a new daemon to server
delete $srv_list{$ipaddr}{$ipport};
($daemon, $srv_list) = &assignDaemon($ipaddr, $ipport, $daemon, $srv_list);
&printEvent("BALANCE", "down - up: Re-Assing daemon $srv_list{$ipaddr}{$ipport}{'dest_ip'}:$srv_list{$ipaddr}{$ipport}{'dest_port'} to $ipaddr:$ipport", 1);
} elsif ($daemon{$key}{'curstate'} eq "down" && $daemon{$key}{'oldstate'} eq "down") {
# DOWN, should already reassinged the daemon.
delete $srv_list{$ipaddr}{$ipport};
($daemon, $srv_list) = &assignDaemon($ipaddr, $ipport, $daemon, $srv_list);
&printEvent("BALANCE", "down-down: Re-Assing daemon $srv_list{$ipaddr}{$ipport}{'dest_ip'}:$srv_list{$ipaddr}{$ipport}{'dest_port'} to $ipaddr:$ipport", 1);
} elsif ($daemon{$key}{'curstate'} eq "down" && $daemon{$key}{'oldstate'} eq "n/a") {
# Daemon down when we started proxy, assing another daemon.
delete $srv_list{$ipaddr}{$ipport};
($daemon, $srv_list) = &assignDaemon($ipaddr, $ipport, $daemon, $srv_list);
&printEvent("BALANCE", "down - na: Assing daemon $srv_list{$ipaddr}{$ipport}{'dest_ip'}:$srv_list{$ipaddr}{$ipport}{'dest_port'} to $ipaddr:$ipport from down/na", 1);
}
}
}
} else {
# Assign a logging daemon for your server:port
delete $srv_list{$ipaddr}{$ipport};
&assignDaemon($ipaddr, $ipport, \%daemon, \%srv_list);
&printEvent("BALANCE", "Assing daemon $srv_list{$ipaddr}{$ipport}{'dest_ip'}:$srv_list{$ipaddr}{$ipport}{'dest_port'} to $ipaddr:$ipport", 1);
}
if ($datagram =~ /.*rcon from.*: command "status".*/ || $datagram =~ /.*rcon from.*: command "stats".*/ || $datagram =~ /.*rcon from.*: command "".*/) {
# skip messages that looks like this, to ease the load on the sub daemons alittle
&printEvent("NOTICE", "Skipping message...", 1) if ($g_debug > 1);
} else {
if (defined($srv_list{$ipaddr}{$ipport}{'dest_ip'}) && defined($srv_list{$ipaddr}{$ipport}{'dest_port'})) {
$datagram =~ s/^.*RL /RL /g;
&printEvent("NOTICE", "Sending $datagram to daemon $srv_list{$ipaddr}{$ipport}{'dest_ip'}:$srv_list{$ipaddr}{$ipport}{'dest_port'}", 1) if ($g_debug > 1);
# Sedning actual message to the daemon.
my $forward = IO::Socket::INET->new( Proto=>"udp",
PeerHost=>$srv_list{$ipaddr}{$ipport}{'dest_ip'},
PeerPort=>$srv_list{$ipaddr}{$ipport}{'dest_port'}
);
$forward->send("PROXY Key=$proxy_key $ipaddr:".$ipport."PROXY $datagram");
}
}
}