/scripts/hlstats.pl
Perl | 3626 lines | 3011 code | 327 blank | 288 comment | 469 complexity | 5eb88865da775b19ae0d23a2257d33e4 MD5 | raw file
Possible License(s): GPL-2.0
Large files files are truncated, but you can click here to view the full file
- #!/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;
- no strict 'vars';
- $SIG{HUP} = 'HUP_handler';
- $SIG{INT} = 'INT_handler'; # unix
- $SIG{INT2} = 'INT_handler'; # windows
- ##
- ## 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 = "./";
- ##
- ##
- ################################################################################
- ## No need to edit below this line
- ##
- use Getopt::Long;
- use Time::Local;
- use IO::Socket;
- use IO::Select;
- use DBI;
- use Digest::MD5;
- use Encode;
- use bytes;
- require "$opt_libdir/ConfigReaderSimple.pm";
- require "$opt_libdir/TRcon.pm";
- require "$opt_libdir/BASTARDrcon.pm";
- require "$opt_libdir/HLstats_Server.pm";
- require "$opt_libdir/HLstats_Player.pm";
- require "$opt_libdir/HLstats_Game.pm";
- do "$opt_libdir/HLstats_GameConstants.plib";
- do "$opt_libdir/HLstats.plib";
- do "$opt_libdir/HLstats_EventHandlers.plib";
- $|=1;
- Getopt::Long::Configure ("bundling");
- $last_trend_timestamp = 0;
- binmode STDIN, ":utf8";
- binmode STDOUT, ":utf8";
- ##
- ## Functions
- ##
- sub lookupPlayer
- {
- my ($saddr, $id, $uniqueid) = @_;
- if (defined($g_servers{$saddr}->{"srv_players"}->{"$id/$uniqueid"}))
- {
- return $g_servers{$saddr}->{"srv_players"}->{"$id/$uniqueid"};
- }
- return undef;
- }
- sub removePlayer
- {
- my ($saddr, $id, $uniqueid, $dontUpdateCount) = @_;
- my $deleteplayer = 0;
- if(defined($g_servers{$saddr}->{"srv_players"}->{"$id/$uniqueid"}))
- {
- $deleteplayer = 1;
- }
- else
- {
- &::printEvent("400", "Bad attempted delete ($saddr) ($id/$uniqueid)");
- }
- if ($deleteplayer == 1) {
- $g_servers{$saddr}->{"srv_players"}->{"$id/$uniqueid"}->playerCleanup();
- delete($g_servers{$saddr}->{"srv_players"}->{"$id/$uniqueid"});
- if (!$dontUpdateCount) # double negative, i know...
- {
- $g_servers{$saddr}->updatePlayerCount();
- }
- }
- }
- sub checkBonusRound
- {
- if ($g_servers{$s_addr}->{bonusroundtime} > 0 && ($::ev_remotetime > ($g_servers{$s_addr}->{bonusroundtime_ts} + $g_servers{$s_addr}->{bonusroundtime}))) {
- if ($g_servers{$s_addr}->{bonusroundtime_state} == 1) {
- &printEvent("SERVER", "Bonus Round Expired",1);
- }
- $g_servers{$s_addr}->set("bonusroundtime_state",0);
- }
-
- if($g_servers{$s_addr}->{bonusroundignore} == 1 && $g_servers{$s_addr}->{bonusroundtime_state} == 1) {
- return 1;
- }
- return 0;
- }
- sub is_number ($) { ( $_[0] ^ $_[0] ) eq '0' }
- #
- # void printNotice (string notice)
- #
- # Prins a debugging notice to stdout.
- #
- sub printNotice
- {
- my ($notice) = @_;
-
- if ($g_debug > 1) {
- print ">> $notice\n";
- }
- }
- sub track_hlstats_trend
- {
- if ($last_trend_timestamp > 0) {
- if ($last_trend_timestamp+299 < $ev_daemontime) {
- my $query = "
- SELECT
- COUNT(*),
- a.game
- FROM
- hlstats_Players a
- INNER JOIN
- (
- SELECT
- game
- FROM
- hlstats_Servers
- GROUP BY
- game
- ) AS b
- ON
- a.game = b.game
- GROUP BY
- a.game
- ";
- my $result = &execCached("get_total_player_counts", $query);
- my $insvalues = "";
- while ( my($total_players, $game) = $result->fetchrow_array) {
- my $query = "
- SELECT
- SUM(kills),
- SUM(headshots),
- COUNT(serverId),
- SUM(act_players),
- SUM(max_players)
- FROM
- hlstats_Servers
- WHERE
- game=?
- ";
- my $data = &execCached("get_game_stat_counts", $query, "eSQL($game));
- my ($total_kills, $total_headshots, $total_servers, $act_slots, $max_slots) = $data->fetchrow_array;
- if ($max_slots > 0) {
- if ($act_slots > $max_slots) {
- $act_slots = $max_slots;
- }
- }
- if ($insvalues ne "") {
- $insvalues .= ",";
- }
- $insvalues .= "
- (
- $ev_daemontime,
- '"."eSQL($game)."',
- $total_players,
- $total_kills,
- $total_headshots,
- $total_servers,
- $act_slots,
- $max_slots
- )
- ";
- }
- if ($insvalues ne "") {
- &execNonQuery("
- INSERT INTO
- hlstats_Trend
- (
- timestamp,
- game,
- players,
- kills,
- headshots,
- servers,
- act_slots,
- max_slots
- )
- VALUES $insvalues
- ");
- }
- $last_trend_timestamp = $ev_daemontime;
- &::printEvent("HLSTATSX", "Insert new server trend timestamp", 1);
- }
- } else {
- $last_trend_timestamp = $ev_daemontime;
- }
- }
- sub send_global_chat
- {
- my ($message) = @_;
- while( my($server) = each(%g_servers))
- {
- if ($server ne $s_addr && $g_servers{$server}->{"srv_players"})
- {
- my @userlist;
- my %players_temp=%{$g_servers{$server}->{"srv_players"}};
- my $pcount = scalar keys %players_temp;
-
- if ($pcount > 0) {
- while ( my($pl, $b_player) = each(%players_temp) ) {
- my $b_userid = $b_player->{userid};
- if ($g_global_chat == 2) {
- my $b_steamid = $b_player->{uniqueid};
- if ($g_servers{$server}->is_admin($b_steamid) == 1) {
- if (($b_player->{display_events} == 1) && ($b_player->{display_chat} == 1)) {
- push(@userlist, $b_player->{userid});
- }
- }
- } else {
- if (($b_player->{display_events} == 1) && ($b_player->{display_chat} == 1)) {
- push(@userlist, $b_player->{userid});
- }
- }
- }
- $g_servers{$server}->messageMany($message, 0, @userlist);
- }
- }
- }
- }
- #
- # void buildEventInsertData ()
- #
- # Ran at startup to init event table queues, build initial queries, and set allowed-null columns
- #
- my %g_eventtable_data = ();
- sub buildEventInsertData
- {
- my $insertType = "";
- $insertType = " DELAYED" if ($db_lowpriority);
- while ( my ($table, $colsref) = each(%g_eventTables) )
- {
- $g_eventtable_data{$table}{queue} = [];
- $g_eventtable_data{$table}{nullallowed} = 0;
- $g_eventtable_data{$table}{lastflush} = $ev_daemontime;
- $g_eventtable_data{$table}{query} = "
- INSERT$insertType INTO
- hlstats_Events_$table
- (
- eventTime,
- serverId,
- map"
- ;
- my $j = 0;
- foreach $i (@{$colsref})
- {
- $g_eventtable_data{$table}{query} .= ",\n$i";
- if (substr($i, 0, 4) eq 'pos_') {
- $g_eventtable_data{$table}{nullallowed} |= (1 << $j);
- }
- $j++;
- }
- $g_eventtable_data{$table}{query} .= ") VALUES\n";
- }
- }
- #
- # void recordEvent (string table, array cols, bool getid, [mixed eventData ...])
- #
- # Queues an event for addition to an Events table, flushing when hitting table queue limit.
- #
- sub recordEvent
- {
- my $table = shift;
- my $unused = shift;
- my @coldata = @_;
-
- my $value = "(FROM_UNIXTIME($::ev_unixtime),".$g_servers{$s_addr}->{'id'}.",'".quoteSQL($g_servers{$s_addr}->get_map())."'";
- $j = 0;
- for $i (@coldata) {
- if ($g_eventtable_data{$table}{nullallowed} & (1 << $j) && (!defined($i) || $i eq "")) {
- $value .= ",NULL";
- } elsif (!defined($i)) {
- $value .= ",''";
- } else {
- $value .= ",'".quoteSQL($i)."'";
- }
- $j++;
- }
- $value .= ")";
-
- push(@{$g_eventtable_data{$table}{queue}}, $value);
-
- if (scalar(@{$g_eventtable_data{$table}{queue}}) > $g_event_queue_size)
- {
- flushEventTable($table);
- }
- }
- sub flushEventTable
- {
- my ($table) = @_;
-
- if (scalar(@{$g_eventtable_data{$table}{queue}}) == 0)
- {
- return;
- }
-
- my $query = $g_eventtable_data{$table}{query};
- foreach (@{$g_eventtable_data{$table}{queue}})
- {
- $query .= $_.",";
- }
- $query =~ s/,$//;
- execNonQuery($query);
- $g_eventtable_data{$table}{lastflush} = $ev_daemontime;
- $g_eventtable_data{$table}{queue} = [];
- }
- #
- # array calcSkill (int skill_mode, int killerSkill, int killerKills, int victimSkill, int victimKills, string weapon)
- #
- # Returns an array, where the first index contains the killer's new skill, and
- # the second index contains the victim's new skill.
- #
- sub calcSkill
- {
- my ($skill_mode, $killerSkill, $killerKills, $victimSkill, $victimKills, $weapon, $killerTeam) = @_;
- my @newSkill;
-
- # ignored bots never do a "comeback"
- return ($g_skill_minchange, $victimSkill) if ($killerSkill < 1);
- return ($killerSkill + $g_skill_minchange, $victimSkill) if ($victimSkill < 1);
-
- if ($g_debug > 2) {
- &printNotice("Begin calcSkill: killerSkill=$killerSkill");
- &printNotice("Begin calcSkill: victimSkill=$victimSkill");
- }
- my $modifier = 1.00;
- # Look up the weapon's skill modifier
- if (defined($g_games{$g_servers{$s_addr}->{game}}{weapons}{$weapon})) {
- $modifier = $g_games{$g_servers{$s_addr}->{game}}{weapons}{$weapon}{modifier};
- }
- # Calculate the new skills
-
- my $killerSkillChange = 0;
- if ($g_skill_ratio_cap > 0) {
- # SkillRatioCap, from *XYZ*SaYnt
- #
- # dgh...we want to cap the ratio between the victimkill and killerskill. For example, if the number 1 player
- # kills a newbie, he gets 1000/5000 * 5 * 1 = 1 points. If gets killed by the newbie, he gets 5000/1000 * 5 *1
- # = -25 points. Not exactly fair. To fix this, I'm going to cap the ratio to 1/2 and 2/1.
- # these numbers are designed such that an excellent player will have to get about a 2:1 ratio against noobs to
- # hold steady in points.
- my $lowratio = 0.7;
- my $highratio = 1.0 / $lowratio;
- my $ratio = ($victimSkill / $killerSkill);
- if ($ratio < $lowratio) { $ratio = $lowratio; }
- if ($ratio > $highratio) { $ratio = $highratio; }
- $killerSkillChange = $ratio * 5 * $modifier;
- } else {
- $killerSkillChange = ($victimSkill / $killerSkill) * 5 * $modifier;
- }
- if ($killerSkillChange > $g_skill_maxchange) {
- &printNotice("Capping killer skill change of $killerSkillChange to $g_skill_maxchange") if ($g_debug > 2);
- $killerSkillChange = $g_skill_maxchange;
- }
-
- my $victimSkillChange = $killerSkillChange;
- if ($skill_mode == 1)
- {
- $victimSkillChange = $killerSkillChange * 0.75;
- }
- elsif ($skill_mode == 2)
- {
- $victimSkillChange = $killerSkillChange * 0.5;
- }
- elsif ($skill_mode == 3)
- {
- $victimSkillChange = $killerSkillChange * 0.25;
- }
- elsif ($skill_mode == 4)
- {
- $victimSkillChange = 0;
- }
- elsif ($skill_mode == 5)
- {
- #Zombie Panic: Source only
- #Method suggested by heimer. Survivor's lose half of killer's gain when dying, but Zombie's only lose a quarter.
- if ($killerTeam eq "Undead")
- {
- $victimSkillChange = $killerSkillChange * 0.5;
- }
- elsif ($killerTeam eq "Survivor")
- {
- $victimSkillChange = $killerSkillChange * 0.25;
- }
- }
-
- if ($victimSkillChange > $g_skill_maxchange) {
- &printNotice("Capping victim skill change of $victimSkillChange to $g_skill_maxchange") if ($g_debug > 2);
- $victimSkillChange = $g_skill_maxchange;
- }
-
- if ($g_skill_maxchange >= $g_skill_minchange) {
- if ($killerSkillChange < $g_skill_minchange) {
- &printNotice("Capping killer skill change of $killerSkillChange to $g_skill_minchange") if ($g_debug > 2);
- $killerSkillChange = $g_skill_minchange;
- }
-
- if (($victimSkillChange < $g_skill_minchange) && ($skill_mode != 4)) {
- &printNotice("Capping victim skill change of $victimSkillChange to $g_skill_minchange") if ($g_debug > 2);
- $victimSkillChange = $g_skill_minchange;
- }
- }
- if (($killerKills < $g_player_minkills ) || ($victimKills < $g_player_minkills )) {
- $killerSkillChange = $g_skill_minchange;
- if ($skill_mode != 4) {
- $victimSkillChange = $g_skill_minchange;
- } else {
- $victimSkillChange = 0;
- }
- }
-
- $killerSkill += $killerSkillChange;
- $victimSkill -= $victimSkillChange;
-
- # we want int not float
- $killerSkill = sprintf("%d", $killerSkill + 0.5);
- $victimSkill = sprintf("%d", $victimSkill + 0.5);
-
- if ($g_debug > 2) {
- &printNotice("End calcSkill: killerSkill=$killerSkill");
- &printNotice("End calcSkill: victimSkill=$victimSkill");
- }
- return ($killerSkill, $victimSkill);
- }
- sub calcL4DSkill
- {
- my ($killerSkill, $weapon, $difficulty) = @_;
-
- # ignored bots never do a "comeback"
- #return ($killerSkill, $victimSkill) if ($killerSkill < 1);
- #return ($killerSkill, $victimSkill) if ($victimSkill < 1);
-
- if ($g_debug > 2) {
- &printNotice("Begin calcSkill: killerSkill=$killerSkill");
- &printNotice("Begin calcSkill: victimSkill=$victimSkill");
- }
- my $modifier = 1.00;
- # Look up the weapon's skill modifier
- if (defined($g_games{$g_servers{$s_addr}->{game}}{weapons}{$weapon})) {
- $modifier = $g_games{$g_servers{$s_addr}->{game}}{weapons}{$weapon}{modifier};
- }
-
- # Calculate the new skills
-
- $diffweight=0.5;
- if ($difficulty > 0) {
- $diffweight = $difficulty / 2;
- }
-
- my $killerSkillChange = $pointvalue * $diffweight;
- if ($killerSkillChange > $g_skill_maxchange) {
- &printNotice("Capping killer skill change of $killerSkillChange to $g_skill_maxchange") if ($g_debug > 2);
- $killerSkillChange = $g_skill_maxchange;
- }
- if ($g_skill_maxchange >= $g_skill_minchange) {
- if ($killerSkillChange < $g_skill_minchange) {
- &printNotice("Capping killer skill change of $killerSkillChange to $g_skill_minchange") if ($g_debug > 2);
- $killerSkillChange = $g_skill_minchange;
- }
- }
-
- $killerSkill += $killerSkillChange;
- # we want int not float
- $killerSkill = sprintf("%d", $killerSkill + 0.5);
-
- if ($g_debug > 2) {
- &printNotice("End calcSkill: killerSkill=$killerSkill");
- }
-
- return $killerSkill;
- }
- # Gives members of 'team' an extra 'reward' skill points. Members of the team
- # who have been inactive (no events) for more than 2 minutes are not rewarded.
- #
- sub rewardTeam
- {
- my ($team, $reward, $actionid, $actionname, $actioncode) = @_;
- $rcmd = $g_servers{$s_addr}->{broadcasting_command};
-
- my $player;
-
- &printNotice("Rewarding team \"$team\" with \"$reward\" skill for action \"$actionid\" ...");
- my @userlist;
- foreach $player (values(%g_players)) {
- my $player_team = $player->{team};
- my $player_timestamp = $player->{timestamp};
- if (($g_servers{$s_addr}->{ignore_bots} == 1) && (($player->{is_bot} == 1) || ($player->{userid} <= 0))) {
- $desc = "(IGNORED) BOT: ";
- } else {
- if ($player_team eq $team) {
- if ($g_debug > 2) {
- &printNotice("Rewarding " . $player->getInfoString() . " with \"$reward\" skill for action \"$actionid\"");
- }
-
- &recordEvent(
- "TeamBonuses", 0,
- $player->{playerid},
- $actionid,
- $reward
- );
- $player->increment("skill", $reward, 1);
- $player->increment("session_skill", $reward, 1);
- $player->updateDB();
- }
- if ($player->{is_bot} == 0 && $player->{userid} > 0 && $player->{display_events} == 1) {
- push(@userlist, $player->{userid});
- }
- }
- }
- if (($g_servers{$s_addr}->{broadcasting_events} == 1) && ($g_servers{$s_addr}->{broadcasting_player_actions} == 1)) {
- my $coloraction = $g_servers{$s_addr}->{format_action};
- my $verb = "got";
- if ($reward < 0) {
- $verb = "lost";
- }
- my $msg = sprintf("%s %s %s points for %s%s", $team, $verb, abs($reward), $coloraction, $actionname);
- $g_servers{$s_addr}->messageMany($msg, 0, @userlist);
- }
- }
- #
- # int getPlayerId (uniqueId)
- #
- # Looks up a player's ID number, from their unique (WON) ID. Returns their PID.
- #
- sub getPlayerId
- {
- my ($uniqueId) = @_;
- my $query = "
- SELECT
- playerId
- FROM
- hlstats_PlayerUniqueIds
- WHERE
- uniqueId='" . &::quoteSQL($uniqueId) . "' AND
- game='" . $g_servers{$s_addr}->{game} . "'
- ";
- my $result = &doQuery($query);
- if ($result->rows > 0) {
- my ($playerId) = $result->fetchrow_array;
- $result->finish;
- return $playerId;
- } else {
- $result->finish;
- return 0;
- }
- }
- #
- # int updatePlayerProfile (object player, string field, string value)
- #
- # Updates a player's profile information in the database.
- #
- sub updatePlayerProfile
- {
- my ($player, $field, $value) = @_;
- $rcmd = $g_servers{$s_addr}->{player_command};
-
- unless ($player) {
- &printNotice("updatePlayerInfo: Bad player");
- return 0;
- }
- $value = "eSQL($value);
- if ($value eq "none" || $value eq " ") {
- $value = "";
- }
-
- my $playerName = &abbreviate($player->{name});
- my $playerId = $player->{playerid};
- &execNonQuery("
- UPDATE
- hlstats_Players
- SET
- $field='$value'
- WHERE
- playerId=$playerId
- ");
-
- if ($g_servers{$s_addr}->{player_events} == 1) {
- my $p_userid = $g_servers{$s_addr}->format_userid($player->{userid});
- my $p_is_bot = $player->{is_bot};
- $cmd_str = $rcmd." $p_userid ".$g_servers{$s_addr}->quoteparam("SET command successful for '$playerName'.");
- $g_servers{$s_addr}->dorcon($cmd_str);
- }
- return 1;
- }
- #
- # mixed getClanId (string name)
- #
- # Looks up a player's clan ID from their name. Compares the player's name to tag
- # patterns in hlstats_ClanTags. Patterns look like: [AXXXXX] (matches 1 to 6
- # letters inside square braces, e.g. [ZOOM]Player) or =\*AAXX\*= (matches
- # 2 to 4 letters between an equals sign and an asterisk, e.g. =*RAGE*=Player).
- #
- # Special characters in the pattern:
- # A matches one character (i.e. a character is required)
- # X matches zero or one characters (i.e. a character is optional)
- # a matches literal A or a
- # x matches literal X or x
- #
- # If no clan exists for the tag, it will be created. Returns the clan's ID, or
- # 0 if the player is not in a clan.
- #
- sub getClanId
- {
- my ($name) = @_;
- my $clanTag = "";
- my $clanName = "";
- my $clanId = 0;
- my $result = &doQuery("
- SELECT
- pattern,
- position,
- LENGTH(pattern) AS pattern_length
- FROM
- hlstats_ClanTags
- ORDER BY
- pattern_length DESC,
- id
- ");
-
- while ( my($pattern, $position) = $result->fetchrow_array) {
- my $regpattern = quotemeta($pattern);
- $regpattern =~ s/([A-Za-z0-9]+[A-Za-z0-9_-]*)/\($1\)/; # to find clan name from tag
- $regpattern =~ s/A/./g;
- $regpattern =~ s/X/.?/g;
-
- if ($g_debug > 2) {
- &printNotice("regpattern=$regpattern");
- }
-
- if ((($position eq "START" || $position eq "EITHER") && $name =~ /^($regpattern).+/i) ||
- (($position eq "END" || $position eq "EITHER") && $name =~ /.+($regpattern)$/i)) {
-
- if ($g_debug > 2) {
- &printNotice("pattern \"$regpattern\" matches \"$name\"! 1=\"$1\" 2=\"$2\"");
- }
-
- $clanTag = $1;
- $clanName = $2;
- last;
- }
- }
-
- unless ($clanTag) {
- return 0;
- }
- my $query = "
- SELECT
- clanId
- FROM
- hlstats_Clans
- WHERE
- tag='" . "eSQL($clanTag) . "' AND
- game='$g_servers{$s_addr}->{game}'
- ";
- $result = &doQuery($query);
- if ($result->rows) {
- ($clanId) = $result->fetchrow_array;
- $result->finish;
- return $clanId;
- } else {
- # The clan doesn't exist yet, so we create it.
- $query = "
- REPLACE INTO
- hlstats_Clans
- (
- tag,
- name,
- game
- )
- VALUES
- (
- '" . "eSQL($clanTag) . "',
- '" . "eSQL($clanName) . "',
- '"."eSQL($g_servers{$s_addr}->{game})."'
- )
- ";
- &execNonQuery($query);
-
- $clanId = $db_conn->{'mysql_insertid'};
- &printNotice("Created clan \"$clanName\" <C:$clanId> with tag "
- . "\"$clanTag\" for player \"$name\"");
- return $clanId;
- }
- }
- #
- # object getServer (string address, int port)
- #
- # Looks up a server's ID number in the Servers table, by searching for a
- # matching IP address and port. NOTE you must specify IP addresses in the
- # Servers table, NOT hostnames.
- #
- # Returns a new "Server object".
- #
- sub getServer
- {
- my ($address, $port) = @_;
- my $query = "
- SELECT
- a.serverId,
- a.game,
- a.name,
- a.rcon_password,
- a.publicaddress,
- IFNULL(b.`value`,3) AS game_engine,
- IFNULL(c.`realgame`, 'hl2mp') AS realgame,
- IFNULL(a.max_players, 0) AS maxplayers
-
- FROM
- hlstats_Servers a LEFT JOIN hlstats_Servers_Config b on a.serverId = b.serverId AND b.`parameter` = 'GameEngine' LEFT JOIN `hlstats_Games` c ON a.game = c.code
- WHERE
- address=? AND
- port=? LIMIT 1
- ";
- my @vals = (
- $address,
- $port
- );
- my $result = &execCached("get_server_information", $query, @vals);
- if ($result->rows) {
- my ($serverId, $game, $name, $rcon_pass, $publicaddress, $gameengine, $realgame, $maxplayers) = $result->fetchrow_array;
- $result->finish;
- if (!defined($g_games{$game})) {
- $g_games{$game} = new HLstats_Game($game);
- }
- # l4d code should be reused for l4d2
- # trying first using l4d as "realgame" code for l4d2 in db. if default server config settings won't work, will leave as own "realgame" code in db but uncomment line.
- #$realgame = "l4d" if $realgame eq "l4d2";
-
- return new HLstats_Server($serverId, $address, $port, $name, $rcon_pass, $game, $publicaddress, $gameengine, $realgame, $maxplayers);
- } else {
- $result->finish;
- return 0;
- }
- }
- #
- #
- #
- #
- #
- sub queryServer
- {
- my ($iaddr, $iport, @query) = @_;
- my $game = "";
- my $timeout=2;
- my $message = IO::Socket::INET->new(Proto=>"udp",Timeout=>$timeout,PeerPort=>$iport,PeerAddr=>$iaddr) or die "Can't make UDP socket: $@";
- $message->send("\xFF\xFF\xFF\xFFTSource Engine Query\x00");
- my ($datagram,$flags);
- my $end = time + $timeout;
- my $rin = '';
- vec($rin, fileno($message), 1) = 1;
- my %hash = ();
- while (1) {
- my $timeleft = $end - time;
- last if ($timeleft <= 0);
- my ($nfound, $t) = select(my $rout = $rin, undef, undef, $timeleft);
- last if ($nfound == 0); # either timeout or end of file
- $message->recv($datagram,1024,$flags);
- @hash{qw/key type netver hostname mapname gamedir gamename id numplayers maxplayers numbots dedicated os passreq secure gamever edf port/} = unpack("LCCZ*Z*Z*Z*vCCCCCCCZ*Cv",$datagram);
- }
- return @hash{@query};
- }
- sub getServerMod
- {
- my ($address, $port) = @_;
- my ($playgame);
- &printEvent ("DETECT", "Querying $address".":$port for gametype");
- my @query = (
- 'gamename',
- 'gamedir',
- 'hostname',
- 'numplayers',
- 'maxplayers',
- 'mapname'
- );
- my ($gamename, $gamedir, $hostname, $numplayers, $maxplayers, $mapname) = &queryServer($address, $port, @query);
- if ($gamename =~ /^Counter-Strike$/i) {
- $playgame = "cstrike";
- } elsif ($gamename =~ /^Counter-Strike/i) {
- $playgame = "css";
- } elsif ($gamename =~ /^Team Fortress C/i) {
- $playgame = "tfc";
- } elsif ($gamename =~ /^Team Fortress/i) {
- $playgame = "tf";
- } elsif ($gamename =~ /^Day of Defeat$/i) {
- $playgame = "dod";
- } elsif ($gamename =~ /^Day of Defeat/i) {
- $playgame = "dods";
- } elsif ($gamename =~ /^Insurgency/i) {
- $playgame = "insmod";
- } elsif ($gamename =~ /^Neotokyo/i) {
- $playgame = "nts";
- } elsif ($gamename =~ /^Fortress Forever/i) {
- $playgame = "ff";
- } elsif ($gamename =~ /^Age of Chivalry/i) {
- $playgame = "aoc";
- } elsif ($gamename =~ /^Dystopia/i) {
- $playgame = "dystopia";
- } elsif ($gamename =~ /^Stargate/i) {
- $playgame = "sgtls";
- } elsif ($gamename =~ /^Battle Grounds/i) {
- $playgame = "bg2";
- } elsif ($gamename =~ /^Hidden/i) {
- $playgame = "hidden";
- } elsif ($gamename =~ /^L4D /i) {
- $playgame = "l4d";
- } elsif ($gamename =~ /^Left 4 Dead 2/i) {
- $playgame = "l4d2";
- } elsif ($gamename =~ /^ZPS /i) {
- $playgame = "zps";
- } elsif ($gamename =~ /^NS /i) {
- $playgame = "ns";
- } elsif ($gamename =~ /^pvkii/i) {
- $playgame = "pvkii";
- } elsif ($gamename =~ /^CSPromod/i) {
- $playgame = "csp";
- } elsif ($gamename eq "Half-Life") {
- $playgame = "valve";
- } elsif ($gamename eq "Nuclear Dawn") {
- $playgame = "nucleardawn";
-
- # We didn't found our mod, trying secondary way. This is required for some games such as FOF and GES and is a fallback for others
- } elsif ($gamedir =~ /^ges/i) {
- $playgame = "ges";
- } elsif ($gamedir =~ /^fistful_of_frags/i || $gamedir =~ /^fof/i) {
- $playgame = "fof";
- } elsif ($gamedir =~ /^hl2mp/i) {
- $playgame = "hl2mp";
- } elsif ($gamedir =~ /^tfc/i) {
- $playgame = "tfc";
- } elsif ($gamedir =~ /^tf/i) {
- $playgame = "tf";
- } elsif ($gamedir =~ /^ins/i) {
- $playgame = "insmod";
- } elsif ($gamedir =~ /^neotokyo/i) {
- $playgame = "nts";
- } elsif ($gamedir =~ /^fortressforever/i) {
- $playgame = "ff";
- } elsif ($gamedir =~ /^ageofchivalry/i) {
- $playgame = "aoc";
- } elsif ($gamedir =~ /^dystopia/i) {
- $playgame = "dystopia";
- } elsif ($gamedir =~ /^sgtls/i) {
- $playgame = "sgtls";
- } elsif ($gamedir =~ /^hidden/i) {
- $playgame = "hidden";
- } elsif ($gamedir =~ /^left4dead/i) {
- $playgame = "l4d";
- } elsif ($gamedir =~ /^left4dead2/i) {
- $playgame = "l4d2";
- } elsif ($gamedir =~ /^zps/i) {
- $playgame = "zps";
- } elsif ($gamedir =~ /^ns/i) {
- $playgame = "ns";
- } elsif ($gamedir =~ /^bg/i) {
- $playgame = "bg2";
- } elsif ($gamedir =~ /^pvkii/i) {
- $playgame = "pvkii";
- } elsif ($gamedir =~ /^cspromod/i) {
- $playgame = "csp";
- } elsif ($gamedir =~ /^valve$/i) {
- $playgame = "valve";
- } elsif ($gamedir =~ /^nucleardawn$/i) {
- $playgame = "nucleardawn";
- } elsif ($gamedir =~ /^dinodday$/i) {
- $playgame = "dinodday";
- } else {
- # We didn't found our mod, giving up.
- &printEvent("DETECT", "Failed to get Server Mod");
- return 0;
- }
- &printEvent("DETECT", "Saving server " . $address . ":" . $port . " with gametype " . $playgame);
- &addServerToDB($address, $port, $hostname, $playgame, $numplayers, $maxplayers, $mapname);
- return $playgame;
- }
- sub addServerToDB
- {
- my ($address, $port, $name, $game, $act_players, $max_players, $act_map) = @_;
- my $sql = "INSERT INTO hlstats_Servers (address, port, name, game, act_players, max_players, act_map) VALUES ('$address', $port, '"."eSQL($name)."', '"."eSQL($game)."', $act_players, $max_players, '"."eSQL($act_map)."')";
- &execNonQuery($sql);
-
- my $last_id = $db_conn->{'mysql_insertid'};
- &execNonQuery("DELETE FROM `hlstats_Servers_Config` WHERE serverId = $last_id");
- &execNonQuery("INSERT INTO `hlstats_Servers_Config` (`serverId`, `parameter`, `value`)
- SELECT $last_id, `parameter`, `value`
- FROM `hlstats_Mods_Defaults` WHERE `code` = '';");
- &execNonQuery("INSERT INTO `hlstats_Servers_Config` (`serverId`, `parameter`, `value`) VALUES
- ($last_id, 'Mod', '');");
- &execNonQuery("INSERT INTO `hlstats_Servers_Config` (`serverId`, `parameter`, `value`)
- SELECT $last_id, `parameter`, `value`
- FROM `hlstats_Games_Defaults` WHERE `code` = '"."eSQL($game)."'
- ON DUPLICATE KEY UPDATE `value` = VALUES(`value`);");
- &readDatabaseConfig();
- return 1;
- }
- #
- # boolean sameTeam (string team1, string team2)
- #
- # This should be expanded later to allow for team alliances (e.g. TFC-hunted).
- #
- sub sameTeam
- {
- my ($team1, $team2) = @_;
-
- if (($team1 eq $team2) && (($team1 ne "Unassigned") || ($team2 ne "Unassigned"))) {
- return 1;
- } else {
- return 0;
- }
- }
- #
- # string getPlayerInfoString (object player, string ident)
- #
- sub getPlayerInfoString
- {
- my ($player) = shift;
- my @ident = @_;
-
- if ($player) {
- return $player->getInfoString();
- } else {
- return "(" . join(",", @ident) . ")";
- }
- }
- #
- # array getPlayerInfo (string player, string $ipAddr)
- #
- # Get a player's name, uid, wonid and team from "Name<uid><wonid><team>".
- #
- sub getPlayerInfo
- {
- my ($player, $create_player, $ipAddr) = @_;
- if ($player =~ /^(.*?)<(\d+)><([^<>]*)><([^<>]*)>(?:<([^<>]*)>)?.*$/) {
- my $name = $1;
- my $userid = $2;
- my $uniqueid = $3;
- my $team = $4;
- my $role = $5;
- my $bot = 0;
- my $haveplayer = 0;
-
- $plainuniqueid = $uniqueid;
- $uniqueid =~ s/^STEAM_[0-9]+?\://;
-
- if (($uniqueid eq "Console") && ($team eq "Console")) {
- return 0;
- }
- if ($g_servers{$s_addr}->{play_game} == L4D()) {
- #for l4d, create meta player object for each role
- if ($uniqueid eq "") {
- #infected & witch have blank steamid
- if ($name eq "infected") {
- $uniqueid = "BOT-Horde";
- $team = "Infected";
- $userid = -9;
- } elsif ($name eq "witch") {
- $uniqueid = "BOT-Witch";
- $team = "Infected";
- $userid = -10;
- } else {
- return 0;
- }
- } elsif ($uniqueid eq "BOT") {
- #all other bots have BOT for steamid
- if ($team eq "Survivor") {
- if ($name eq "Nick") {
- $userid = -11;
- } elsif ($name eq "Ellis") {
- $userid = -13;
- } elsif ($name eq "Rochelle") {
- $userid = -14;
- } elsif ($name eq "Coach") {
- $userid = -12;
- } elsif ($name eq "Louis") {
- $userid = -4;
- } elsif ($name eq "Zoey") {
- $userid = -1;
- } elsif ($name eq "Francis") {
- $userid = -2;
- } elsif ($name eq "Bill") {
- $userid = -3;
- } else {
- &printEvent("ERROR", "No survivor match for $name",0,1);
- $userid = -4;
- }
- } else {
- if ($name eq "Smoker") {
- $userid = -5;
- } elsif ($name eq "Boomer") {
- $userid = -6;
- } elsif ($name eq "Hunter") {
- $userid = -7;
- } elsif ($name eq "Spitter") {
- $userid = -15;
- } elsif ($name eq "Jockey") {
- $userid = -16;
- } elsif ($name eq "Charger") {
- $userid = -17;
- } elsif ($name eq "Tank") {
- $userid = -8;
- } else {
- &printEvent("DEBUG", "No infected match for $name",0,1);
- $userid = -8;
- }
- }
- $uniqueid = "BOT-".$name;
- $name = "BOT-".$name;
- }
- }
- if ($ipAddr eq "none") {
- $ipAddr = "";
- }
-
- $bot = botidcheck($uniqueid);
-
- if ($g_mode eq "NameTrack") {
- $uniqueid = $name;
- } else {
- if ($g_mode eq "LAN" && !$bot && $userid > 0) {
- if ($ipAddr ne "") {
- $g_lan_noplayerinfo->{"$s_addr/$userid/$name"} = {
- ipaddress => $ipAddr,
- userid => $userid,
- name => $name,
- server => $s_addr
- };
- $uniqueid = $ipAddr;
- } else {
- while ( my($index, $player) = each(%g_players) ) {
- if (($player->{userid} eq $userid) &&
- ($player->{name} eq $name)) {
-
- $uniqueid = $player->{uniqueid};
- $haveplayer = 1;
- last;
- }
- }
- if (!$haveplayer) {
- while ( my($index, $player) = each(%g_lan_noplayerinfo) ) {
- if (($player->{server} eq $s_addr) &&
- ($player->{userid} eq $userid) &&
- ($player->{name} eq $name)) {
-
- $uniqueid = $player->{ipaddress};
- $haveplayer = 1;
- }
- }
- }
- if (!$haveplayer) {
- $uniqueid = "UNKNOWN";
- }
- }
- } else {
- # Normal (steamid) mode player and bot, as well as lan mode bots
- if ($bot) {
- $md5 = Digest::MD5->new;
- $md5->add($name);
- $md5->add($s_addr);
- $uniqueid = "BOT:" . $md5->hexdigest;
- $unique_id = $uniqueid if ($g_mode eq "LAN");
- }
-
- if ($uniqueid eq "UNKNOWN"
- || $uniqueid eq "STEAM_ID_PENDING" || $uniqueid eq "STEAM_ID_LAN"
- || $uniqueid eq "VALVE_ID_PENDING" || $uniqueid eq "VALVE_ID_LAN"
- ) {
- return {
- name => $name,
- userid => $userid,
- uniqueid => $uniqueid,
- team => $team
- };
- }
- }
- }
-
- if (!$haveplayer)
- {
- while ( my ($index, $player) = each(%g_players) ) {
- # Cannot exit loop early as more than one player can exist with same uniqueid
- # (bug? or just bad logging)
- # Either way, we disconnect any that don't match the current line
- if ($player->{uniqueid} eq $uniqueid) {
- $haveplayer = 1;
- # Catch players reconnecting without first disconnecting
- if ($player->{userid} != $userid) {
-
- &doEvent_Disconnect(
- $player->{"userid"},
- $uniqueid,
- ""
- );
- $haveplayer = 0;
- }
- }
- }
- }
-
- if ($haveplayer) {
- my $player = lookupPlayer($s_addr, $userid, $uniqueid);
- if ($player) {
- # The only time team should go /back/ to unassigned ("") is on mapchange
- # (which is already handled in the ChangeMap handler)
- # So ignore when team is blank (<>) from lazy log lines
- if ($team ne "" && $player->{team} ne $team) {
- &doEvent_TeamSelection(
- $userid,
- $uniqueid,
- $team
- );
- }
- if ($role ne "" && $role ne $player->{role}) {
- &doEvent_RoleSelection(
- $player->{"userid"},
- $player->{"uniqueid"},
- $role
- );
- }
-
- $player->updateTimestamp();
- }
- } else {
- if ($userid != 0) {
- if ($create_player > 0) {
- my $preIpAddr = "";
- if ($g_preconnect->{"$s_addr/$userid/$name"}) {
- $preIpAddr = $g_preconnect->{"$s_addr/$userid/$name"}->{"ipaddress"};
- }
- # Add the player to our hash of player objects
- $g_servers{$s_addr}->{"srv_players"}->{"$userid/$uniqueid"} = new HLstats_Player(
- server => $s_addr,
- server_id => $g_servers{$s_addr}->{id},
- userid => $userid,
- uniqueid => $uniqueid,
- plain_uniqueid => $plainuniqueid,
- game => $g_servers{$s_addr}->{game},
- name => $name,
- team => $team,
- role => $role,
- is_bot => $bot,
- display_events => $g_servers{$s_addr}->{default_display_events},
- address => (($preIpAddr ne "") ? $preIpAddr : $ipAddr)
- );
-
- if ($preIpAddr ne "") {
- &printEvent("SERVER", "LATE CONNECT [$name/$userid] - steam userid validated");
- &doEvent_Connect($userid, $uniqueid, $preIpAddr);
- delete($g_preconnect->{"$s_addr/$userid/$name"});
- }
- # Increment number of players on server
- $g_servers{$s_addr}->updatePlayerCount();
- }
- } elsif (($g_mode eq "LAN") && (defined($g_lan_noplayerinfo{"$s_addr/$userid/$name"}))) {
- if ((!$haveplayer) && ($uniqueid ne "UNKNOWN") && ($create_player > 0)) {
- $g_servers{$s_addr}->{srv_players}->{"$userid/$uniqueid"} = new HLstats_Player(
- server => $s_addr,
- server_id => $g_servers{$s_addr}->{id},
- userid => $userid,
- uniqueid => $uniqueid,
- plain_uniqueid => $plainuniqueid,
- game => $g_servers{$s_addr}->{game},
- name => $name,
- team => $team,
- role => $role,
- is_bot => $bot
- );
- delete($g_lan_noplayerinfo{"$s_addr/$userid/$name"});
- # Increment number of players on server
-
- $g_servers{$s_addr}->updatePlayerCount();
- }
- } else {
- &printNotice("No player object available for player \"$name\" <U:$userid>");
- }
- }
-
- return {
- name => $name,
- userid => $userid,
- uniqueid => $uniqueid,
- team => $team,
- is_bot => $bot
- };
- } elsif ($player =~ /^(.+)<([^<>]+)>$/) {
- my $name = $1;
- my $uniqueid = $2;
- my $bot = 0;
-
- if (&botidcheck($uniqueid)) {
- $md5 = Digest::MD5->new;
- $md5->add($ev_daemontime);
- $md5->add($s_addr);
- $uniqueid = "BOT:" . $md5->hexdigest;
- $bot = 1;
- }
- return {
- name => $name,
- uniqueid => $uniqueid,
- is_bot => $bot
- };
- } elsif ($player =~ /^<><([^<>]+)><>$/) {
- my $uniqueid = $1;
- my $bot = 0;
- if (&botidcheck($uniqueid)) {
- $md5 = Digest::MD5->new;
- $md5->add($ev_daemontime);
- $md5->add($s_addr);
- $uniqueid = "BOT:" . $md5->hexdigest;
- $bot = 1;
- }
- return {
- uniqueid => $uniqueid,
- is_bot => $bot
- };
- } else {
- return 0;
- }
- }
- #
- # hash getProperties (string propstring)
- #
- # Parse (key "value") properties into a hash.
- #
- sub getProperties
- {
- my ($propstring) = @_;
- my %properties;
- my $dods_flag = 0;
-
- while ($propstring =~ s/^\s*\((\S+)(?:(?: "(.+?)")|(?: ([^\)]+)))?\)//) {
- my $key = $1;
- if (defined($2)) {
- if ($key eq "player") {
- if ($dods_flag == 1) {
- $key = "player_a";
- $dods_flag++;
- } elsif ($dods_flag == 2) {
- $key = "player_b";
- }
- }
- $properties{$key} = $2;
- } elsif (defined($3)) {
- $properties{$key} = $3;
- } else {
- $properties{$key} = 1; # boolean property
- }
- if ($key eq "flagindex") {
- $dods_flag++;
- }
- }
-
- return %properties;
- }
- #
- # boolean like (string subject, string compare)
- #
- # Returns true if 'subject' equals 'compare' with optional whitespace.
- #
- sub like
- {
- my ($subject, $compare) = @_;
-
- if ($subject =~ /^\s*\Q$compare\E\s*$/) {
- return 1;
- } else {
- return 0;
- }
- }
- #
- # boolean botidcheck (string uniqueid)
- #
- # Returns true if 'uniqueid' is that of a bot.
- #
- sub botidcheck
- {
- # needs cleaned up
- # added /^00000000\:\d+\:0$/ check for "whichbot"
- my ($uniqueid) = @_;
- if ($uniqueid eq "BOT" || $uniqueid eq "0" || $uniqueid =~ /^00000000\:\d+\:0$/) {
- return 1
- }
- return 0;
- }
- sub isTrackableTeam
- {
- my ($team) = @_;
- #if ($team =~ /spectator/i || $team =~ /unassigned/i || $team eq "") {
- if ($team =~ /spectator/i || $team eq "") {
- return 0;
- }
- return 1;
- }
- sub reloadConfiguration
- {
- &flushAll;
- &readDatabaseConfig;
- }
- sub flushAll
- {
- # we only need to flush events if we're about to shut down. they are unaffected by server/player deletion
- my ($flushevents) = @_;
- if ($flushevents)
- {
- while ( my ($table, $colsref) = each(%g_eventTables) )
- {
- flushEventTable($table);
- }
- }
-
- while( my($se, $server) = each(%g_servers))
- {
- while ( my($pl, $player) = each(%{$server->{"srv_players"}}) )
- {
- if ($player)
- {
- $player->playerCleanup();
- }
- }
- $server->flushDB();
- }
- }
- ##
- ## MAIN
- ##
- # Options
- $opt_help = 0;
- $opt_version = 0;
- $db_host = "localhost";
- $db_user = "";
- $db_pass = "";
- $db_name = "hlstats";
- $db_lowpriority = 1;
- $s_ip = "";
- $s_port = "27500";
- $g_mailto = "";
- $g_mailpath = "/bin/mail";
- $g_mode = "Normal";
- $g_deletedays = 5;
- $g_requiremap = 0;
- $g_debug = 1;
- $g_nodebug = 0;
- $g_rcon = 1;
- $g_rcon_ignoreself = 0;
- $g_rcon_record = 1;
- $g_stdin = 0;
- $g_server_ip = "";
- $g_server_port = 27015;
- $g_timestamp = 0;
- $g_cpanelhack = 0;
- $g_event_queue_size = 10;
- $g_dns_resolveip = 1;
- $g_dns_timeout = 5;
- $g_skill_maxchange = 100;
- $g_skill_minchange = 2;
- $g_skill_ratio_cap = 0;
- $g_geoip_binary = 0;
- $g_player_minkills = 50;
- $g_onlyconfig_servers = 1;
- $g_track_stats_trend = 0;
- %g_lan_noplayerinfo = ();
- %g_preconnect = ();
- $g_global_banning = 0;
- $g_log_chat = 0;
- $g_log_chat_admins = 0;
- $g_global_chat = 0;
- $g_ranktype = "skill";
- $g_gi = undef;
- my %dysweaponcodes = (
- "1" => "Light Katana",
- "2" => "Medium Katana",
- "3" => "Fatman Fist",
- "4" => "Machine Pistol",
- "5" => "Shotgun",
- "6" => "Laser Rifle",
- "7" => "BoltGun",
- "8" => "SmartLock Pistols",
- "9" => "Assault Rifle",
- "10" => "Grenade Launcher",
- "11" => "MK-808 Rifle",
- "12" => "Tesla Rifle",
- "13" => "Rocket Launcher",
- "14" => "Minigun",
- "15" => "Ion Cannon",
- "16" => "Basilisk",
- "17" => "Frag Grenade",
- "18" => "EMP Grenade",
- "19" => "Spider Grenade",
- "22" => "Cortex Bomb"
- );
- # Usage message
- $usage = <<EOT
- Usage: hlstats.pl [OPTION]...
- Collect statistics from one or more Half-Life2 servers for insertion into
- a MySQL database.
- -h, --help display this help and exit
- -v, --version output version information and exit
- -d, --debug enable debugging output (-dd for more)
- -n, --nodebug disables above; reduces debug level
- -m, --mode=MODE player tracking mode (Normal, LAN or NameTrack) [$g_mode]
- --db-host=HOST database ip or ip:port [$db_host]
- --db-name=DATABASE database name [$db_name]
- --db-password=PASSWORD database password (WARNING: specifying the
- password on the command line is insecure.
- Use the configuration file instead.)
- --db-username=USERNAME database username
- --dns-resolveip resolve player IP addresses to hostnames
- (requires working DNS)
- -c,--configfile Specific configfile to use, settings in this file can now
- be overidden with commandline settings.
- --nodns-resolveip disables above
- --dns-timeout=SEC timeout DNS queries after SEC seconds [$g_dns_timeout]
- -i, --ip=IP set IP address to listen on for UDP log data
- -p, --port=PORT set port to listen on for UDP log data [$s_port]
- -r, --rcon enables rcon command exec support (the default)
- --norcon disables rcon command exec support
- -s, --stdin read log data from standard input, instead of
- from UDP socket. Must specify --server-ip
- and --server-port to indicate the generator
- of the inputted log data (implies --norcon)
- --nostdin disables above
- --server-ip specify data source IP address for --stdin
- --server-port specify data source port for --stdin [$g_server_port]
- -t, --timestamp tells HLstatsX:CE to use the timestamp in the log
- data, instead of the current time on the
- database server, when recording events
- --notimestamp disables above
- --event-queue-size=SIZE manually set event queue size to control flushing
- (recommend 100+ for STDIN)
- Long options can be abbreviated, where such abbreviation is not ambiguous.
- Default values for options are indicated in square brackets [...].
- Most options can be specified in the configuration file:
- $opt_configfile
- Note: Options set on the command line take precedence over options set in the
- configuration file. The configuration file name is set at the top of hlstats.pl.
- HLstatsX: Community Edition http://www.hlxcommunity.com
- EOT
- ;
- %g_config_servers = ();
- sub readDatabaseConfig()
- {
- &printEvent("CONFIG", "Reading database config...", 1);
- %g_config_servers = ();
- %g_servers = ();
- %g_games = ();
- # elstatsneo: read the servers portion from the mysql database
- my $srv_id = &doQuery("SELECT serverId,CONCAT(address,':',port) AS addr FROM hlstats_Servers");
- while ( my($serverId,$addr) = $srv_id->fetchrow_array) {
- $g_config_servers{$addr} = ();
- my $serverConfig = &doQuery("SELECT parameter,value FROM hlstats_Servers_Config WHERE serverId=$serverId");
- while ( my($p,$v) = $serverConfig->fetchrow_array) {
- $g_config_servers{$addr}{$p} = $v;
- }
- }
- $srv_id->finish;
- # hlxce: read the global settings from the database!
- my $gsettings = &doQuery("SELECT keyname,value FROM hlstats_Options WHERE opttype <= 1");
- while ( my($p,$v) = $gsettings->fetchrow_array) {
- if ($g_debug > 1) {
- print "Config parameter '$p' = '$v'\n";
- }
- $tmp = "\$".$directives_mysql{$p}." = '$v'";
- #print " -> setting ".$tmp."\n";
- eval $tmp;
- }
- $gsettings->finish;
- # setting defaults
- &printEvent("DAEMON", "Proxy_Key DISABLED", 1) if ($proxy_key eq "");
- while (my($addr, $server) = each(%g_config_servers)) {
-
- if (!defined($g_config_servers{$addr}{"MinPlayers"})) {
- $g_config_servers{$addr}{"MinPlayers"} = 6;
- }
- if (!defined($g_config_servers{$addr}{"DisplayResultsInBrowser"})) {
- $g_config_servers{$addr}{"DisplayResultsInBrowser"} = 0;
- }
- if (!defined($g_config_servers{$addr}{"BroadCastEvents"})) {
- $g_config_servers{$addr}{"BroadCastEvents"} = 0;
- }
- if (!defined($g_config_servers{$addr}{"BroadCastPlayerActions"})) {
- $g_config_servers{$addr}{"BroadCastPlayerActions"} = 0;
- }
- if (!defined($g_config_servers{$addr}{"BroadCastEventsCommand"})) {
- $g_config_servers{$addr}{"BroadCastEventsCommand"} = "say";
- }
- if (!defined($g_config_servers{$addr}{"BroadCastEventsCommandAnnounce"})) {
- $g_config_servers{$addr}{"BroadCastEventsCommandAnnounce"} = "say";
- }
- if (!defined($g_config_servers{$addr}{"PlayerEvents"})) {
- $g_config_servers{$addr}{"PlayerEvents"} = 1;
- }
- if (!defined($g_config_servers{$addr}{"PlayerEventsCommand"})) {
- $g_config_servers{$addr}{"PlayerEventsCommand"} = "say";
- }
- if (!defined($g_config_servers{$addr}{"PlayerEventsCommandOSD"})) {
- $g_config_servers{$addr}{"PlayerEventsCommandOSD"} = "";
- }
- if (!defined($g_config_servers{$addr}{"PlayerEventsCommandHint"})) {
- $g_config_servers{$addr}{"PlayerEventsCommandHint"} = "";
- }
- if (!defined($g_config_servers{$addr}{"PlayerEventsAdminCommand"})) {
- $g_config_servers{$addr}{"PlayerEventsAdminCommand"} = "";
- }
- if (!defined($g_config_servers{$addr}{"ShowStats"})) {
- $g_config_servers{$addr}{"ShowStats"} = 1;
- }
- if (!defined($g_config_servers{$addr}{"AutoTeamBalance"})) {
- $g_config_servers{$addr}{"AutoTeamBalance"} = 0;
- }
- if (!defined($g_config_servers{$addr}{"AutoBanRetry"})) {
- $g_config_servers{$addr}{"AutoBanRetry"} = 0;
- }
- if (!defined($g_config_servers{$addr}{"TrackServerLoad"})) {
- $g_config_servers{$addr}{"TrackServerLoad"} = 0;
- }
- if (!defined($g_config_servers{$addr}{"MinimumPlayersRank"})) {
- $g_config_servers{$addr}{"MinimumPlayersRank"} = 0;
- }
- if (!defined($g_config_servers{$addr}{"Admins"})) {
- $g_config_servers{$addr}{"Admins"} = "";
- }
- if (!defined($g_config_servers{$addr}{"SwitchAdmins"})) {
- $g_config_servers{$addr}{"SwitchAdmins"} = 0;
- }
- if (!defined($g_config_servers{$addr}{"IgnoreBots"})) {
- $g_config_servers{$addr}{"IgnoreBots"} = 1;
- }
- if (!defined($g_config_servers{$addr}{"SkillMode"})) {
- $g_config_servers{$addr}{"SkillMode"} = 0;
- }
- if (!defined($g_config_servers{$addr}{"GameType"})) {
- $g_config_servers{$addr}{"GameType"} = 0;
- }
- if (!defined($g_config_servers{$addr}{"BonusRoundTime"})) {
- $g_config_servers{$addr}{"BonusRoundTime"} = 0;
- }
- if (!defined($g_config_servers{$addr}{"BonusRoundIgnore"})) {
- $g_config_servers{$addr}{"BonusRoundIgnore"} = 0;
- }
- if (!defined($g_config_servers{$addr}{"Mod"})) {
- $g_config_servers{$addr}{"Mod"} = "";
- }
- if (!defined($g_config_servers{$addr}{"EnablePublicCommands"})) {
- $g_config_servers{$addr}{"EnablePublicCommands"} = 1;
- }
- if (!defined($g_config_servers{$addr}{"ConnectAnnounce"})) {
- $g_config_servers{$addr}{"ConnectAnnounce"} = 1;
- }
- if (!defined($g_config_servers{$addr}{"UpdateHostname"})) {
- $g_config_servers{$addr}{"UpdateHostname"} = 0;
- }
- if (!defined($g_config_servers{$addr}{"DefaultDisplayEvents"})) {
- $g_config_servers{$addr}{"DefaultDisplayEvents"} = 1;
- }
- }
- &printEvent("CONFIG", "I have found the following server configs in database:", 1);
- while (my($addr, $server) = each(%g_config_servers)) {
- &printEvent("S_CONFIG", $addr, 1);
- }
-
- my $geotell = ((!defined($g_gi)) ? -1 : tell $g_gi{fh});
-
- if ($g_geoip_binary > 0 && $geotell == -1) {
- my $geoipfile = "$opt_libdir/GeoLiteCity/GeoLiteCity.dat";
- if (-r $geoipfile) {
- eval "use Geo::IP::PurePerl"; my $hasGeoIP = $@ ? 0 : 1;
- if ($hasGeoIP) {
- $g_gi = Geo::IP::PurePerl->open($geoipfile, "GEOIP_STANDARD");
- } else {
- &printEvent("ERROR", "GeoIP method set to binary file lookup but Geo::IP::PurePerl module NOT FOUND", 1);
- $g_gi = undef;
- }
- } else {
- &printEvent("ERROR", "GeoIP method set to binary file lookup but $geoipfile NOT FOUND", 1);
- $g_gi = undef;
- }
- } elsif ($g_geoip_binary == 0 && $geotell > -1) {
- close($g_gi{fh});
- $g_gi = undef;
- }
- }
- # 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",
- "DBLowPriority", "db_lowpriority",
- "BindIP", "s_ip",
- "Port", "s_port",
- "DebugLevel", "g_debug",
- "CpanelHack", "g_cpanelhack",
- "EventQueueSize", "g_event_queue_size"
- );
- %directives_mysql = (
- "version", "g_version",
- "MailTo", "g_mailto",
- "MailPath", "g_mailpath",
- "Mode", "g_mode",
- "DeleteDays", "g_deletedays",
- "UseTimestamp", "g_timestamp",
- "DNSResolveIP", "g_dns_resolveip",
- "DNSTimeout", "g_dns_timeout",
- "RconIgnoreSelf", "g_rcon_ignoreself",
- "Rcon", "g_rcon",
- "RconRecord", "g_rcon_record",
- "MinPlayers", "g_minplayers",
- "SkillMaxChange", "g_skill_maxchange",
- "SkillMinChange", "g_skill_minchange",
- "PlayerMinKills", "g_player_minkills",
- "AllowOnlyConfigServers", "g_onlyconfig_servers",
- "TrackStatsTrend", "g_track_stats_trend",
- "GlobalBanning", "g_global_banning",
- "LogChat", "g_log_chat",
- "LogChatAdmins", "g_log_chat_admins",
- "GlobalChat", "g_global_chat",
- "SkillRatioCap", "g_skill_ratio_cap",
- "rankingtype", "g_ranktype",
- "UseGeoIPBinary", "g_geoip_binary",
- "Proxy_Key", "proxy_key"
- );
- # "Servers", "g_config_servers"
- &doConf($conf, %directives);
- } else {
- print "-- Warning: unable to open configuration file '$opt_configfile'\n";
- }
- # Read Command Line Arguments
- %copts = ();
- GetOptions(
- "help|h" => \$copts{opt_help},
- "version|v" => \$copts{opt_version},
- "debug|d+" => \$copts{g_debug},
- "nodebug|n+" => \$copts{g_nodebug},
- "mode|m=s" => \$copts{g_mode},
- "configfile|c=s" => \$copts{configfile},
- "db-host=s" => \$copts{db_host},
- "db-name=s" => \$copts{db_name},
- "db-password=s" => \$copts{db_pass},
- "db-username=s" => \$copts{db_user},
- "dns-resolveip!" => \$copts{g_dns_resolveip},
- "dns-timeout=i" => \$copts{g_…
Large files files are truncated, but you can click here to view the full file