#!/usr/bin/perl

use strict;
no strict 'vars';

##
## Settings
##

# $opt_configfile - Absolute path and filename of configuration file.
$opt_configfile = "./perl.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;

require "$opt_libdir/ConfigReaderSimple.pm";
do "$opt_libdir/perl.plib";

$|=1;
Getopt::Long::Configure ("bundling");


$last_trend_timestamp = 0;

##
## MAIN
##

# Options

$opt_help = 0;
$opt_version = 0;

$db_host = "localhost";
$db_user = "";
$db_pass = "";
$db_name = "";
$db_lowpriority = 1;

$s_ip = "";
$s_port = "27500";

$g_mailto = "";
$g_mailpath = "/bin/mail";
$g_mode = "Normal";
$g_deletedays = 5;
$g_minactivity = 28;
$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_dns_resolveip = 1;
$g_dns_timeout = 5;
$g_skill_maxchange = 100;
$g_skill_minchange = 2;
$g_player_minkills = 50;
$g_bot_ids = "BOT:0";
$g_onlyconfig_servers = 1;
$g_track_stats_trend = 0;
%g_lan_noplayerinfo = ();
%g_preconnect = ();
$g_global_banning = 0;
$g_masterserver_address = "";
$g_masterserver_port    = "";
$g_statsserver_address  = "";
$g_statsserver_port     = "";
$g_log_chat = 0;
$g_log_chat_admins = 0;
$g_global_chat = 0;

# Usage message

$usage = <<EOT

EOT
;

%g_config_servers = ();

# 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",
                "DBUsername2",            "db_user2",
                "DBPassword2",            "db_pass2",
                "DBName2",                        "db_name2",
                "DBLowPriority",          "db_lowpriority",
                "BindIP",                         "s_ip",
                "Port",                           "s_port",
                "MailTo",                         "g_mailto",
                "MailPath",                       "g_mailpath",
                "Mode",                           "g_mode",
                "DeleteDays",             "g_deletedays",
                "MinActivity",            "g_minactivity",
                "DebugLevel",             "g_debug",
                "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"
        );
        &doConf($conf, %directives);
        #,              #"Servers",                "g_config_servers"

# Connect to the database

$db_conn = DBI->connect(
        "DBI:mysql:$db_name:$db_host",
        $db_user, $db_pass
) or die ("\nCan't connect to MySQL database '$db_name' on '$db_host'\n" .
        "Server error: $DBI::errstr\n");

&printEvent("MYSQL", "Connecting to MySQL database '$db_name' on '$db_host' as user '$db_user' ... connected ok", 1);

$db_conn2 = DBI->connect(
        "DBI:mysql:$db_name2:$db_host",
        $db_user2, $db_pass2
) or die ("\nCan't connect to Global MySQL database '$db_name2' on '$db_host2'\n" .
        "Server error: $DBI::errstr\n");

&printEvent("MYSQL", "Connecting to Global MySQL database '$db_name2' on '$db_host' as user '$db_user2' ... connected ok", 1);
        
    my $query = "
            SELECT
                    *
            FROM
                    hlstats_Servers
    ";
    my $result = &doQuery($query);
    my $hash_ref;
 
        # mit jedem Durchlauf gibt es eine neue Variable $hash_ref mit eigener Speicheradresse
        while ( my $hash_ref = $db_conn->fetchrow_hashref( $result ) ) {
        # $hash_ref nicht dereferenzieren, weil wir einen AoH aufbauen; perldoc perldsc
                $g_config_servers[ $hash_ref->{'serverId'} ] = $hash_ref;
                print $hash_ref;
        }

# Release version number

$VERSION = "0.20";
$g_version = $VERSION;

##
## Common Functions
##

sub number_format {
  local $_  = shift;
  1 while s/^(-?\d+)(\d{3})/$1,$2/;
  return $_;
}

sub date_format {
  my $timestamp = shift;
  return sprintf('%dd %02d:%02d:%02dh', 
                  $timestamp / 86400, 
                  $timestamp / 3600 % 24, 
                  $timestamp / 60 % 60, 
                  $timestamp % 60 
                 );     
}



#
# void error (string errormsg)
#
# Dies, and optionally mails error messages to $g_mailto.
#

sub error
{
        my $errormsg = $_[0];
        
        if ($g_mailto && $g_mailpath)
        {
                system("echo \"$errormsg\" | $g_mailpath -s \"Perl crashed `date`\" $g_mailto");
        }

        die("$errormsg\n");
}


#
# string quoteSQL (string varQuote)
#
# Escapes all quote characters in a variable, making it suitable for use in an
# SQL query. Returns the escaped version.
#

sub quoteSQL
{
        my $varQuote = $_[0];

        $varQuote =~ s/\\/\\\\/g;       # replace \ with \\
        $varQuote =~ s/'/\\'/g;         # replace ' with \'
        
        return $varQuote;
}

#
# result doQuery (string query)
#
# Executes the SQL query 'query' and returns the result identifier.
#

sub doQuery
{
        my ($query, $callref) = @_;

        my $result = $db_conn->prepare($query) or die("Unable to prepare query:\n$query\n$DBI::errstr\n$callref");
        $result->execute or die("Unable to execute query:\n$query\n$DBI::errstr\n$callref");
        return $result;
}

sub doQuery2
{
        my ($query, $callref) = @_;

        my $result = $db_conn2->prepare($query) or die("Unable to prepare query:\n$query\n$DBI::errstr\n$callref");
        $result->execute or die("Unable to execute query:\n$query\n$DBI::errstr\n$callref");
        return $result;
}


#
# string resolveIp (string ip, boolean quiet)
#
# Do a DNS reverse-lookup on an IP address and return the hostname, or empty
# string on error.
#

sub resolveIp
{
        my ($ip, $quiet) = @_;
        my ($host) = "";
        
        unless ($g_dns_resolveip)
        {
                return "";
        }
        
        
        eval
        {
                $SIG{ALRM} = sub { die "DNS Timeout\n" };
                alarm $g_dns_timeout;   # timeout after $g_dns_timeout sec
                $host = gethostbyaddr(inet_aton($ip), AF_INET);
                alarm 0;
        };
        
        if ($@)
        {
                my $error = $@;
                chomp($error);
        printEvent("DNS", "Resolving hostname (timeout $g_dns_timeout sec) for IP \"$ip\" - $error ", 1);
                $host = "";             # some error occurred
        }
        elsif (!defined($host))
        {
        printEvent("DNS", "Resolving hostname (timeout $g_dns_timeout sec) for IP \"$ip\" - No Host ", 1);
                $host = "";             # ip did not resolve to any host
        } else {
          $host = lc($host);    # lowercase
      printEvent("DNS", "Resolving hostname (timeout $g_dns_timeout sec) for IP \"$ip\" - $host ", 1);
        }
        chomp($host);
        return $host;
}


#
# object queryHostGroups ()
#
# Returns result identifier.
#

sub queryHostGroups
{
        return &doQuery("
                SELECT
                        pattern,
                        name,
                        LENGTH(pattern) AS patternlength
                FROM
                        hlstats_HostGroups
                ORDER BY
                        patternlength DESC,
                        pattern ASC
        ");
}


#
# string getHostGroup (string hostname[, object result])
#
# Return host group name if any match, or last 2 or 3 parts of hostname.
#

sub getHostGroup
{
        my ($hostname, $result) = @_;
        my $hostgroup = "";
        
        # User can define special named hostgroups in hlstats_HostGroups, i.e.
        # '.adsl.someisp.net' => 'SomeISP ADSL'
        
        $result = &queryHostGroups()  unless ($result);
        $result->execute();
        
        while (my($pattern, $name) = $result->fetchrow_array())
        {
                $pattern = quotemeta($pattern);
                $pattern =~ s/\\\*/[^.]*/g;     # allow basic shell-style globbing in pattern
                if ($hostname =~ /$pattern$/)
                {
                        $hostgroup = $name;
                        last;
                }
        }
        
        if (!$hostgroup)
        {
                #
                # Group by last 2 or 3 parts of hostname, i.e. 'max1.xyz.someisp.net' as
                # 'someisp.net', and 'max1.xyz.someisp.net.nz' as 'someisp.net.nz'.
                # Unfortunately some countries do not have categorical SLDs, so this
                # becomes more complicated. The dom_nosld array below contains a list of
                # known country codes that do not use categorical second level domains.
                # If a country uses SLDs and is not listed below, then it will be
                # incorrectly grouped, i.e. 'max1.xyz.someisp.yz' will become
                # 'xyz.someisp.yz', instead of just 'someisp.yz'.
                #
                # Please mail sgarner@hlstats.org with any additions.
                #
                
                my @dom_nosld = (
                        "ca", # Canada
                        "ch", # Switzerland
                        "be", # Belgium
                        "de", # Germany
                        "ee", # Estonia
                        "es", # Spain
                        "fi", # Finland
                        "fr", # France
                        "ie", # Ireland
                        "nl", # Netherlands
                        "no", # Norway
                        "ru", # Russia
                        "se", # Sweden
                );
                
                my $dom_nosld = join("|", @dom_nosld);
                
                if ($hostname =~ /([\w-]+\.(?:$dom_nosld|\w\w\w))$/)
                {
                        $hostgroup = $1;
                }
                elsif ($hostname =~ /([\w-]+\.[\w-]+\.\w\w)$/)
                {
                        $hostgroup = $1;
                }
                else
                {
                        $hostgroup = $hostname;
                }
        }
        
        return $hostgroup;
}


#
# void doConf (object conf, hash directives)
#
# Walk through configuration directives, setting values of global variables.
#