457 lines
14 KiB
Perl
457 lines
14 KiB
Perl
#!/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");
|
|
}
|
|
}
|
|
}
|
|
|