diff options
Diffstat (limited to 'lib')
40 files changed, 2106 insertions, 2081 deletions
diff --git a/lib/MasterServer/Core/Core.pm b/lib/MasterServer/Core/Core.pm index a20172c..3f99a3a 100755 --- a/lib/MasterServer/Core/Core.pm +++ b/lib/MasterServer/Core/Core.pm @@ -7,7 +7,7 @@ use AnyEvent; use Exporter 'import'; use DBI; -our @EXPORT = qw | halt main |; +our @EXPORT = qw | halt select_database_type main |; ################################################################################ ## Handle shutting down the program in case a fatal error occurs. @@ -34,6 +34,19 @@ sub halt { } ################################################################################ +## Set up the database connection +################################################################################ +sub select_database_type { + my $self = shift; + + # Connect to database + $self->{dbh} = $self->database_login(); + + # and test whether we succeeded. + $self->halt() unless (defined $self->{dbh}); +} + +################################################################################ ## Initialize all processes and start various functions ################################################################################ sub main { @@ -42,67 +55,69 @@ sub main { # condition var prevents or allows the program from ending $self->{must_halt} = AnyEvent->condvar; - # determine version info + # force version info $self->version(); + # print startup + print "Running...\n"; + # keep several objects alive outside their original scope $self->{scope} = (); # startup procedure information + $self->log("info", ""); + $self->log("info", ""); $self->log("info", "333networks Master Server Application."); - $self->log("info", "Build: $self->{build_type}"); - $self->log("info", "Version: $self->{build_version}"); - $self->log("info", "Written by $self->{build_author}"); - $self->log("info", "Logs are written to $self->{log_dir}"); + $self->log("info", "Hostname: $self->{masterserver_hostname}"); + $self->log("info", "Build: $self->{build_type}"); + $self->log("info", "Version: $self->{build_version}"); + $self->log("info", "Author: $self->{build_author}"); + $self->log("info", "Logs: $self->{log_dir}"); # determine the type of database and load the appropriate module - { - # read from login - my @db_type = split(':', $self->{dblogin}->[0]); - - # format supported? - if ( "Pg SQLite mysql" =~ m/$db_type[1]/i) { - - # inform us what DB we try to load - $self->log("load","Loading $db_type[1] database module."); - - # load dbd and tables/queries for this db type - MasterServer::load_recursive("MasterServer::Database::$db_type[1]"); - - # Connect to database - $self->{dbh} = $self->database_login(); - - # and test whether we succeeded. - $self->halt() unless (defined $self->{dbh}); - } - else { - # raise error and halt - $self->log("fatal", "The masterserver could not determine the chosen database type."); - $self->halt(); - } - } + $self->select_database_type(); + + # + # Prepare necessary tasks for running the masterserver + # # (re)load the list with ciphers from the config file, into the database $self->load_ciphers(); + # set first run flag to avoid ignoring servers after downtime + $self->{firstrun} = undef; + $self->{firstruntime} = time; + + ### + # + # activate all schedulers and functions + # + ### + + # + # Timers + # + # tasks that are executed once or twice per hour + $self->{scope}->{long_periodic_tasks} = $self->long_periodic_tasks(); + # + # tasks that are executed every few minutes + $self->{scope}->{short_periodic_tasks} = $self->short_periodic_tasks(); + # + # tasks that are executed every few milliseconds + $self->{scope}->{udp_ticker} = $self->udp_ticker(); + + # + # Network listeners + # # start the listening service (listen for UDP beacons) $self->{scope}->{beacon_catcher} = $self->beacon_catcher(); - - # start the beacon checker service (query entries from the pending list) - $self->{scope}->{beacon_checker} = $self->beacon_checker() if ($self->{beacon_checker_enabled}); - + # # provide server lists to clients with the browser host server $self->{scope}->{browser_host} = $self->browser_host(); - # query other masterserver applets to get more server addresses - $self->{scope}->{ucc_applet_query} = $self->ucc_applet_query_scheduler() if ($self->{master_applet_enabled}); - - # synchronize with 333networks-based masterservers - $self->{scope}->{syncer_scheduler} = $self->syncer_scheduler() if ($self->{sync_enabled}); - # all modules loaded. Running... $self->log("info", "All modules loaded. Masterserver is now running."); - + # prevent main program from ending prematurely $self->{must_halt}->recv; } diff --git a/lib/MasterServer/Core/Logging.pm b/lib/MasterServer/Core/Logging.pm index 800fa43..5aaf683 100755 --- a/lib/MasterServer/Core/Logging.pm +++ b/lib/MasterServer/Core/Logging.pm @@ -15,6 +15,9 @@ our @EXPORT = qw| log |; sub log { my ($self, $type, $msg) = @_; + # flush + $| = 1; + # parse time of log entry and prep for rotating log my $time = strftime('%Y-%m-%d %H:%M:%S',localtime); my $yearly = strftime('-%Y',localtime); @@ -26,7 +29,7 @@ sub log { return if (defined $type && $self->{suppress} =~ m/$type/i); # determine filename - my $f = "MasterServer-Perl"; + my $f = "MasterServer"; # rotate log filename according to config $f .= $daily if ($self->{log_rotate} =~ /^daily$/i ); diff --git a/lib/MasterServer/Core/Schedulers.pm b/lib/MasterServer/Core/Schedulers.pm new file mode 100755 index 0000000..97e45a5 --- /dev/null +++ b/lib/MasterServer/Core/Schedulers.pm @@ -0,0 +1,125 @@ + +package MasterServer::Core::Schedulers; + +use strict; +use warnings; +use AnyEvent; +use POSIX qw/strftime/; +use Exporter 'import'; +use DBI; + +our @EXPORT = qw | + long_periodic_tasks + short_periodic_tasks +|; + +################################################################################ +## tasks that are executed only once or twice per hour +################################################################################ +sub long_periodic_tasks { + my $self = shift; + my $num = 0; + + return AnyEvent->timer ( + after => 300, # 5 minutes grace time + interval => 1800, # execute every half hour + cb => sub { + + ## update Killing Floor stats + $self->read_kfstats(); + + # time spacer + my $t = 0; + + # clean out handles from the previous round (executed or not) + $self->{scope}->{sync} = (); + + ## Query Epic Games'-based UCC applets periodically to get an additional + ## list of online UT, Unreal (or other) game servers. + if ($self->{master_applet_enabled}) { + for my $ms (@{$self->{master_applet}}) { + + # add 3 second delay to spread network/server load + $self->{scope}->{sync}->{$t} = AnyEvent->timer( + after => 3*$t++, + cb => sub{$self->query_applet($ms)} + ); + } + } + + # do NOT reset $t, keep padding time -- you should not have more than 600 + # entries in applets/syncer in total. + + ## Request the masterlist for selected or all games from other + ## 333networks-based masterservers that uplinked to us and otherwise made + ## our list (config, manual entry, etc) + if ($self->{sync_enabled}) { + foreach my $ms (values %{$self->masterserver_list()}) { + + # add 3 second delay to spread network/server load + $self->{scope}->{sync}->{$t} = AnyEvent->timer( + after => 3*$t++, + cb => sub{$self->sync_with_master($ms) if ($ms->{tcp} > 0)} + ); + } + } + + # + # Also very long-running tasks, like once per day: + # + if ($num++ >= 47) { + # reset counter + $num = 0; + + # + # do database dump + # + my $time = strftime('%Y-%m-%d-%H-%M',localtime); + + # read db type from db login + my @db_type = split(':', $self->{dblogin}->[0]); + $db_type[2] =~ s/dbname=//; + + if ($db_type[1] eq "Pg") { + # use pg_dump to dump Postgresql databases + system("pg_dump $db_type[2] -U $self->{dblogin}->[1] > $self->{root}/data/dumps/$db_type[1]-$time.db"); + $self->log("dump", "Dumping database to /data/dumps/$db_type[1]-$time.db"); + } + } + + }, + ); +} + +################################################################################ +## tasks that are executed every few minutes +################################################################################ +sub short_periodic_tasks { + my $self = shift; + + return AnyEvent->timer ( + after => 10, + interval => 120, + cb => sub { + + ## update stats on direct beacons and total number of servers + $self->update_stats(); + + ## determine whether servers are still uplinking to us. If not, toggle. + $self->write_direct_beacons() if (defined $self->{firstrun}); + + ## delete old servers from the "pending" list (except for the first run) + $self->delete_old_pending() if (defined $self->{firstrun}); + + ## uplink to other 333networks masterservers with heartbeats, + ## that way we can index other masterservers too + $self->send_heartbeats(); + + # + # more short tasks? + # + }, + ); +} + +1; diff --git a/lib/MasterServer/Core/Secure.pm b/lib/MasterServer/Core/Secure.pm index 07e48b8..51d1832 100755 --- a/lib/MasterServer/Core/Secure.pm +++ b/lib/MasterServer/Core/Secure.pm @@ -8,11 +8,8 @@ use Exporter 'import'; our @EXPORT = qw| load_ciphers secure_string - validated_beacon - validated_request - validate_string - charshift - get_validate_string |; + validate_string + compare_challenge |; ################################################################################ ## Supported Games list ciphers @@ -21,7 +18,6 @@ our @EXPORT = qw| load_ciphers ## data/supportedgames.pl file. ## ## Only config files after 5 October 2015 work with this script. -## IMPORTANT! Afterwards, the $self->{game} hash will be cleared! ################################################################################ sub load_ciphers { my $self = shift; @@ -47,14 +43,13 @@ sub load_ciphers { $self->{dbh}->rollback; $self->halt(); } - } # commit $self->{dbh}->commit; $self->log("info", "Cipher database successfully updated!"); - # unload the game variables from memory + # unload the game variables from masterserver memory $self->{game} = undef; } @@ -78,82 +73,54 @@ sub secure_string { # authenticate the \validate\ response for the \secure\ challenge. # returns 1 on valid response, 0 on invalid ################################################################################ -sub validated_beacon { - my ($self, $gamename, $secure, $enctype, $validate) = @_; +sub compare_challenge { + my ($self, %o) = @_; # debugging enabled? Then don't care about validation return 1 if ($self->{debug_validate}); - # enctype given? - $enctype = 0 unless $enctype; + # secure string too long? (because vulnerable in UE) + return 0 if (length $o{secure} > 16); - if ($self->{ignore_beacon_key} =~ m/$gamename/i){ - $self->log("secure", "ignored beacon validation for $gamename"); - return 1; - } + # additional conditions to skip checking provided? + $o{ignore} = "" unless $o{ignore}; - # compare received response with expected response - return ($self->validate_string($gamename, $secure, $enctype) eq $validate) || 0; -} + # ignore this game if asked to do so + if ($o{ignore} =~ m/$o{gamename}/i){ + $self->log("secure", "ignored beacon validation for $o{gamename}"); + return 1; + } -################################################################################ -# authenticate the \validate\ response for the \secure\ challenge. -# returns 1 on valid response, 0 on invalid -################################################################################ -sub validated_request { - my ($self, $gamename, $secure, $enctype, $validate) = @_; - - # debugging enabled? Then don't care about validation - return 1 if ($self->{debug_validate}); + # enctype given? + $o{enctype} = 0 unless $o{enctype}; - # enctype given? - $enctype = 0 unless $enctype; + # get cipher corresponding with the gamename + my $cip = $self->get_game_props($o{gamename})->{cipher}; - # ignore games and beacons that are listed - if ($self->{ignore_browser_key} =~ m/$gamename/i){ - $self->log("secure", "ignored browser validation for $gamename"); - return 1; - } - - # compare received response with expected response - return ($self->validate_string($gamename, $secure, $enctype) eq $validate) || 0; + # calculate validate string + my $val = get_validate_string($cip, $o{secure}, $o{enctype}); + + # return whether or not they match + return ($val eq $o{validate}); } ################################################################################ -# process the validate string as a response to the secure challenge -# returns: validate string (usually 8 characters long) +# obtain the secure/validate challenge string ################################################################################ sub validate_string { - my ($self, $game, $sec, $enc) = @_; + my ($self, %o) = @_; - # get cipher from gamename - my $cip = $self->get_cipher($game); + # secure string too long? (because vulnerable in UE) + return 0 if (length $o{secure} > 16); - # don't accept challenge longer than 16 characters (because vulnerable in UE) - if (length $sec > 16) { - return "invalid!"} + # get cipher from gamename + my $cip = $self->get_game_props(lc $o{gamename})->{cipher}; - # check for valid encryption choices - my $enc_val = (defined $enc && 0 <= $enc && $enc <= 2) ? $enc : 0; + # enctype given? + $o{enctype} = 0 unless $o{enctype}; # calculate and return validate string - return $self->get_validate_string($cip, $sec, $enc_val); -} - -################################################################################ -# rotate characters as part of the secure/validate algorithm. -# arg and return: int (representing a character) -################################################################################ -sub charshift { - my ($self, $reg) = @_; - return($reg + 65) if ($reg < 26); - return($reg + 71) if ($reg < 52); - return($reg - 4) if ($reg < 62); - return(43) if ($reg == 62); - return(47) if ($reg == 63); - - # if all else fails - return(0); + return get_validate_string($cip, $o{secure}, $o{enctype}); } ################################################################################ @@ -166,14 +133,15 @@ sub charshift { # was released under the GNU General Public License, for more information, see # the original software at http://aluigi.altervista.org/papers.htm#gsmsalg # -# conversion and modification of the algorithm by Darkelarious, June 2014. +# conversion and modification of the algorithm by Darkelarious, June 2014 with +# explicit, written permission of Luigi Auriemma. # # args: game cipher, 6-char challenge string, encryption type # returns: validate string (usually 8 characters long) # !! requires cipher hash to be configured in config! (imported or otherwise) ################################################################################ sub get_validate_string { - my ($self, $cipher_string, $secure_string, $enctype) = @_; + my ($cipher_string, $secure_string, $enctype) = @_; # use pre-built rotations for enctype # -- see GSMSALG 0.3.3 reference for copyright and more information @@ -245,7 +213,7 @@ sub get_validate_string { $tmp[$i] = $sec[$i] ^ $enc[($l + $m) & 0xff]; } -# part of the enctype 1-2 process + # part of the enctype 1-2 process for($sec_len = $i; $sec_len % 3; $sec_len++) { $tmp[$sec_len] = 0; } @@ -270,10 +238,10 @@ sub get_validate_string { $m = $m % 256; $n = $tmp[$i + 2]; $n = $n % 256; - $val[$p++] = $self->charshift($l >> 2); - $val[$p++] = $self->charshift((($l & 3 ) << 4) | ($m >> 4)); - $val[$p++] = $self->charshift((($m & 15) << 2) | ($n >> 6)); - $val[$p++] = $self->charshift($n & 63); + $val[$p++] = charshift($l >> 2); + $val[$p++] = charshift((($l & 3 ) << 4) | ($m >> 4)); + $val[$p++] = charshift((($m & 15) << 2) | ($n >> 6)); + $val[$p++] = charshift($n & 63); } # return to ascii characters @@ -283,4 +251,20 @@ sub get_validate_string { return $str; } +################################################################################ +# rotate characters as part of the secure/validate algorithm. +# arg and return: int (representing a character) +################################################################################ +sub charshift { + my $reg = shift; + return($reg + 65) if ($reg < 26); + return($reg + 71) if ($reg < 52); + return($reg - 4) if ($reg < 62); + return(43) if ($reg == 62); + return(47) if ($reg == 63); + + # if all else fails + return(0); +} + 1; diff --git a/lib/MasterServer/Core/Stats.pm b/lib/MasterServer/Core/Stats.pm new file mode 100755 index 0000000..25044e8 --- /dev/null +++ b/lib/MasterServer/Core/Stats.pm @@ -0,0 +1,39 @@ + +package MasterServer::Core::Stats; + +use strict; +use warnings; +use AnyEvent::IO; +use Exporter 'import'; + +our @EXPORT = qw| update_stats |; + +################################################################################ +# Update statistics on servers and update the games table with those values +################################################################################ +sub update_stats { + my $self = shift; + + # get all gamenames where there is one or more servers online and update the + # stats per gamename. + my $games = $self->get_gamelist_stats(); + + # iterate through available stats + for my $e (@{$games}) { + + # extract gamename, number of direct uplinks and total servers + my %opt = (); + $opt{gamename} = $e->[0]; + $opt{num_uplink} = $e->[1]; + $opt{num_total} = $e->[2]; + + # write to DB + $self->write_stat(%opt); + } + + #done + $self->log("stat", "Updated all game statistics."); + +} + +1; diff --git a/lib/MasterServer/Core/Util.pm b/lib/MasterServer/Core/Util.pm index af3a551..4f64fe1 100755 --- a/lib/MasterServer/Core/Util.pm +++ b/lib/MasterServer/Core/Util.pm @@ -4,10 +4,11 @@ package MasterServer::Core::Util; use strict; use warnings; use IP::Country::Fast; +use Socket; use POSIX qw/strftime/; use Exporter 'import'; -our @EXPORT = qw| ip2country countryflag valid_address |; +our @EXPORT = qw| ip2country host2ip valid_address db_all sqlprint |; ################################################################################ ## return the abbreviated country name based on IP @@ -19,23 +20,24 @@ sub ip2country { } ################################################################################ -## return the flag of a country +## return IP of a hostname ################################################################################ -sub countryflag { - my ($self, $country) = @_; - # placeholder function to return the flag of a country +sub host2ip { + my ($self, $name) = @_; + return inet_ntoa(inet_aton($name)) if $name; } + ################################################################################ ## Verify whether a given domain name or IP address and port are valid. -## returns 1/0 if valid/invalid ip + port +## returns 1/0 if valid/invalid ip + port. IPv4 ONLY! ################################################################################ sub valid_address { my ($self, $a, $p) = @_; - + # check if ip and port are in valid range - my $val_addr = ($a =~ '\b(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\b'); - my $val_port = (0 < $p && $p <= 65535); + my $val_addr = ($a =~ '\b(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\b') if $a; + my $val_port = (0 < $p && $p <= 65535) if $p; # exclude addresses where we don't want people sniffing for (qw|192.168.(.\d*).(.\d*) 127.0.(.\d*).(.\d*) 10.0.(.\d*).(.\d*)|){$val_addr = 0 if ($a =~ m/$_/)} @@ -44,4 +46,73 @@ sub valid_address { return ($val_addr && $val_port); } +################################################################################ +# Adaptation of TUWF's dbAll sql function +################################################################################ +sub db_all { + my $self = shift; + my $sqlq = shift; + my $s = $self->{dbh}; + + $sqlq =~ s/\r?\n/ /g; + $sqlq =~ s/ +/ /g; + my(@q) = @_ ? sqlprint($sqlq, @_) : ($sqlq); + + my($q, $r); + my $ret = eval { + $q = $s->prepare($q[0]); + $q->execute($#q ? @q[1..$#q] : ()); + $r = $q->fetchall_arrayref({}); + $q->finish(); + 1; + }; + + $r = [] if (!$r || ref($r) ne 'ARRAY'); + return $r; +} + +################################################################################ +# sqlprint (TUWF): +# ? normal placeholder +# !l list of placeholders, expects arrayref +# !H list of SET-items, expects hashref or arrayref: format => (bind_value || \@bind_values) +# !W same as !H, but for WHERE clauses (AND'ed together) +# !s the classic sprintf %s, use with care +# This isn't sprintf, so all other things won't work, +# Only the ? placeholder is supported, so no dollar sign numbers or named placeholders +################################################################################ +sub sqlprint { # query, bind values. Returns new query + bind values + + my @a; + my $q=''; + for my $p (split /(\?|![lHWs])/, shift) { + next if !defined $p; + if($p eq '?') { + push @a, shift; + $q .= $p; + } elsif($p eq '!s') { + $q .= shift; + } elsif($p eq '!l') { + my $l = shift; + $q .= join ', ', map '?', 0..$#$l; + push @a, @$l; + } elsif($p eq '!H' || $p eq '!W') { + my $h=shift; + my @h=ref $h eq 'HASH' ? %$h : @$h; + my @r; + while(my($k,$v) = (shift(@h), shift(@h))) { + last if !defined $k; + my($n,@l) = sqlprint($k, ref $v eq 'ARRAY' ? @$v : $v); + push @r, $n; + push @a, @l; + } + $q .= ($p eq '!W' ? 'WHERE ' : 'SET ').join $p eq '!W' ? ' AND ' : ', ', @r + if @r; + } else { + $q .= $p; + } + } + return($q, @a); +} + 1; diff --git a/lib/MasterServer/Core/Version.pm b/lib/MasterServer/Core/Version.pm index ccf9491..bf12f21 100755 --- a/lib/MasterServer/Core/Version.pm +++ b/lib/MasterServer/Core/Version.pm @@ -23,17 +23,20 @@ sub version { # these fields does not count as a significant alteration. # # -- addition to the LICENCE, you are only allowed to modify these lines - # if you send Darkelarious a postcard or email with your compliments. + # if you send Darkelarious a postcard or (e)mail with your compliments. # # master type - $self->{build_type} = "333networks Masterserver-Perl (Pg-SQLite-MySQL) 20151108209"; + $self->{build_type} = "333networks Masterserver-Perl pre-release"; # version - $self->{build_version} = "2.0.9"; + $self->{build_version} = "2.2.4"; + + # short version for uplinks + $self->{short_version} = "MS-perl $self->{build_version}"; # date yyyy-mm-dd - $self->{build_date} = "2015-11-08"; + $self->{build_date} = "2016-11-17"; #author, email $self->{build_author} = "Darkelarious, darkelarious\@333networks.com"; diff --git a/lib/MasterServer/Database/Pg/dbBeacon.pm b/lib/MasterServer/Database/Pg/dbBeacon.pm deleted file mode 100755 index 735eaf9..0000000 --- a/lib/MasterServer/Database/Pg/dbBeacon.pm +++ /dev/null @@ -1,203 +0,0 @@ - -package MasterServer::Database::Pg::dbBeacon; - -use strict; -use warnings; -use Exporter 'import'; - -our @EXPORT = qw| add_beacon - add_pending - remove_pending - get_pending_beacon - get_pending_info - get_next_pending |; - -################################################################################ -## Update beacon in serverlist or pending list. Add if beacon does not exist in -## either list. Return 0,1,2 if success in adding or -1 on error. -################################################################################ -sub add_beacon { - my ($self, $ip, $beaconport, $heartbeat, $gamename, $secure) = @_; - - # if address is in list, update the timestamp - my $u = $self->{dbh}->do( - "UPDATE serverlist - SET beacon = NOW(), - updated = NOW(), - gamename = ?, - b333ms = TRUE - WHERE ip = ? - AND port = ?", - undef, lc $gamename, $ip, $heartbeat); - - # notify - $self->log("update", "beacon heartbeat for $ip:$heartbeat") if ($u > 0); - - # if serverlist was updated return 0 - return 0 if ($u > 0); - - # if it is already in the pending list, update it with a new challenge - $u = $self->{dbh}->do( - "UPDATE pending - SET added = NOW(), - beaconport = ?, - gamename = ?, - secure = ? - WHERE ip = ? - AND heartbeat = ?", - undef, $beaconport, lc $gamename, $secure, $ip, $heartbeat); - - # notify - $self->log("update", "beacon heartbeat $ip:$beaconport pending $gamename:$heartbeat") if ($u > 0); - - # beacon was already in pending list and was updated - return 1 if ($u > 0); - - # if not found, add it - $u = $self->{dbh}->do( - "INSERT INTO pending ( - ip, - beaconport, - heartbeat, - gamename, - secure) - SELECT ?, ?, ?, ?, ?", - undef, $ip, $beaconport, $heartbeat, lc $gamename, $secure); - - # notify - $self->log("add", "beacon heartbeat $ip:$beaconport pending $gamename:$heartbeat") if ($u > 0); - - # it was added to pending - return 2 if ($u > 0); - - # or else report error - $self->log("error", "an error occurred adding beacon $ip:$beaconport with $gamename:$heartbeat to the pending list"); - return -1; -} - -################################################################################ -## Add an address to the database that was obtained via a method other than -## an udp beacon. Return 0,1,2 if success in adding or -1 on error. -################################################################################ -sub add_pending { - my ($self, $ip, $port, $gamename, $secure) = @_; - - # if address is in list, update the timestamp - my $u = $self->{dbh}->do( - "UPDATE serverlist - SET updated = NOW() - WHERE ip = ? - AND port = ?", - undef, $ip, $port); - - # notify - $self->log("update", "updated serverlist with $ip:$port") if ($u > 0); - - # if updated, return 0 - return 0 if ($u > 0); - - # if it is already in the pending list, update it with a new challenge - $u = $self->{dbh}->do( - "UPDATE pending - SET added = NOW(), - secure = ? - WHERE ip = ? - AND heartbeat = ?", - undef, $secure, $ip, $port); - - # notify - $self->log("update", "updated pending with $ip:$port") if ($u > 0); - - # return 1 if updated - return 1 if ($u > 0); - - # if not found, add it - $u = $self->{dbh}->do( - "INSERT INTO pending ( - ip, - heartbeat, - gamename, - secure) - SELECT ?, ?, ?, ?", - undef, $ip, $port, $gamename, $secure); - - # notify - $self->log("add", "$ip:$port added pending $gamename") if ($u > 0); - - # return 2 if added new - return 2 if ($u > 0); - - # else - return -1; -} - -################################################################################ -## Remove an entry from the pending list. Returns 0 if removed or -1 in case -## of error(s). -################################################################################ -sub remove_pending { - my ($self, $id) = @_; - - # if address is in list, update the timestamp - my $u = $self->{dbh}->do( - "DELETE FROM pending - WHERE id = ?", - undef, $id); - - # notify - $self->log("delete", "removed pending id $id from pending") if ($u > 0); - - # it was removed from pending - return 2 if ($u > 0); - - # or else report error - $self->log("error", "error deleting server $id from pending"); - return -1; -} - -################################################################################ -## Get pending server by ip, beacon port. Returns * or undef -################################################################################ -sub get_pending_beacon { - my ($self, $ip, $port) = @_; - - # if address is in list, update the timestamp - return $self->{dbh}->selectall_arrayref( - "SELECT * FROM pending - WHERE ip = ? - AND beaconport = ?", - undef, $ip, $port)->[0]; -} - -################################################################################ -## Get pending server by ip, heartbeat port. Returns * or undef -################################################################################ -sub get_pending_info { - my ($self, $ip, $port) = @_; - - # if address is in list, update the timestamp - return $self->{dbh}->selectall_arrayref( - "SELECT * FROM pending - WHERE ip = ? - AND heartbeat = ?", - undef, $ip, $port)->[0]; -} - -################################################################################ -## Get server info from any entry with an id higher than the provided one. The -## server is added to pending at least 15 seconds ago. Returns info or undef. -################################################################################ -sub get_next_pending { - my ($self, $id) = @_; - - # get 1 pending id that is older than 15s - return $self->{dbh}->selectall_arrayref( - "SELECT id, ip, heartbeat, secure FROM pending - WHERE added < (NOW() - INTERVAL '15 SECONDS') - AND id > ? - ORDER BY id ASC LIMIT 1", - undef, $id)->[0]; -} - - -1; diff --git a/lib/MasterServer/Database/Pg/dbCiphers.pm b/lib/MasterServer/Database/Pg/dbCiphers.pm deleted file mode 100755 index e2e8191..0000000 --- a/lib/MasterServer/Database/Pg/dbCiphers.pm +++ /dev/null @@ -1,98 +0,0 @@ - -package MasterServer::Database::Pg::dbCiphers; - -use strict; -use warnings; -use Exporter 'import'; - -our @EXPORT = qw| clear_ciphers - insert_cipher - get_cipher - get_default_port |; - -################################################################################ -## Clear all existing ciphers from the database -################################################################################ -sub clear_ciphers { - my $self = shift; - - # delete ALL entries - my $u = $self->{dbh}->do("DELETE FROM games"); - - # notify - $self->log("delete", "Removed all ciphers") if ($u > 0); - - # removed from games - return 2 if ($u > 0); - - # or else report notice - $self->log("notice", "No ciphers deleted!"); - return -1; - -} - -################################################################################ -## Insert the list of supported games and their ciphers / default ports / -## descriptions included from the data/supportedgames.pl file. -################################################################################ -sub insert_cipher { - my ($self, %opt) = @_; - - # insert a single cipher/key combo - my $u = $self->{dbh}->do( - "INSERT INTO games ( - gamename, - cipher, - description, - default_qport) - VALUES(?, ?, ?, ?)", undef, - $opt{gamename}, $opt{cipher}, $opt{description}, $opt{default_qport}); - - # notify - $self->log("add", "Added cipher for $opt{gamename}") if ($u and $u > 0); - return 1 if ($u and $u > 0); - - # or else report error - $self->log("error", "An error occurred adding a cipher for $opt{gamename}"); - return -1; - -} - - -################################################################################ -## get the cipher that goes with gamename -################################################################################ -sub get_cipher { - my ($self, $gn) = @_; - - # no gamename specified? "undef" is not a known cipher, so send that instead. - return 'undef' if !$gn; - - # get cipher from db if gamename exists - my $cipher = $self->{dbh}->selectall_arrayref( - 'SELECT cipher FROM games WHERE gamename = ?', undef, - lc $gn)->[0]->[0]; - - # return a non-zero-length string - return ($cipher ? $cipher : 'undef'); -} - -################################################################################ -## get the default query port that goes with gamename -################################################################################ -sub get_default_port { - my ($self, $gn) = @_; - - # no gamename specified? default port is 0 - return 0 if !$gn; - - # get port from db if gamename exists - my $p = $self->{dbh}->selectall_arrayref( - 'SELECT default_qport FROM games WHERE gamename = ?', undef, - lc $gn)->[0]->[0]; - - # return port or zero - return $p || 0; -} - -1; diff --git a/lib/MasterServer/Database/Pg/dbClientList.pm b/lib/MasterServer/Database/Pg/dbClientList.pm deleted file mode 100755 index 718bf8a..0000000 --- a/lib/MasterServer/Database/Pg/dbClientList.pm +++ /dev/null @@ -1,45 +0,0 @@ - -package MasterServer::Database::Pg::dbClientList; - -use strict; -use warnings; -use Exporter 'import'; - -our @EXPORT = qw| get_gamenames - get_game_list |; - - -################################################################################ -## get a list of distinct gamenames currently in the database. it does not -## matter whether they are recent or old, as long as the game is currently in -## the database. -## -## returns: hashref of gamenames -################################################################################ -sub get_gamenames { - my $self = shift; - - return $self->{dbh}->selectall_arrayref( - "SELECT distinct gamename - FROM serverlist"); -} - -################################################################################ -## get the list of games of a certain $gamename, excluding the ones excempted -## via the blacklist -## only returns server addresses that are no more than 1 hours old -################################################################################ -sub get_game_list { - my ($self, $gamename) = @_; - - return $self->{dbh}->selectall_arrayref( - "SELECT ip, port - FROM serverlist - WHERE updated > (NOW() - INTERVAL '1 HOUR') - AND gamename = ? - AND NOT blacklisted", - undef, lc $gamename); -} - - -1; diff --git a/lib/MasterServer/Database/Pg/dbCore.pm b/lib/MasterServer/Database/Pg/dbCore.pm deleted file mode 100755 index 5cd194b..0000000 --- a/lib/MasterServer/Database/Pg/dbCore.pm +++ /dev/null @@ -1,44 +0,0 @@ - -package MasterServer::Database::Pg::dbCore; - -use strict; -use warnings; -use Exporter 'import'; - -our @EXPORT = qw| database_login |; - -################################################################################ -## login to the database with credentials provided in the config file. -## returns dbh object or quits application on error. -################################################################################ -sub database_login { - my $self = shift; - - # create the dbi object - my $dbh = DBI->connect(@{$self->{dblogin}}, {PrintError => $self->{db_print}}); - - # verify that the database connected - if (defined $dbh) { - - # log the event - $self->log("load","Connected to the Postgres database."); - - # turn on error printing - $dbh->{printerror} = 1; - - # return the dbi object for further use - return $dbh; - } - else { - # fatal error - $self->log("fatal", "$DBI::errstr!"); - - # end program - $self->halt(); - } - - # unreachable - return undef; -} - -1; diff --git a/lib/MasterServer/Database/Pg/dbServerlist.pm b/lib/MasterServer/Database/Pg/dbServerlist.pm deleted file mode 100755 index 5a58717..0000000 --- a/lib/MasterServer/Database/Pg/dbServerlist.pm +++ /dev/null @@ -1,152 +0,0 @@ - -package MasterServer::Database::Pg::dbServerlist; - -use strict; -use warnings; -use Exporter 'import'; - -our @EXPORT = qw| add_to_serverlist - update_serverlist - syncer_add - get_next_server |; - -################################################################################ -## beacon was verified or otherwise accepted and will now be added to the -## serverlist. -################################################################################ -sub add_to_serverlist { - my ($self, $ip, $port, $gamename) = @_; - - # update or add server to serverlist - my $u = $self->{dbh}->do("UPDATE serverlist - SET updated = NOW() - WHERE ip = ? - AND port = ?", - undef, $ip, $port); - - # notify - $self->log("update", "$ip:$port timestamp updated") if ($u > 0); - - # if found, updated; done - return 0 if ($u > 0); - - # if not found, add it. - $u = $self->{dbh}->do("INSERT INTO serverlist (ip, port, gamename, country) - SELECT ?, ?, ?, ?", - undef, $ip, $port, $gamename, $self->ip2country($ip)); - - # notify - $self->log("add", "$ip:$port added to serverlist") if ($u > 0); - - # return added - return 1 if ($u > 0); - - # or else report error - $self->log("error", "an error occurred adding server $ip:$port ($gamename) to the serverlist"); - return -1; -} - -################################################################################ -## same as add_to_serverlist above, but does not add the server to serverlist -## if it does not exist in serverlist. it must be added by another function -## first. -################################################################################ -sub update_serverlist { - my ($self, $ip, $port, $s) = @_; - - # update server info - my $u = $self->{dbh}->do( - 'UPDATE serverlist - SET updated = NOW(), - gamename = ?, - gamever = ?, - hostname = ?, - hostport = ? - WHERE ip = ? - AND port = ?', undef, - $s->{gamename}, $s->{gamever}, $s->{hostname}, $s->{hostport}, - $ip, $port); - - # notify - $self->log("update", "server $ip:$port info updated") if ($u > 0); - - # return 0 if updated - return 0 if ($u > 0); - - # or else report error - $self->log("error", "an error occurred updating server $ip:$port in the serverlist"); - return -1; -} - - -################################################################################ -## add new addresses to the pending list, but do not update timestamps. masters -## that sync with each other would otherwise update the timestamp for a server -## which is no longer online. -################################################################################ -sub syncer_add { - my ($self, $ip, $port, $gamename, $secure) = @_; - - # if address is in list, update the timestamp - my $u = $self->{dbh}->do( - "SELECT * FROM serverlist - WHERE ip = ? - AND port = ?", - undef, $ip, $port); - - # notify - $self->log("read","syncer found entry for $ip:$port") if ($u > 0); - - # if found, return 0 - return 0 if ($u > 0); - - # if it is already in the pending list, update it with a new challenge - $u = $self->{dbh}->do( - "UPDATE pending - SET secure = ? - WHERE ip = ? - AND heartbeat = ?", - undef, $secure, $ip, $port); - - # notify - $self->log("update","$ip:$port was updated by syncer", - $self->{log_settings}->{db_updated}) if ($u > 0); - - # return 1 if found - return 1 if ($u > 0); - - # if not found, add it - $u = $self->{dbh}->do( - "INSERT INTO pending (ip, heartbeat, gamename, secure) - SELECT ?, ?, ?, ?", - undef, $ip, $port, $gamename, $secure); - - # notify - $self->log("add","beacon: $ip:$port was added for $gamename after sync") if ($u > 0); - - # return 2 if added new - return 2 if ($u > 0); - - # or else report error - $self->log("error", "an error occurred adding $ip:$port after sync"); - return -1; -} - -################################################################################ -## get a server address of the next server in line to be queried for game info. -## query must be older than 30 seconds (in case it just got added) and not -## older than 3 hours. -################################################################################ -sub get_next_server { - my ($self, $id) = @_; - - return $self->{dbh}->selectall_arrayref( - "SELECT id, ip, port FROM serverlist - WHERE added < (NOW() - INTERVAL '15 SECONDS') - AND updated > (NOW() - INTERVAL '3 HOUR') - AND id > ? - AND NOT blacklisted - ORDER BY id ASC LIMIT 1", undef, $id)->[0]; -} - -1; diff --git a/lib/MasterServer/Database/SQLite/dbBeacon.pm b/lib/MasterServer/Database/SQLite/dbBeacon.pm deleted file mode 100755 index 09eeec3..0000000 --- a/lib/MasterServer/Database/SQLite/dbBeacon.pm +++ /dev/null @@ -1,203 +0,0 @@ - -package MasterServer::Database::SQLite::dbBeacon; - -use strict; -use warnings; -use Exporter 'import'; - -our @EXPORT = qw| add_beacon - add_pending - remove_pending - get_pending_beacon - get_pending_info - get_next_pending |; - -################################################################################ -## Update beacon in serverlist or pending list. Add if beacon does not exist in -## either list. Return 0,1,2 if success in adding or -1 on error. -################################################################################ -sub add_beacon { - my ($self, $ip, $beaconport, $heartbeat, $gamename, $secure) = @_; - - # if address is in list, update the timestamp - my $u = $self->{dbh}->do( - "UPDATE serverlist - SET beacon = CURRENT_TIMESTAMP, - updated = CURRENT_TIMESTAMP, - gamename = ?, - b333ms = 1 - WHERE ip = ? - AND port = ?", - undef, lc $gamename, $ip, $heartbeat); - - # notify - $self->log("update", "beacon heartbeat for $ip:$heartbeat") if ($u > 0); - - # if serverlist was updated return 0 - return 0 if ($u > 0); - - # if it is already in the pending list, update it with a new challenge - $u = $self->{dbh}->do( - "UPDATE pending - SET added = CURRENT_TIMESTAMP, - beaconport = ?, - gamename = ?, - secure = ? - WHERE ip = ? - AND heartbeat = ?", - undef, $beaconport, lc $gamename, $secure, $ip, $heartbeat); - - # notify - $self->log("update", "beacon heartbeat $ip:$beaconport pending $gamename:$heartbeat") if ($u > 0); - - # beacon was already in pending list and was updated - return 1 if ($u > 0); - - # if not found, add it - $u = $self->{dbh}->do( - "INSERT INTO pending ( - ip, - beaconport, - heartbeat, - gamename, - secure) - SELECT ?, ?, ?, ?, ?", - undef, $ip, $beaconport, $heartbeat, lc $gamename, $secure); - - # notify - $self->log("add", "beacon heartbeat $ip:$beaconport pending $gamename:$heartbeat") if ($u > 0); - - # it was added to pending - return 2 if ($u > 0); - - # or else report error - $self->log("error", "an error occurred adding beacon $ip:$beaconport with $gamename:$heartbeat to the pending list"); - return -1; -} - -################################################################################ -## Add an address to the database that was obtained via a method other than -## an udp beacon. Return 0,1,2 if success in adding or -1 on error. -################################################################################ -sub add_pending { - my ($self, $ip, $port, $gamename, $secure) = @_; - - # if address is in list, update the timestamp - my $u = $self->{dbh}->do( - "UPDATE serverlist - SET updated = CURRENT_TIMESTAMP - WHERE ip = ? - AND port = ?", - undef, $ip, $port); - - # notify - $self->log("update", "updated serverlist with $ip:$port") if ($u > 0); - - # if updated, return 0 - return 0 if ($u > 0); - - # if it is already in the pending list, update it with a new challenge - $u = $self->{dbh}->do( - "UPDATE pending - SET added = CURRENT_TIMESTAMP, - secure = ? - WHERE ip = ? - AND heartbeat = ?", - undef, $secure, $ip, $port); - - # notify - $self->log("update", "updated pending with $ip:$port") if ($u > 0); - - # return 1 if updated - return 1 if ($u > 0); - - # if not found, add it - $u = $self->{dbh}->do( - "INSERT INTO pending ( - ip, - heartbeat, - gamename, - secure) - SELECT ?, ?, ?, ?", - undef, $ip, $port, $gamename, $secure); - - # notify - $self->log("add", "$ip:$port added pending $gamename") if ($u > 0); - - # return 2 if added new - return 2 if ($u > 0); - - # else - return -1; -} - -################################################################################ -## Remove an entry from the pending list. Returns 0 if removed or -1 in case -## of error(s). -################################################################################ -sub remove_pending { - my ($self, $id) = @_; - - # if address is in list, update the timestamp - my $u = $self->{dbh}->do( - "DELETE FROM pending - WHERE id = ?", - undef, $id); - - # notify - $self->log("delete", "removed pending id $id from pending") if ($u > 0); - - # it was removed from pending - return 2 if ($u > 0); - - # or else report error - $self->log("error", "error deleting server $id from pending"); - return -1; -} - -################################################################################ -## Get pending server by ip, beacon port. Returns * or undef -################################################################################ -sub get_pending_beacon { - my ($self, $ip, $port) = @_; - - # if address is in list, update the timestamp - return $self->{dbh}->selectall_arrayref( - "SELECT * FROM pending - WHERE ip = ? - AND beaconport = ?", - undef, $ip, $port)->[0]; -} - -################################################################################ -## Get pending server by ip, heartbeat port. Returns * or undef -################################################################################ -sub get_pending_info { - my ($self, $ip, $port) = @_; - - # if address is in list, update the timestamp - return $self->{dbh}->selectall_arrayref( - "SELECT * FROM pending - WHERE ip = ? - AND heartbeat = ?", - undef, $ip, $port)->[0]; -} - -################################################################################ -## Get server info from any entry with an id higher than the provided one. The -## server is added to pending at least 15 seconds ago. Returns info or undef. -################################################################################ -sub get_next_pending { - my ($self, $id) = @_; - - # get 1 pending id that is older than 15s - return $self->{dbh}->selectall_arrayref( - "SELECT id, ip, heartbeat, secure FROM pending - WHERE added < datetime(CURRENT_TIMESTAMP, '-15 seconds') - AND id > ? - ORDER BY id ASC LIMIT 1", - undef, $id)->[0]; -} - - -1; diff --git a/lib/MasterServer/Database/SQLite/dbCiphers.pm b/lib/MasterServer/Database/SQLite/dbCiphers.pm deleted file mode 100755 index 0dc388d..0000000 --- a/lib/MasterServer/Database/SQLite/dbCiphers.pm +++ /dev/null @@ -1,98 +0,0 @@ - -package MasterServer::Database::SQLite::dbCiphers; - -use strict; -use warnings; -use Exporter 'import'; - -our @EXPORT = qw| clear_ciphers - insert_cipher - get_cipher - get_default_port |; - -################################################################################ -## Clear all existing ciphers from the database -################################################################################ -sub clear_ciphers { - my $self = shift; - - # delete ALL entries - my $u = $self->{dbh}->do("DELETE FROM games"); - - # notify - $self->log("delete", "Removed all ciphers") if ($u > 0); - - # removed from games - return 2 if ($u > 0); - - # or else report notice - $self->log("notice", "No ciphers deleted!"); - return -1; - -} - -################################################################################ -## Insert the list of supported games and their ciphers / default ports / -## descriptions included from the data/supportedgames.pl file. -################################################################################ -sub insert_cipher { - my ($self, %opt) = @_; - - # insert a single cipher/key combo - my $u = $self->{dbh}->do( - "INSERT INTO games ( - gamename, - cipher, - description, - default_qport) - VALUES(?, ?, ?, ?)", undef, - $opt{gamename}, $opt{cipher}, $opt{description}, $opt{default_qport}); - - # notify - $self->log("add", "Added cipher for $opt{gamename}") if ($u and $u > 0); - return 1 if ($u and $u > 0); - - # or else report error - $self->log("error", "An error occurred adding a cipher for $opt{gamename}"); - return -1; - -} - - -################################################################################ -## get the cipher that goes with gamename -################################################################################ -sub get_cipher { - my ($self, $gn) = @_; - - # no gamename specified? "undef" is not a known cipher, so send that instead. - return 'undef' if !$gn; - - # get cipher from db if gamename exists - my $cipher = $self->{dbh}->selectall_arrayref( - 'SELECT cipher FROM games WHERE gamename = ?', undef, - lc $gn)->[0]->[0]; - - # return a non-zero-length string - return ($cipher ? $cipher : 'undef'); -} - -################################################################################ -## get the default query port that goes with gamename -################################################################################ -sub get_default_port { - my ($self, $gn) = @_; - - # no gamename specified? default port is 0 - return 0 if !$gn; - - # get port from db if gamename exists - my $p = $self->{dbh}->selectall_arrayref( - 'SELECT default_qport FROM games WHERE gamename = ?', undef, - lc $gn)->[0]->[0]; - - # return port or zero - return $p || 0; -} - -1; diff --git a/lib/MasterServer/Database/SQLite/dbClientList.pm b/lib/MasterServer/Database/SQLite/dbClientList.pm deleted file mode 100755 index 58c1392..0000000 --- a/lib/MasterServer/Database/SQLite/dbClientList.pm +++ /dev/null @@ -1,45 +0,0 @@ - -package MasterServer::Database::SQLite::dbClientList; - -use strict; -use warnings; -use Exporter 'import'; - -our @EXPORT = qw| get_gamenames - get_game_list |; - - -################################################################################ -## get a list of distinct gamenames currently in the database. it does not -## matter whether they are recent or old, as long as the game is currently in -## the database. -## -## returns: hashref of gamenames -################################################################################ -sub get_gamenames { - my $self = shift; - - return $self->{dbh}->selectall_arrayref( - "SELECT distinct gamename - FROM serverlist"); -} - -################################################################################ -## get the list of games of a certain $gamename, excluding the ones excempted -## via the blacklist -## only returns server addresses that are no more than 1 hours old -################################################################################ -sub get_game_list { - my ($self, $gamename) = @_; - - return $self->{dbh}->selectall_arrayref( - "SELECT ip, port - FROM serverlist - WHERE updated > datetime(CURRENT_TIMESTAMP, '-3600 seconds') - AND gamename = ? - AND NOT blacklisted", - undef, lc $gamename); -} - - -1; diff --git a/lib/MasterServer/Database/SQLite/dbCore.pm b/lib/MasterServer/Database/SQLite/dbCore.pm deleted file mode 100755 index 27c9b35..0000000 --- a/lib/MasterServer/Database/SQLite/dbCore.pm +++ /dev/null @@ -1,66 +0,0 @@ - -package MasterServer::Database::SQLite::dbCore; - -use strict; -use warnings; -use Exporter 'import'; - -our @EXPORT = qw| database_login |; - -################################################################################ -## login to the database with credentials provided in the config file. -## returns dbh object or quits application on error. -################################################################################ -sub database_login { - my $self = shift; - - # check if database file exists - my $db_file = [split(':', $self->{dblogin}->[0])]->[2]; - $db_file =~ s/dbname=//i; - - unless (-e $db_file) { - # fatal error - $self->log("fatal", "Database file $db_file does not exist!"); - - # end program - $self->halt(); - } - - # create the dbi object - my $dbh = DBI->connect(@{$self->{dblogin}}, {PrintError => $self->{db_print}}); - - # verify that the database connected - if (defined $dbh) { - # log the event - $self->log("load","Connected to the SQLite database."); - - # turn on error printing - $dbh->{printerror} = 1; - - # synchronous read/writing to the sql file OFF. That means: when the script - # shuts down unexpectedly, i.e. because of power failure or a crash, changes - # to the database are NOT SAVED. However, if this setting is not turned OFF, - # it takes too long to write to the database, which means that new beacons, - # requests and servers cannot be processed. You don't have a choice, really.. - $dbh->do("PRAGMA synchronous = OFF"); - - # allow the use of foreign keys (referencing) - $dbh->do("PRAGMA foreign_keys = ON"); - - # return the dbi object for further use - return $dbh; - } - else { - # fatal error - $self->log("fatal", "$DBI::errstr!"); - - # end program - $self->halt(); - } - - # unreachable - return undef; - -} - -1; diff --git a/lib/MasterServer/Database/SQLite/dbServerlist.pm b/lib/MasterServer/Database/SQLite/dbServerlist.pm deleted file mode 100755 index 436a788..0000000 --- a/lib/MasterServer/Database/SQLite/dbServerlist.pm +++ /dev/null @@ -1,152 +0,0 @@ - -package MasterServer::Database::SQLite::dbServerlist; - -use strict; -use warnings; -use Exporter 'import'; - -our @EXPORT = qw| add_to_serverlist - update_serverlist - syncer_add - get_next_server |; - -################################################################################ -## beacon was verified or otherwise accepted and will now be added to the -## serverlist. -################################################################################ -sub add_to_serverlist { - my ($self, $ip, $port, $gamename) = @_; - - # update or add server to serverlist - my $u = $self->{dbh}->do("UPDATE serverlist - SET updated = CURRENT_TIMESTAMP - WHERE ip = ? - AND port = ?", - undef, $ip, $port); - - # notify - $self->log("update", "$ip:$port timestamp updated") if ($u > 0); - - # if found, updated; done - return 0 if ($u > 0); - - # if not found, add it. - $u = $self->{dbh}->do("INSERT INTO serverlist (ip, port, gamename, country) - SELECT ?, ?, ?, ?", - undef, $ip, $port, $gamename, $self->ip2country($ip)); - - # notify - $self->log("add", "$ip:$port added to serverlist") if ($u > 0); - - # return added - return 1 if ($u > 0); - - # or else report error - $self->log("error", "an error occurred adding server $ip:$port ($gamename) to the serverlist"); - return -1; -} - -################################################################################ -## same as add_to_serverlist above, but does not add the server to serverlist -## if it does not exist in serverlist. it must be added by another function -## first. -################################################################################ -sub update_serverlist { - my ($self, $ip, $port, $s) = @_; - - # update server info - my $u = $self->{dbh}->do( - 'UPDATE serverlist - SET updated = CURRENT_TIMESTAMP, - gamename = ?, - gamever = ?, - hostname = ?, - hostport = ? - WHERE ip = ? - AND port = ?', undef, - $s->{gamename}, $s->{gamever}, $s->{hostname}, $s->{hostport}, - $ip, $port); - - # notify - $self->log("update", "server $ip:$port info updated") if ($u > 0); - - # return 0 if updated - return 0 if ($u > 0); - - # or else report error - $self->log("error", "an error occurred updating server $ip:$port in the serverlist"); - return -1; -} - - -################################################################################ -## add new addresses to the pending list, but do not update timestamps. masters -## that sync with each other would otherwise update the timestamp for a server -## which is no longer online. -################################################################################ -sub syncer_add { - my ($self, $ip, $port, $gamename, $secure) = @_; - - # if address is in list, update the timestamp - my $u = $self->{dbh}->do( - "SELECT * FROM serverlist - WHERE ip = ? - AND port = ?", - undef, $ip, $port); - - # notify - $self->log("read","syncer found entry for $ip:$port") if ($u > 0); - - # if found, return 0 - return 0 if ($u > 0); - - # if it is already in the pending list, update it with a new challenge - $u = $self->{dbh}->do( - "UPDATE pending - SET secure = ? - WHERE ip = ? - AND heartbeat = ?", - undef, $secure, $ip, $port); - - # notify - $self->log("update","$ip:$port was updated by syncer", - $self->{log_settings}->{db_updated}) if ($u > 0); - - # return 1 if found - return 1 if ($u > 0); - - # if not found, add it - $u = $self->{dbh}->do( - "INSERT INTO pending (ip, heartbeat, gamename, secure) - SELECT ?, ?, ?, ?", - undef, $ip, $port, $gamename, $secure); - - # notify - $self->log("add","beacon: $ip:$port was added for $gamename after sync") if ($u > 0); - - # return 2 if added new - return 2 if ($u > 0); - - # or else report error - $self->log("error", "an error occurred adding $ip:$port after sync"); - return -1; -} - -################################################################################ -## get a server address of the next server in line to be queried for game info. -## query must be older than 30 seconds (in case it just got added) and not -## older than 3 hours. -################################################################################ -sub get_next_server { - my ($self, $id) = @_; - - return $self->{dbh}->selectall_arrayref( - "SELECT id, ip, port FROM serverlist - WHERE added < datetime(CURRENT_TIMESTAMP, '-15 seconds') - AND updated > datetime(CURRENT_TIMESTAMP, '-10800 seconds') - AND id > ? - AND NOT blacklisted - ORDER BY id ASC LIMIT 1", undef, $id)->[0]; -} - -1; diff --git a/lib/MasterServer/Database/dbAddServers.pm b/lib/MasterServer/Database/dbAddServers.pm new file mode 100755 index 0000000..4898316 --- /dev/null +++ b/lib/MasterServer/Database/dbAddServers.pm @@ -0,0 +1,162 @@ + +package MasterServer::Database::dbAddServers; + +use strict; +use warnings; +use MasterServer::Core::Util 'sqlprint'; +use Exporter 'import'; + +our @EXPORT = qw| add_server_new + add_server_list + update_server_list + syncer_add |; + +################################################################################ +## Update an existing address or add a new address to the pending list. +## opts: direct beacon, set update, game +################################################################################ +sub add_server_new { + my $self = shift; + my %o = ( + updated => time, + @_); + + # try updating it in serverlist + my %H = ( + $o{direct} ? ( 'b333ms = CAST(? AS BOOLEAN)' => $o{direct}) : (), + $o{updated} ? ( 'updated = to_timestamp(?)' => $o{updated}) : (), + $o{beacon} ? ( 'beacon = to_timestamp(?)' => $o{beacon}) : (), + $o{gamename} ? ('gamename = ?' => lc $o{gamename}) : (), + ); + + my($q, @p) = sqlprint("UPDATE serverlist !H + WHERE ip = ? AND port = ?", \%H, $o{ip}, $o{heartbeat}); + + my $n = $self->{dbh}->do($q, undef, @p); + + # if serverlist was updated + return 0 if ($n > 0); + + + # try updating it in pending + %H = ( + $o{added} ? ( 'added = ?' => $o{added}) : (), + $o{secure} ? ( 'secure = ?' => $o{secure}) : (), + $o{gamename} ? ( 'gamename = ?' => lc $o{gamename}) : (), + $o{beaconport} ? ('beaconport = ?' => $o{beaconport}) : (), + ); + + ($q, @p) = sqlprint("UPDATE pending !H + WHERE ip = ? AND heartbeat = ?", \%H, $o{ip}, $o{heartbeat}); + + # exec query + $n = $self->{dbh}->do($q, undef, @p); + + # if beacon was updated + return 1 if ($n > 0); + + # if not found at all, add to pending + $n = $self->{dbh}->do( + "INSERT INTO pending ( + ip, + beaconport, + heartbeat, + gamename, + secure) + SELECT ?, ?, ?, ?, ?", + undef, $o{ip}, $o{beaconport}, $o{heartbeat}, lc $o{gamename}, $o{secure}); + + # it was added to pending + return 2 if ($n > 0); +} + +################################################################################ +## Update the server info in the serverlist +################################################################################ +sub update_server_list { + my $self = shift; + my %o = ( + updated => time, + @_); + + # try updating it in serverlist + my %H = ( + $o{gamename} ? ('gamename = ?' => lc $o{gamename}) : (), + $o{gamever} ? ( 'gamever = ?' => $o{gamever}) : (), + $o{hostname} ? ('hostname = ?' => $o{hostname}) : (), + $o{hostport} ? ('hostport = ?' => $o{hostport}) : (), + $o{updated} ? ( 'updated = to_timestamp(?)' => $o{updated}) : (), + ); + + my($q, @p) = sqlprint("UPDATE serverlist !H + WHERE ip = ? AND port = ?", \%H, $o{ip}, $o{port}); + + return $self->{dbh}->do($q, undef, @p); +} + +################################################################################ +## beacon was verified or otherwise accepted and will now be added to the +## serverlist. +################################################################################ +sub add_server_list { + my $self = shift; + my %o = @_; + + # insert basic data + return $self->{dbh}->do("INSERT INTO serverlist (ip, port, gamename, country) + SELECT ?, ?, ?, ?", undef, + $o{ip}, $o{port}, lc $o{gamename}, $self->ip2country($o{ip})); +} + +################################################################################ +## add new addresses to the pending list, but do not update timestamps. masters +## that sync with each other would otherwise update the timestamp for a server +## which is no longer online. +################################################################################ +sub syncer_add { + my ($self, $ip, $port, $gamename, $secure) = @_; + + # if address is in the list AND up to date, + # acknowledge its existance but don't do anything with it + my $u = $self->{dbh}->do( + "SELECT * FROM serverlist + WHERE ip = ? + AND port = ? + AND updated > to_timestamp(?)", + undef, $ip, $port, time-7200); + + # if found, return 0 + return 0 if ($u > 0); + + # if it is already in the pending list, update it with a new challenge + $u = $self->{dbh}->do( + "UPDATE pending + SET secure = ? + WHERE ip = ? + AND heartbeat = ?", + undef, $secure, $ip, $port); + + # notify + $self->log("update","$ip:$port was updated by syncer") if ($u > 0); + + # return 1 if found + return 1 if ($u > 0); + + # if not found or out of date, add it to pending to be checked again + $u = $self->{dbh}->do( + "INSERT INTO pending (ip, heartbeat, gamename, secure) + SELECT ?, ?, ?, ?", + undef, $ip, $port, lc $gamename, $secure); + + # notify + $self->log("add","beacon: $ip:$port was added for $gamename after sync") if ($u > 0); + + # return 2 if added new + return 2 if ($u > 0); + + # or else report error + $self->log("error", "an error occurred adding $ip:$port after sync"); + return -1; +} + +1; diff --git a/lib/MasterServer/Database/dbCiphers.pm b/lib/MasterServer/Database/dbCiphers.pm new file mode 100755 index 0000000..e62552d --- /dev/null +++ b/lib/MasterServer/Database/dbCiphers.pm @@ -0,0 +1,57 @@ + +package MasterServer::Database::dbCiphers; + +use strict; +use warnings; +use Exporter 'import'; + +our @EXPORT = qw| clear_ciphers + insert_cipher + get_game_props |; + +################################################################################ +## Clear all existing ciphers from the database +################################################################################ +sub clear_ciphers { + my $self = shift; + + # delete ALL entries + my $u = $self->{dbh}->do("DELETE FROM games"); +} + +################################################################################ +## Insert the list of supported games and their ciphers / default ports / +## descriptions included from the data/supportedgames.pl file. +################################################################################ +sub insert_cipher { + my ($self, %opt) = @_; + + # insert a single cipher/key combo + my $u = $self->{dbh}->do( + "INSERT INTO games ( + gamename, + cipher, + description, + default_qport) + VALUES(?, ?, ?, ?)", undef, + lc $opt{gamename}, $opt{cipher}, $opt{description}, $opt{default_qport}); + return 1 if ($u and $u > 0); + + # or else report error + $self->log("error", "An error occurred adding a cipher for $opt{gamename}"); +} + +################################################################################ +## get the cipher, description and default port that goes with given gamename +################################################################################ +sub get_game_props { + my ($self, $gn) = @_; + + # get cipher from db if gamename exists + return $self->{dbh}->selectall_arrayref( + 'SELECT * FROM games WHERE gamename = ?', + {Slice=>{}}, + lc $gn)->[0]; +} + +1; diff --git a/lib/MasterServer/Database/dbCore.pm b/lib/MasterServer/Database/dbCore.pm new file mode 100755 index 0000000..4ea0c79 --- /dev/null +++ b/lib/MasterServer/Database/dbCore.pm @@ -0,0 +1,83 @@ + +package MasterServer::Database::dbCore; + +use strict; +use warnings; +use Exporter 'import'; + +our @EXPORT = qw| database_login |; + +################################################################################ +## login to the database with credentials provided in the config file. +## returns dbh object or quits application on error. +## +## Recommended database types: Postgresql, MySQL or SQLite. Warranty void if +## other database types are used. Use at your own risk. +################################################################################ +sub database_login { + my $self = shift; + + # read db type from db login + my @db_type = split(':', $self->{dblogin}->[0]); + + # if the type is an SQLite database, check if the database file exists + if ( "SQLite" =~ m/$db_type[1]/i) { + + # check if database file exists + my $db_file = [split(':', $self->{dblogin}->[0])]->[2]; + $db_file =~ s/dbname=//i; + + unless (-e $db_file) { + # fatal error + $self->log("fatal", "Database file $db_file does not exist!"); + + # end program + $self->halt(); + } + } + + # inform what DB we try to load + # $self->log("info","Database: $db_type[1]"); + + # create the dbi object + my $dbh = DBI->connect(@{$self->{dblogin}}, {PrintError => $self->{db_print}}); + + # verify that the database connected + if (defined $dbh) { + + # log the event + $self->log("info","Connected to the $db_type[1] database."); + + # turn on error printing + $dbh->{printerror} = 1; + + # if the type is an SQLite database, disable sync rw. + if ( "SQLite" =~ m/$db_type[1]/i) { + + # synchronous read/writing to the SQLite file OFF. That means: when the script + # shuts down unexpectedly, i.e. because of power failure or a crash, changes + # to the database are NOT SAVED. However, if this setting is not turned OFF, + # it takes too long to write to the database, which means that new beacons, + # requests and servers cannot be processed. You don't have a choice, really.. + $dbh->do("PRAGMA synchronous = OFF"); + + # allow the use of foreign keys (referencing) + $dbh->do("PRAGMA foreign_keys = ON"); + } + + # return the dbi object for further use + return $dbh; + } + else { + # fatal error + $self->log("fatal", "$DBI::errstr!"); + + # end program + $self->halt(); + } + + # in case of any other error, return undef. + return undef; +} + +1; diff --git a/lib/MasterServer/Database/dbGetServers.pm b/lib/MasterServer/Database/dbGetServers.pm new file mode 100755 index 0000000..5069462 --- /dev/null +++ b/lib/MasterServer/Database/dbGetServers.pm @@ -0,0 +1,139 @@ +package MasterServer::Database::dbGetServers; + +use strict; +use warnings; +use Exporter 'import'; + +our @EXPORT = qw| get_server + get_pending + get_gamenames |; + +################################################################################ +## get server details for one or multiple servers +## opts: limit, see $order +################################################################################ +sub get_server { + my $s = shift; + my %o = ( + sort => '', + @_ + ); + + my %where = ( + $o{next_id} ? ( 'id > ?' => $o{next_id}) : (), + $o{id} ? ( 'id = ?' => $o{id}) : (), + $o{ip} ? ( 'ip = ?' => $o{ip}) : (), + $o{port} ? ( 'port = ?' => $o{port}) : (), + $o{gamename} ? ( 'gamename = ?' => lc $o{gamename}) : (), + $o{gamever} ? ( 'gamever = ?' => $o{gamever}) : (), + $o{hostname} ? ( 'hostname = ?' => $o{hostname}) : (), + $o{hostport} ? ( 'hostport = ?' => $o{hostport}) : (), + $o{country} ? ( 'country = ?' => $o{country}) : (), + $o{b333ms} ? ( 'b333ms = ?' => $o{b333ms}) : (), + $o{blacklisted} ? ('blacklisted = ?' => $o{blacklisted}) : (), + $o{added} ? ( 'added < to_timestamp(?)' => (time-$o{added})) : (), + $o{beacon} ? ( 'beacon > to_timestamp(?)' => (time-$o{beacon})) : (), + $o{updated} ? ('updated > to_timestamp(?)' => (time-$o{updated})) : (), + $o{before} ? ('updated < to_timestamp(?)' => (time-$o{before})) : (), + ); + + my @select = ( qw| + id + ip + port + gamename + gamever + hostname + hostport + country + b333ms + blacklisted + added + beacon + updated + |); + + my $order = sprintf { + id => 'id %s', + ip => 'ip %s', + port => 'port %s', + gamename => 'gamename %s', + gamever => 'gamever %s', + hostname => 'hostname %s', + hostport => 'hostport %s', + country => 'country %s', + b333ms => 'b333ms %s', + blacklisted => 'blacklisted %s', + added => 'added %s', + beacon => 'beacon %s', + updated => 'updated %s', + }->{ $o{sort}||'id' }, $o{reverse} ? 'DESC' : 'ASC'; + + return $s->db_all( q| + SELECT !s FROM serverlist + !W + ORDER BY !s| + .($o{limit} ? " LIMIT ?" : ""), + join(', ', @select), \%where, $order, ($o{limit} ? $o{limit} : ()), + ); +} + +################################################################################ +## get server details for one or multiple pending servers +## opts: limit, next_id, beaconport, heartbeat, gamename, secure, enctype, added +################################################################################ +sub get_pending { + my $s = shift; + my %o = ( + sort => '', + @_ + ); + + my %where = ( + $o{next_id} ? ( 'id > ?' => $o{next_id}) : (), + $o{id} ? ( 'id = ?' => $o{id}) : (), + $o{ip} ? ( 'ip = ?' => $o{ip}) : (), + $o{beaconport} ? ('beaconport = ?' => $o{beaconport}) : (), + $o{heartbeat} ? ( 'heartbeat = ?' => $o{heartbeat}) : (), + $o{gamename} ? ( 'gamename = ?' => lc $o{gamename}) : (), + $o{secure} ? ( 'secure = ?' => $o{secure}) : (), + $o{enctype} ? ( 'enctype = ?' => $o{enctype}) : (), + $o{added} ? ('added < to_timestamp(?)' => (time-$o{added})) : (), + $o{after} ? ('added > to_timestamp(?)' => (time-$o{after})) : (), + ); + + my @select = ( qw| id ip beaconport heartbeat gamename secure enctype added |,); + my $order = sprintf { + id => 'id %s', + ip => 'ip %s', + beaconport => 'beaconport %s', + heartbeat => 'heartbeat %s', + gamename => 'gamename %s', + secure => 'secure %s', + enctype => 'enctype %s', + added => 'added %s', + }->{ $o{sort}||'id' }, $o{reverse} ? 'DESC' : 'ASC'; + + return $s->db_all( q| + SELECT !s FROM pending + !W + ORDER BY !s| + .($o{limit} ? " LIMIT ?" : ""), + join(', ', @select), \%where, $order, ($o{limit} ? $o{limit} : ()), + ); +} + +################################################################################ +## get a list of distinct gamenames currently in the database. it does not +## matter whether they are recent or old, as long as the game is currently in +## the database. +################################################################################ +sub get_gamenames { + my $self = shift; + + return $self->{dbh}->selectall_arrayref( + "SELECT distinct gamename + FROM serverlist"); +} + +1; diff --git a/lib/MasterServer/Database/dbMaintenance.pm b/lib/MasterServer/Database/dbMaintenance.pm new file mode 100755 index 0000000..41ea93a --- /dev/null +++ b/lib/MasterServer/Database/dbMaintenance.pm @@ -0,0 +1,40 @@ +package MasterServer::Database::dbMaintenance; + +use strict; +use warnings; +use Exporter 'import'; + +our @EXPORT = qw| delete_old_pending + remove_pending |; + +################################################################################ +## delete unresponsive servers from the pending list +## where the server is unresponsive for more than 1 hour +################################################################################ +sub delete_old_pending { + my ($self) = shift; + + # remove servers + my $u = $self->{dbh}->do( + "DELETE FROM pending + WHERE added < to_timestamp(?)", undef, time-3600); + + # notify + $self->log("delete", "Removed $u entries from pending.") if ($u > 0); +} + +################################################################################ +## Remove an entry from the pending list. Returns 0 if removed or -1 in case +## of error(s). +################################################################################ +sub remove_pending { + my ($self, $id) = @_; + + # if address is in list, update the timestamp + my $u = $self->{dbh}->do("DELETE FROM pending WHERE id = ?", undef, $id); + + # notify + $self->log("delete", "removed pending id $id from pending") if ($u > 0); +} + +1; diff --git a/lib/MasterServer/Database/dbStats.pm b/lib/MasterServer/Database/dbStats.pm new file mode 100755 index 0000000..70962dc --- /dev/null +++ b/lib/MasterServer/Database/dbStats.pm @@ -0,0 +1,117 @@ +package MasterServer::Database::dbStats; + +use strict; +use warnings; +use Exporter 'import'; + +our @EXPORT = qw| get_gamelist_stats + write_direct_beacons + write_stat + write_kfstats |; + +################################################################################ +# calculate stats for all individual games +################################################################################ +sub get_gamelist_stats { + my $self = shift; + + return $self->{dbh}->selectall_arrayref( + "SELECT DISTINCT gamename AS gamename, + COUNT(NULLIF(b333ms AND updated > to_timestamp(?), FALSE)) AS numdirect, + COUNT(NULLIF(updated > to_timestamp(?), FALSE)) AS numtotal + FROM serverlist + GROUP BY gamename", undef, time-7200, time-7200); +} + +################################################################################ +# Determine from the last beacon whether the server is still uplinking +# directly to us, or whether it stopped uplinking and is now artificially +# kept in the database. +################################################################################ +sub write_direct_beacons { + my $self = shift; + my $u = $self->{dbh}->do( + "UPDATE serverlist + SET b333ms = CAST(0 AS BOOLEAN) + WHERE beacon < to_timestamp(?) AND b333ms", + undef, time-3600); + + # notify + $self->log("unset", "Lost $u direct beacons.") if ($u > 0); +} + +################################################################################ +# Write the stats to the games table +# A stat can not exist without existing gamename. Was inserted by cipher loader. +################################################################################ +sub write_stat { + my ($self, %opt) = @_; + + # if it is already in the pending list, update it with a new challenge + my $u = $self->{dbh}->do( + "UPDATE games + SET num_uplink = ?, + num_total = ? + WHERE gamename = ?", + undef, $opt{num_uplink}, $opt{num_total}, lc $opt{gamename}); + + # notify + $self->log("update", "Updated stats for $opt{gamename}.") if ($u > 0); + +} + +################################################################################ +## Write the KFStats to the database +################################################################################ +sub write_kfstats { + my ($self, $h) = @_; + + # check if entry already excists. + my $u = $self->{dbh}->selectall_arrayref( + "SELECT * FROM kfstats WHERE UTkey = ? ", undef, $h->{UTkey}); + + if ( !defined $u->[0] ) { + $u = $self->{dbh}->do( + "INSERT INTO kfstats (UTkey, Username) VALUES (?,?)", + undef, $h->{UTkey}, $h->{Username}); + + # notify + $self->log("kfnew", "New KF Player $h->{Username} added"); + } + + # update existing information + $u = $self->{dbh}->do("UPDATE kfstats SET + Username = ?, + CurrentVeterancy = ?, + TotalKills = ?, + DecaptedKills = ?, + TotalMeleeDamage = ?, + MeleeKills = ?, + PowerWpnKills = ?, + BullpupDamage = ?, + StalkerKills = ?, + TotalWelded = ?, + TotalHealed = ?, + TotalPlaytime =?, + GamesWon = ?, + GamesLost = ? + WHERE UTkey = ?", undef, + $h->{Username}, + $h->{CurrentVeterancy}, + $h->{TotalKills}, + $h->{DecaptedKills}, + $h->{TotalMeleeDamage}, + $h->{MeleeKills}, + $h->{PowerWpnKills}, + $h->{BullpupDamage}, + $h->{StalkerKills}, + $h->{TotalWelded}, + $h->{TotalHealed}, + $h->{TotalPlaytime}, + $h->{GamesWon}, + $h->{GamesLost}, + $h->{UTkey} + ); +} + +1; diff --git a/lib/MasterServer/Database/dbUTServerInfo.pm b/lib/MasterServer/Database/dbUTServerInfo.pm new file mode 100755 index 0000000..9352e38 --- /dev/null +++ b/lib/MasterServer/Database/dbUTServerInfo.pm @@ -0,0 +1,238 @@ + +package MasterServer::Database::dbUTServerInfo; + +use strict; +use warnings; +use MasterServer::Core::Util 'sqlprint'; +use Exporter 'import'; + +our @EXPORT = qw| get_utserver + add_utserver + update_utserver + delete_utplayers + insert_utplayer |; + +################################################################################ +## get server details for one or multiple UT servers +## opts: limit, see $order +################################################################################ +sub get_utserver { + my $s = shift; + my %o = ( + sort => '', + @_ + ); + + my %where = ( + $o{id} ? ('server_id = ?' => $o{id}) : (), + $o{minnetver} ? ('minnetver = ?' => $o{minnetver}) : (), + $o{gamever} ? ('gamever = ?' => $o{gamever}) : (), + $o{location} ? ('location = ?' => $o{location}) : (), + $o{listenserver} ? ('listenserver = ?' => $o{listenserver}) : (), + $o{hostport} ? ('hostport = ?' => $o{hostport}) : (), + $o{hostname} ? ('hostname = ?' => $o{hostname}) : (), + $o{adminname} ? ('adminname = ?' => $o{adminname}) : (), + $o{adminemail} ? ('adminemail = ?' => $o{adminemail}) : (), + $o{password} ? ('password = ?' => $o{password}) : (), + $o{gametype} ? ('gametype = ?' => $o{gametype}) : (), + $o{gamestyle} ? ('gamestyle = ?' => $o{gamestyle}) : (), + $o{changelevels} ? ('changelevels = ?' => $o{changelevels}) : (), + $o{maptitle} ? ('maptitle = ?' => $o{maptitle}) : (), + $o{mapname} ? ('mapname = ?' => $o{mapname}) : (), + $o{numplayers} ? ('numplayers = ?' => $o{numplayers}) : (), + $o{maxplayers} ? ('maxplayers = ?' => $o{maxplayers}) : (), + $o{minplayers} ? ('minplayers = ?' => $o{minplayers}) : (), + $o{botskill} ? ('botskill = ?' => $o{botskill}) : (), + $o{balanceteams} ? ('balanceteams = ?' => $o{balanceteams}) : (), + $o{playersbalanceteams} ? ('playersbalanceteams = ?' => $o{playersbalanceteams}) : (), + $o{friendlyfire} ? ('friendlyfire = ?' => $o{friendlyfire}) : (), + $o{maxteams} ? ('maxteams = ?' => $o{maxteams}) : (), + $o{timelimit} ? ('timelimit = ?' => $o{timelimit}) : (), + $o{goalteamscore} ? ('goalteamscore = ?' => $o{goalteamscore}) : (), + $o{fraglimit} ? ('fraglimit = ?' => $o{fraglimit}) : (), + $o{mutators} ? ('hostname ILIKE ?' => "%$o{mutators}%") : (), + $o{updated} ? ('updated > to_timestamp(?)'=> (time-$o{updated})) : (), + ); + + my @select = ( qw| + server_id + minnetver + gamever + location + listenserver + hostport + hostname + adminname + adminemail + password + gametype + gamestyle + changelevels + maptitle + mapname + numplayers + maxplayers + minplayers + botskill + balanceteams + playersbalanceteams + friendlyfire + maxteams + timelimit + goalteamscore + fraglimit + mutators + updated + |); + + my $order = sprintf { + server_id => 'server_id %s', + minnetver => 'minnetver %s', + gamever => 'gamever %s', + location => 'location %s', + listenserver => 'listenserver %s', + hostport => 'hostport %s', + hostname => 'hostname %s', + adminname => 'adminname %s', + adminemail => 'adminemail %s', + password => 'password %s', + gametype => 'gametype %s', + gamestyle => 'gamestyle %s', + changelevels => 'changelevels %s', + maptitle => 'maptitle %s', + mapname => 'mapname %s', + numplayers => 'numplayers %s', + maxplayers => 'maxplayers %s', + minplayers => 'minplayers %s', + botskill => 'botskill %s', + balanceteams => 'balanceteams %s', + playersbalanceteams => 'playersbalanceteams %s', + friendlyfire => 'friendlyfire %s', + maxteams => 'maxteams %s', + timelimit => 'timelimit %s', + goalteamscore => 'goalteamscore %s', + fraglimit => 'fraglimit %s', + mutators => 'mutators %s', + updated => 'updated %s', + }->{ $o{sort}||'server_id' }, $o{reverse} ? 'DESC' : 'ASC'; + + return $s->db_all( q| + SELECT !s FROM utserver_info + !W + ORDER BY !s| + .($o{limit} ? " LIMIT ?" : ""), + join(', ', @select), \%where, $order, ($o{limit} ? $o{limit} : ()), + ); +} + + +################################################################################ +## Update serverinfo for an existing address to the utserver list. +## opts: all server info data fields. +################################################################################ +sub update_utserver { + my $self = shift; + my $id = shift; + my %s = ( + # defaults + updated => time, + @_); + + # try updating it in serverlist + my %H = ( + $s{minnetver} ? ( 'minnetver = ?' => $s{minnetver} ) : (), + $s{gamever} ? ( 'gamever = ?' => int( $s{gamever}) ) : (), + $s{location} ? ( 'location = ?' => $s{location} ) : (), + $s{listenserver} ? ( 'listenserver = ?' => ( $s{listenserver} ? 1 : 0) ) : (), + $s{hostport} ? ( 'hostport = ?' => $s{hostport}) : (), + $s{hostname} ? ( 'hostname = ?' => $s{hostname}) : (), + $s{AdminName} ? ( 'adminname = ?' => $s{AdminName}) : (), + $s{AdminEMail} ? ( 'adminemail = ?' => $s{AdminEMail}) : (), + $s{password} ? ( 'password = ?' => ( $s{password} ? 1 : 0) ) : (), + $s{gametype} ? ( 'gametype = ?' => $s{gametype}) : (), + $s{gamestyle} ? ( 'gamestyle = ?' => $s{gamestyle}) : (), + $s{changelevels} ? ( 'changelevels = ?' => ( $s{changelevels} ? 1 : 0) ) : (), + $s{maptitle} ? ( 'maptitle = ?' => $s{maptitle}) : (), + $s{mapname} ? ( 'mapname = ?' => $s{mapname}) : (), + $s{numplayers} ? ( 'numplayers = ?' => $s{numplayers}) : ('numplayers = ?' => 0), + $s{maxplayers} ? ( 'maxplayers = ?' => $s{maxplayers}) : ('maxplayers = ?' => 0), + $s{minplayers} ? ( 'minplayers = ?' => $s{minplayers}) : ('minplayers = ?' => 0), + $s{botskill} ? ( 'botskill = ?' => $s{botskill}) : (), + $s{balanceteams} ? ( 'balanceteams = ?' => ( $s{balanceteams} ? 1 : 0) ) : (), + $s{playersbalanceteams} ? ( 'playersbalanceteams = ?' => ( $s{playersbalanceteams} ? 1 : 0) ) : (), + $s{friendlyfire} ? ( 'friendlyfire = ?' => $s{friendlyfire}) : (), + $s{maxteams} ? ( 'maxteams = ?' => $s{maxteams}) : (), + $s{timelimit} ? ( 'timelimit = ?' => $s{timelimit}) : (), + $s{goalteamscore} ? ( 'goalteamscore = ?' => int( $s{goalteamscore}) ) : (), + $s{fraglimit} ? ( 'fraglimit = ?' => int( $s{fraglimit}) ) : (), + $s{mutators} ? ( 'mutators = ?' => $s{mutators}) : ('mutators = ?' => "None"), + $s{updated} ? ('updated = to_timestamp(?)' => $s{updated}) : (), + ); + + my($q, @p) = sqlprint("UPDATE utserver_info !H WHERE server_id = ?", \%H, $id); + return $self->{dbh}->do($q, undef, @p); +} + + +################################################################################ +## Add a new utserver and trigger the update routine above. +## opts: id, server info data +################################################################################ +sub add_utserver { + my ($self, $ip, $port) = @_; + + # create new entry + return $self->{dbh}->do( + "INSERT INTO utserver_info (server_id) + SELECT (SELECT id FROM serverlist WHERE ip = ? AND port = ?)", + undef, $ip, $port); +} + + +################################################################################ +## Delete all players from a certain server ID +## opts: server id +################################################################################ +sub delete_utplayers { + my ($self, $sid) = @_; + + # delete players for server_id + return $self->{dbh}->do( + "DELETE FROM utplayer_info WHERE server_id = ?", + undef, $sid); +} + +################################################################################ +## Insert player info for a single player in server sid +## opts: server id, player info +################################################################################ +sub insert_utplayer { + my $self = shift; + my $sid = shift; + my %s = ( + updated => time, + @_); + + # apparently useless chunk of code + # FIXME move to site part + my %H = ( + $s{server_id} ? ( 'server_id = ?' => $s{server_id}) : (), + $s{player} ? ( 'player = ?' => $s{player}) : (), + $s{team} ? ( 'team = ?' => int( $s{team})) : (), + $s{frags} ? ( 'frags = ?' => int( $s{frags})) : (), + $s{mesh} ? ( 'mesh = ?' => $s{mesh}) : (), + $s{skin} ? ( 'skin = ?' => $s{skin}) : (), + $s{face} ? ( 'face = ?' => $s{face}) : (), + $s{ping} ? ( 'ping = ?' => int( $s{ping})) : (), + $s{ngsecret} ? ( 'ngsecret = ?' => $s{ngsecret}) : (), + $s{updated} ? ('updated = to_timestamp(?)' => $s{updated}) : (), + ); + + # insert + return $self->{dbh}->do( + "INSERT INTO utplayer_info (server_id, player, team, frags, mesh, skin, face, ping, ngsecret) + VALUES (?,?,?,?,?,?,?,?,?)", + undef, $sid, $s{player}, $s{team}, $s{frags}, $s{mesh}, $s{skin}, $s{face}, $s{ping}, $s{ngsecret}); +} + +1; diff --git a/lib/MasterServer/Database/mysql/dbBeacon.pm b/lib/MasterServer/Database/mysql/dbBeacon.pm deleted file mode 100755 index fd956b7..0000000 --- a/lib/MasterServer/Database/mysql/dbBeacon.pm +++ /dev/null @@ -1,203 +0,0 @@ - -package MasterServer::Database::mysql::dbBeacon; - -use strict; -use warnings; -use Exporter 'import'; - -our @EXPORT = qw| add_beacon - add_pending - remove_pending - get_pending_beacon - get_pending_info - get_next_pending |; - -################################################################################ -## Update beacon in serverlist or pending list. Add if beacon does not exist in -## either list. Return 0,1,2 if success in adding or -1 on error. -################################################################################ -sub add_beacon { - my ($self, $ip, $beaconport, $heartbeat, $gamename, $secure) = @_; - - # if address is in list, update the timestamp - my $u = $self->{dbh}->do( - "UPDATE serverlist - SET beacon = NOW(), - updated = NOW(), - gamename = ?, - b333ms = 1 - WHERE ip = ? - AND port = ?", - undef, lc $gamename, $ip, $heartbeat); - - # notify - $self->log("update", "beacon heartbeat for $ip:$heartbeat") if ($u > 0); - - # if serverlist was updated return 0 - return 0 if ($u > 0); - - # if it is already in the pending list, update it with a new challenge - $u = $self->{dbh}->do( - "UPDATE pending - SET added = NOW(), - beaconport = ?, - gamename = ?, - secure = ? - WHERE ip = ? - AND heartbeat = ?", - undef, $beaconport, lc $gamename, $secure, $ip, $heartbeat); - - # notify - $self->log("update", "beacon heartbeat $ip:$beaconport pending $gamename:$heartbeat") if ($u > 0); - - # beacon was already in pending list and was updated - return 1 if ($u > 0); - - # if not found, add it - $u = $self->{dbh}->do( - "INSERT INTO pending ( - ip, - beaconport, - heartbeat, - gamename, - secure) - SELECT ?, ?, ?, ?, ?", - undef, $ip, $beaconport, $heartbeat, lc $gamename, $secure); - - # notify - $self->log("add", "beacon heartbeat $ip:$beaconport pending $gamename:$heartbeat") if ($u > 0); - - # it was added to pending - return 2 if ($u > 0); - - # or else report error - $self->log("error", "an error occurred adding beacon $ip:$beaconport with $gamename:$heartbeat to the pending list"); - return -1; -} - -################################################################################ -## Add an address to the database that was obtained via a method other than -## an udp beacon. Return 0,1,2 if success in adding or -1 on error. -################################################################################ -sub add_pending { - my ($self, $ip, $port, $gamename, $secure) = @_; - - # if address is in list, update the timestamp - my $u = $self->{dbh}->do( - "UPDATE serverlist - SET updated = NOW() - WHERE ip = ? - AND port = ?", - undef, $ip, $port); - - # notify - $self->log("update", "updated serverlist with $ip:$port") if ($u > 0); - - # if updated, return 0 - return 0 if ($u > 0); - - # if it is already in the pending list, update it with a new challenge - $u = $self->{dbh}->do( - "UPDATE pending - SET added = NOW(), - secure = ? - WHERE ip = ? - AND heartbeat = ?", - undef, $secure, $ip, $port); - - # notify - $self->log("update", "updated pending with $ip:$port") if ($u > 0); - - # return 1 if updated - return 1 if ($u > 0); - - # if not found, add it - $u = $self->{dbh}->do( - "INSERT INTO pending ( - ip, - heartbeat, - gamename, - secure) - SELECT ?, ?, ?, ?", - undef, $ip, $port, $gamename, $secure); - - # notify - $self->log("add", "$ip:$port added pending $gamename") if ($u > 0); - - # return 2 if added new - return 2 if ($u > 0); - - # else - return -1; -} - -################################################################################ -## Remove an entry from the pending list. Returns 0 if removed or -1 in case -## of error(s). -################################################################################ -sub remove_pending { - my ($self, $id) = @_; - - # if address is in list, update the timestamp - my $u = $self->{dbh}->do( - "DELETE FROM pending - WHERE id = ?", - undef, $id); - - # notify - $self->log("delete", "removed pending id $id from pending") if ($u > 0); - - # it was removed from pending - return 2 if ($u > 0); - - # or else report error - $self->log("error", "error deleting server $id from pending"); - return -1; -} - -################################################################################ -## Get pending server by ip, beacon port. Returns * or undef -################################################################################ -sub get_pending_beacon { - my ($self, $ip, $port) = @_; - - # if address is in list, update the timestamp - return $self->{dbh}->selectall_arrayref( - "SELECT * FROM pending - WHERE ip = ? - AND beaconport = ?", - undef, $ip, $port)->[0]; -} - -################################################################################ -## Get pending server by ip, heartbeat port. Returns * or undef -################################################################################ -sub get_pending_info { - my ($self, $ip, $port) = @_; - - # if address is in list, update the timestamp - return $self->{dbh}->selectall_arrayref( - "SELECT * FROM pending - WHERE ip = ? - AND heartbeat = ?", - undef, $ip, $port)->[0]; -} - -################################################################################ -## Get server info from any entry with an id higher than the provided one. The -## server is added to pending at least 15 seconds ago. Returns info or undef. -################################################################################ -sub get_next_pending { - my ($self, $id) = @_; - - # get 1 pending id that is older than 15s - return $self->{dbh}->selectall_arrayref( - "SELECT id, ip, heartbeat, secure FROM pending - WHERE added < NOW() - INTERVAL 15 SECOND - AND id > ? - ORDER BY id ASC LIMIT 1", - undef, $id)->[0]; -} - - -1; diff --git a/lib/MasterServer/Database/mysql/dbCiphers.pm b/lib/MasterServer/Database/mysql/dbCiphers.pm deleted file mode 100755 index 31db78b..0000000 --- a/lib/MasterServer/Database/mysql/dbCiphers.pm +++ /dev/null @@ -1,98 +0,0 @@ - -package MasterServer::Database::mysql::dbCiphers; - -use strict; -use warnings; -use Exporter 'import'; - -our @EXPORT = qw| clear_ciphers - insert_cipher - get_cipher - get_default_port |; - -################################################################################ -## Clear all existing ciphers from the database -################################################################################ -sub clear_ciphers { - my $self = shift; - - # delete ALL entries - my $u = $self->{dbh}->do("DELETE FROM games"); - - # notify - $self->log("delete", "Removed all ciphers") if ($u > 0); - - # removed from games - return 2 if ($u > 0); - - # or else report notice - $self->log("notice", "No ciphers deleted!"); - return -1; - -} - -################################################################################ -## Insert the list of supported games and their ciphers / default ports / -## descriptions included from the data/supportedgames.pl file. -################################################################################ -sub insert_cipher { - my ($self, %opt) = @_; - - # insert a single cipher/key combo - my $u = $self->{dbh}->do( - "INSERT INTO games ( - gamename, - cipher, - description, - default_qport) - VALUES(?, ?, ?, ?)", undef, - $opt{gamename}, $opt{cipher}, $opt{description}, $opt{default_qport}); - - # notify - $self->log("add", "Added cipher for $opt{gamename}") if ($u and $u > 0); - return 1 if ($u and $u > 0); - - # or else report error - $self->log("error", "An error occurred adding a cipher for $opt{gamename}"); - return -1; - -} - - -################################################################################ -## get the cipher that goes with gamename -################################################################################ -sub get_cipher { - my ($self, $gn) = @_; - - # no gamename specified? "undef" is not a known cipher, so send that instead. - return 'undef' if !$gn; - - # get cipher from db if gamename exists - my $cipher = $self->{dbh}->selectall_arrayref( - 'SELECT cipher FROM games WHERE gamename = ?', undef, - lc $gn)->[0]->[0]; - - # return a non-zero-length string - return ($cipher ? $cipher : 'undef'); -} - -################################################################################ -## get the default query port that goes with gamename -################################################################################ -sub get_default_port { - my ($self, $gn) = @_; - - # no gamename specified? default port is 0 - return 0 if !$gn; - - # get port from db if gamename exists - my $p = $self->{dbh}->selectall_arrayref( - 'SELECT default_qport FROM games WHERE gamename = ?', undef, - lc $gn)->[0]->[0]; - - # return port or zero - return $p || 0; -} - -1; diff --git a/lib/MasterServer/Database/mysql/dbClientList.pm b/lib/MasterServer/Database/mysql/dbClientList.pm deleted file mode 100755 index 898eb28..0000000 --- a/lib/MasterServer/Database/mysql/dbClientList.pm +++ /dev/null @@ -1,45 +0,0 @@ - -package MasterServer::Database::mysql::dbClientList; - -use strict; -use warnings; -use Exporter 'import'; - -our @EXPORT = qw| get_gamenames - get_game_list |; - - -################################################################################ -## get a list of distinct gamenames currently in the database. it does not -## matter whether they are recent or old, as long as the game is currently in -## the database. -## -## returns: hashref of gamenames -################################################################################ -sub get_gamenames { - my $self = shift; - - return $self->{dbh}->selectall_arrayref( - "SELECT distinct gamename - FROM serverlist"); -} - -################################################################################ -## get the list of games of a certain $gamename, excluding the ones excempted -## via the blacklist -## only returns server addresses that are no more than 1 hours old -################################################################################ -sub get_game_list { - my ($self, $gamename) = @_; - - return $self->{dbh}->selectall_arrayref( - "SELECT ip, port - FROM serverlist - WHERE updated > NOW() - INTERVAL 10800 SECOND - AND gamename = ? - AND NOT blacklisted", - undef, lc $gamename); -} - - -1; diff --git a/lib/MasterServer/Database/mysql/dbCore.pm b/lib/MasterServer/Database/mysql/dbCore.pm deleted file mode 100755 index 30fe3ef..0000000 --- a/lib/MasterServer/Database/mysql/dbCore.pm +++ /dev/null @@ -1,44 +0,0 @@ - -package MasterServer::Database::mysql::dbCore; - -use strict; -use warnings; -use Exporter 'import'; - -our @EXPORT = qw| database_login |; - -################################################################################ -## login to the database with credentials provided in the config file. -## returns dbh object or quits application on error. -################################################################################ -sub database_login { - my $self = shift; - - # create the dbi object - my $dbh = DBI->connect(@{$self->{dblogin}}, {PrintError => $self->{db_print}}); - - # verify that the database connected - if (defined $dbh) { - - # log the event - $self->log("load","Connected to the MySQL database."); - - # turn on error printing - $dbh->{printerror} = 1; - - # return the dbi object for further use - return $dbh; - } - else { - # fatal error - $self->log("fatal", "$DBI::errstr!"); - - # end program - $self->halt(); - } - - # unreachable - return undef; -} - -1; diff --git a/lib/MasterServer/Database/mysql/dbServerlist.pm b/lib/MasterServer/Database/mysql/dbServerlist.pm deleted file mode 100755 index 5bc1cd3..0000000 --- a/lib/MasterServer/Database/mysql/dbServerlist.pm +++ /dev/null @@ -1,153 +0,0 @@ - -package MasterServer::Database::mysql::dbServerlist; - -use strict; -use warnings; -use Exporter 'import'; - -our @EXPORT = qw| add_to_serverlist - update_serverlist - syncer_add - get_next_server |; - -################################################################################ -## beacon was verified or otherwise accepted and will now be added to the -## serverlist. -################################################################################ -sub add_to_serverlist { - my ($self, $ip, $port, $gamename) = @_; - - # update or add server to serverlist - my $u = $self->{dbh}->do("UPDATE serverlist - SET updated = NOW() - WHERE ip = ? - AND port = ?", - undef, $ip, $port); - - # notify - $self->log("update", "$ip:$port timestamp updated") if ($u > 0); - - # if found, updated; done - return 0 if ($u > 0); - - # if not found, add it. - $u = $self->{dbh}->do("INSERT INTO serverlist (ip, port, gamename, country) - SELECT ?, ?, ?, ?", - undef, $ip, $port, $gamename, $self->ip2country($ip)); - - # notify - $self->log("add", "$ip:$port added to serverlist") if ($u > 0); - - # return added - return 1 if ($u > 0); - - # or else report error - $self->log("error", "an error occurred adding server $ip:$port ($gamename) to the serverlist"); - return -1; -} - -################################################################################ -## same as add_to_serverlist above, but does not add the server to serverlist -## if it does not exist in serverlist. it must be added by another function -## first. -################################################################################ -sub update_serverlist { - my ($self, $ip, $port, $s) = @_; - - # update server info - my $u = $self->{dbh}->do( - 'UPDATE serverlist - SET updated = NOW(), - gamename = ?, - gamever = ?, - hostname = ?, - hostport = ? - WHERE ip = ? - AND port = ?', undef, - $s->{gamename}, $s->{gamever}, $s->{hostname}, $s->{hostport}, - $ip, $port); - - # notify - $self->log("update", "server $ip:$port info updated") if ($u > 0); - - # return 0 if updated - return 0 if ($u > 0); - - # or else report error - $self->log("error", "an error occurred updating server $ip:$port in the serverlist"); - return -1; -} - - -################################################################################ -## add new addresses to the pending list, but do not update timestamps. masters -## that sync with each other would otherwise update the timestamp for a server -## which is no longer online. -################################################################################ -sub syncer_add { - my ($self, $ip, $port, $gamename, $secure) = @_; - - # if address is in list, update the timestamp - my $u = $self->{dbh}->do( - "SELECT * FROM serverlist - WHERE ip = ? - AND port = ?", - undef, $ip, $port); - - # notify - $self->log("read","syncer found entry for $ip:$port") if ($u > 0); - - # if found, return 0 - return 0 if ($u > 0); - - # if it is already in the pending list, update it with a new challenge - $u = $self->{dbh}->do( - "UPDATE pending - SET secure = ? - WHERE ip = ? - AND heartbeat = ?", - undef, $secure, $ip, $port); - - # notify - $self->log("update","$ip:$port was updated by syncer", - $self->{log_settings}->{db_updated}) if ($u > 0); - - # return 1 if found - return 1 if ($u > 0); - - # if not found, add it - $u = $self->{dbh}->do( - "INSERT INTO pending (ip, heartbeat, gamename, secure) - SELECT ?, ?, ?, ?", - undef, $ip, $port, $gamename, $secure); - - # notify - $self->log("add","beacon: $ip:$port was added for $gamename after sync") if ($u > 0); - - # return 2 if added new - return 2 if ($u > 0); - - # or else report error - $self->log("error", "an error occurred adding $ip:$port after sync"); - return -1; -} - -################################################################################ -## get a server address of the next server in line to be queried for game info. -## query must be older than 30 seconds (in case it just got added) and not -## older than 3 hours. FIXME: now older servers are ignored! -################################################################################ -sub get_next_server { - my ($self, $id) = @_; - - return $self->{dbh}->selectall_arrayref( - "SELECT id, ip, port FROM serverlist - WHERE added < NOW() - INTERVAL 15 SECOND - AND updated > NOW() - INTERVAL 10800 SECOND - AND id > ? - AND NOT blacklisted - ORDER BY id ASC LIMIT 1", undef, $id)->[0]; - -} - -1; diff --git a/lib/MasterServer/TCP/BrowserHost.pm b/lib/MasterServer/TCP/BrowserHost.pm index 3eb22eb..855b2c0 100755 --- a/lib/MasterServer/TCP/BrowserHost.pm +++ b/lib/MasterServer/TCP/BrowserHost.pm @@ -16,9 +16,6 @@ our @EXPORT = qw| browser_host clean_tcp_handle|; ################################################################################ sub browser_host { my $self = shift; - - # log: TCP host is active - $self->log("load","Loading TCP Browser Host."); my $browser = tcp_server undef, $self->{listen_port}, sub { my ($fh, $a, $p) = @_; @@ -51,7 +48,7 @@ sub browser_host { }; # startup of TCP server complete - $self->log("load", "Listening for TCP connections on port $self->{listen_port}."); + $self->log("info", "Listening for TCP connections on port $self->{listen_port}."); return $browser; } diff --git a/lib/MasterServer/TCP/Handler.pm b/lib/MasterServer/TCP/Handler.pm index 2fb05f5..1a075bf 100755 --- a/lib/MasterServer/TCP/Handler.pm +++ b/lib/MasterServer/TCP/Handler.pm @@ -33,47 +33,53 @@ sub read_tcp_handle { # allow multiple blocks to add to the response string my $response = ""; + + # print debug values + $self->log("debug","$a:$p sent $rxbuf"); # replace empty values for the string "undef" and replace line endings from netcatters # parse the received data and extrapolate all the query commands found my %r = (); $m =~ s/\\\\/\\undef\\/; - $m =~ s/\n//; + $m =~ s/\\$/\\undef\\/; $m =~ s/\\([^\\]+)\\([^\\]+)/$r{$1}=$2/eg; # secure/validate challenge # part 2: receive \gamename\ut\location\0\validate\$validate\final\ $val = $self->handle_validate(\%r, $h, $secure, $a, $p) if (exists $r{validate} && !$val); - + # about query $response .= $self->handle_about($r{about}, $a, $p) if (exists $r{about}); # return address list - # part 3: wait for the requested action: \list\gamename\ut\ + # part 3: wait for the requested action: \list\\gamename\ut\ $self->handle_list($val, \%r, $c, $a, $p) if (exists $r{list} && exists $r{gamename}); # Sync request from another 333networks-based masterserver. Respond with list # of requested games (or all games). $self->handle_sync($val, \%r, $c, $a, $p) if (exists $r{sync}); + # + # Support echo: doesn't do anything but print to log if not suppressed. + $self->log("echo","($a:$p): $r{echo}") if $r{echo}; + # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # improper syntax/protocol -- no valid commands found # respond with an error. # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # - if ($m =~ m/!(about|sync|validate|list)/) { + if ("about sync validate list" =~ m/\Q$response\E/i) { # error message to client $c->push_write("\\echo\\333networks did not understand your request. ". "Contact us via 333networks.com\\final\\"); # and log it - $self->log("error","invalid request from Browser $a:$p with unknown message \"$rxbuf\"", $self->{log_settings}->{handler_error}); + $self->log("error","invalid request from Browser $a:$p with unknown message \"$rxbuf\"."); } # end if weird query else { $c->push_write($response . "\\final\\") if ($response ne ""); } - } @@ -87,22 +93,28 @@ sub handle_validate { # auth var init my $val = 0; - + # pass or fail the secure challenge - if (exists $r->{gamename} && length $self->get_cipher(lc $r->{gamename}) > 1 ) { + if (exists $r->{gamename} && length $self->get_game_props(lc $r->{gamename})->{cipher} > 1 ) { # game exists and we have the key to verify the response - $val = $self->validated_request($r->{gamename}, $secure, $r->{enctype}, $r->{validate}); - + $val = $self->compare_challenge( + gamename => $r->{gamename}, + secure => $secure, + enctype => $r->{enctype}, + validate => $r->{validate}, + ignore => $self->{ignore_browser_key}, + ); + # update for future queries $self->{browser_clients}->{$h}[1] = $val; } elsif (exists $r->{gamename}) { # log - $self->log("support", "received unknown gamename request \"$r->{gamename}\" from $a:$p"); + $self->log("support", "received unknown gamename request \"$r->{gamename}\" from $a:$p."); } - # log - $self->log("secure","$a:$p validated with $val for $r->{gamename}, $secure, $r->{validate}"); + # log (the spam!) + #$self->log("secure","$a:$p validated with $val for $r->{gamename}, $secure, $r->{validate}"); # return auth status return $val; @@ -124,47 +136,30 @@ sub handle_validate { sub handle_about { my ($self, $about, $a, $p) = @_; my $response = ""; - - # + # contact info - # if ($about =~ /^contact$/i or $about =~ /^undef$/i) { - $response .= "\\about\\$self->{contact_details}"; - - # log/print + $response .= "\\about\\$self->{masterserver_hostname}, contact: $self->{masterserver_contact}"; $self->log("about","communicating to $a:$p my contact information."); } - # - # build info - # - if ($about =~ /^build$/i or $about =~ /^undef$/i) { - + # build/version info + if ($about =~ /^build$/i or $about =~ /^version$/i or $about =~ /^undef$/i) { $response .= "\\build\\$self->{build_type} $self->{build_version} written " . "by $self->{build_author}, released $self->{build_date}"; - - # log/print $self->log("about","telling $a:$p my build info."); } - # # address info - # if ($about =~ /^address$/i or $about =~ /^undef$/i) { - $response .= "\\address\\$self->{masterserver_address}" . "\\listen_port\\$self->{listen_port}" . "\\beacon_port\\$self->{beacon_port}"; - - # log/print $self->log("about","telling $a:$p my address/config info."); } - # # support info - # if ($about =~ /^support$/i or $about =~ /^undef$/i) { - # string games in database my $sg = $self->get_gamenames(); my $sgs = ""; @@ -172,13 +167,15 @@ sub handle_about { $sgs .= " " if (length $sgs > 0); $sgs .= $_->[0]; } - - # print response $response .= "\\support\\$sgs"; - - #log/print $self->log("about","telling $a:$p which games are supported."); } + + # unsupported query + if ("contact build address support version undef" !~ m/$about/i) { + $response .= "\\echo\\incorrect query usage, supported queries are: contact build version address support."; + $self->log("about","incorrect query \"$about\", telling $a:$p the supported \"about\" queries."); + } # return response string return $response; @@ -200,7 +197,7 @@ sub handle_list { my $data = ""; # determine the return format - if ($self->{hex_format} =~ m/$r->{gamename}/i or $r->{gamename} =~ /^cmp$/i) { + if ($self->{hex_format} =~ m/$r->{gamename}/i or $r->{list} =~ /^cmp$/i) { # return addresses as byte format (ip=ABCD port=EF) $data .= $self->compile_list_cmp($r->{gamename}); } @@ -215,7 +212,7 @@ sub handle_list { # immediately send to client $c->push_write($data); - # log successful (debug) + # log successful $self->log("list","$a:$p successfully retrieved the list for $r->{gamename}."); # clean and close the connection @@ -244,7 +241,7 @@ sub handle_sync { my ($self, $val, $r, $c, $a, $p) = @_; # alternate part 3: wait for the requested action: \sync\(all|list of games)\sender\domainname - $self->log("tcp","Sync request from $a:$p found"); + $self->log("tcp","Sync request from $a:$p found."); if ($val && exists $r->{sync}) { @@ -256,8 +253,7 @@ sub handle_sync { $c->push_write($data); # log successful (debug) - if (exists $r->{sender}) {$self->log("sync","$r->{sender} successfully synced.");} - else {$self->log("sync","$a:$p successfully synced.");} + $self->log("sync-tx","$a:$p successfully synced."); # clean and close the connection $self->clean_tcp_handle($c); diff --git a/lib/MasterServer/TCP/ListCompiler.pm b/lib/MasterServer/TCP/ListCompiler.pm index 1863757..a5571d0 100755 --- a/lib/MasterServer/TCP/ListCompiler.pm +++ b/lib/MasterServer/TCP/ListCompiler.pm @@ -3,6 +3,7 @@ package MasterServer::TCP::ListCompiler; use strict; use warnings; + use Exporter 'import'; our @EXPORT = qw| compile_list compile_list_cmp compile_sync |; @@ -15,7 +16,10 @@ sub compile_list { my ($self, $gamename) = @_; # get the list from database - my $serverlist = $self->get_game_list($gamename); + my $serverlist = $self->get_server( + updated => 3600, + gamename => $gamename, + ); # prepare empty return string my $response_string = ""; @@ -24,9 +28,9 @@ sub compile_list { for (@{$serverlist}){ # append \ip\ip:port to string - $response_string .= "\\ip\\$_->[0]:$_->[1]"; + $response_string .= "\\ip\\$_->{ip}:$_->{port}"; } - + # return the string with data return $response_string; } @@ -39,7 +43,10 @@ sub compile_list_cmp { my ($self, $gamename) = @_; # get the list from database - my $serverlist = $self->get_game_list($gamename); + my $serverlist = $self->get_server( + updated => 3600, + gamename => $gamename, + ); # prepare empty return string my $response_string = ""; @@ -48,8 +55,8 @@ sub compile_list_cmp { for (@{$serverlist}){ # convert ip address to ABCDEF mode - my ($A, $B, $C, $D) = ($_->[0] =~ /(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})/); - my ($E, $F) = ($_->[1] >> 8, $_->[1] & 0xFF); + my ($A, $B, $C, $D) = ($_->{ip} =~ /(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})/); + my ($E, $F) = ($_->{port} >> 8, $_->{port} & 0xFF); # print as chr string of 6 bytes long my $bin = ""; $bin .= (chr $A) . (chr $B) . (chr $C) . (chr $D) . (chr $E) . (chr $F); @@ -87,20 +94,23 @@ sub compile_sync { } # only get unique values from array - @games = map { $_ => 1 } @games; + my %games = map { $_ => 1 } @games; # get the list for every requested gamename - for my $g (@games) { - + for my $g (keys %games) { + # $g is now a gamename -- check if it's supported. Else ignore. - if (length $self->get_cipher(lc $g) > 1) { + if ($self->get_game_props($g)) { # get list from database - my $list = $self->get_game_list($g); + my $list = $self->get_server( + updated => 7200, + gamename => $g, + ); # add all games to string separated by spaces my $gamestring = ""; - foreach $_ (@{$list}) {$gamestring .= "$_->[0]:$_->[1] ";} + foreach $_ (@{$list}) {$gamestring .= "$_->{ip}:$_->{port} ";} # if it contains at least one entry, add the list to the response list $response_string .= "\\$g\\$gamestring" if (length $gamestring >= 7); diff --git a/lib/MasterServer/TCP/Syncer.pm b/lib/MasterServer/TCP/Syncer.pm index 2ba52ca..bfe3d78 100755 --- a/lib/MasterServer/TCP/Syncer.pm +++ b/lib/MasterServer/TCP/Syncer.pm @@ -7,39 +7,9 @@ use AnyEvent; use AnyEvent::Handle; use Exporter 'import'; -our @EXPORT = qw| syncer_scheduler sync_with_master process_sync_list|; - -################################################################################ -## Syncer Scheduler -## Request the masterlist for selected or all games from other -## 333networks-based masterservers. -################################################################################ -sub syncer_scheduler { - my $self = shift; - - # log active - $self->log("load", "Synchronisation module active."); - - # go through the list of provided addresses - my $i = 0; - return AnyEvent->timer ( - after => $self->{sync_time}[0], - interval => $self->{sync_time}[1], - cb => sub { - # check if there's a master server entry to be synced. If not, return - # to zero and go all over again. - $i = 0 unless $self->{sync_masters}[$i]; - return if (!defined $self->{sync_masters}[$i]); - - # synchronze with master $i - $self->log("tcp", "Attempting to synchronize with $self->{sync_masters}[$i]->{address}"); - $self->sync_with_master($self->{sync_masters}[$i]); - - #increment counter - $i++; - } - ); -} +our @EXPORT = qw| sync_with_master + process_sync_list + masterserver_list |; ################################################################################ ## Sends synchronization request to another 333networks based master server and @@ -47,6 +17,9 @@ sub syncer_scheduler { ################################################################################ sub sync_with_master { my ($self, $ms) = @_; + + # announce + $self->log("tcp", "Attempting to synchronize with $ms->{ip}"); # list to store all IPs in. my $sync_list = ""; @@ -54,11 +27,11 @@ sub sync_with_master { # connection handle my $handle; $handle = new AnyEvent::Handle( - connect => [$ms->{address} => $ms->{port}], - timeout => 3, + connect => [$ms->{ip} => $ms->{tcp}], + timeout => 4, poll => 'r', - on_error => sub {$self->log("error","$! on $ms->{address} $ms->{port}"); $handle->destroy;}, - on_eof => sub {$self->process_sync_list($sync_list, $ms); $handle->destroy;}, + on_error => sub {$self->log("error","$! on $ms->{ip} $ms->{tcp}"); $handle->destroy;}, + on_eof => sub {$self->process_sync_list($sync_list, $ms); $handle->destroy;}, on_read => sub { # receive and clear buffer my $m = $_[0]->rbuf; @@ -78,13 +51,20 @@ sub sync_with_master { $m =~ s/\\([^\\]+)\\([^\\]+)/$r{$1}=$2/eg; # respond to the validate challenge - my $validate = $self->validate_string("333networks", $r{secure}, $r{enctype}); + my $validate = $self->validate_string( + gamename => "333networks", + secure => $r{secure}, + enctype => $r{enctype} + ); # part 2: send \gamename\ut\location\0\validate\$validate\final\ $handle->push_write("\\gamename\\333networks\\location\\0\\validate\\$validate\\final\\"); # part 3: request the list \sync\gamenames consisting of space-seperated game names or "all" - my $request = "\\sender\\$self->{masterserver_address}\\sync\\".(($self->{sync_games}[0] == 0) ? "all" : $self->{sync_games}[1])."\\final\\"; + # compatibility note: old queries use "new", instead treat them as "all". + my $request = "\\sync\\" + . (($self->{sync_games}[0] == 0) ? ("all" or "new") : $self->{sync_games}[1]) + . "\\final\\"; # push the request to remote host $handle->push_write($request); @@ -119,7 +99,7 @@ sub process_sync_list { if (exists $r{echo}) { # remote address says... - $self->log("error", "$ms->{address} replied: $r{echo}"); + $self->log("error", "$ms->{ip} replied: $r{echo}"); } @@ -152,7 +132,7 @@ sub process_sync_list { } else { # invalid address, log - $self->log("error", "invalid address found while syncing at $ms->{address}: $l!"); + $self->log("error", "invalid address found while syncing at $ms->{ip}: $l!"); } } # endif ($l =~ /:/) @@ -165,7 +145,41 @@ sub process_sync_list { } # end while # end message - $self->log("sync", "received $c addresses after syncing from $ms->{address}"); + $self->log("sync-rx", "received $c addresses after syncing from $ms->{ip}:$ms->{tcp}"); } - + +################################################################################ +## Determine a list of all unique 333networks-compatible masterservers +## and return this list. Join the brotherhood! +################################################################################ +sub masterserver_list { + my $self = shift; + my %brotherhood; + + # start with the masterservers defined in our configuration file + for my $ms (@{$self->{sync_masters}}) { + my $ip = $self->host2ip($ms->{address}); + $brotherhood{"$ip:$ms->{port}"} = {ip => $ip, tcp => $ms->{port}, udp => $ms->{beacon}} if $ip; + } + + # get the list of uplinking masterservers + my $serverlist = $self->get_server( + updated => 3600, + gamename => "333networks", + limit => 50, # more would be ridiculous.. right?.. + ); + + # overwrite existing entries, add new + for my $ms (@{$serverlist}) { + $brotherhood{"$ms->{ip}:$ms->{hostport}"} = {ip => $ms->{ip}, tcp => $ms->{hostport}, udp => $ms->{port}}; + } + + # masterservers that sync with us can not be derived directly, but by reading + # the server log we can add them manually. Lot of work, little gain, as those + # syncing masterservers will most likely be uplinking as well between now and + # a few weeks/months. + + return \%brotherhood; +} + 1; diff --git a/lib/MasterServer/UDP/UCCAppletQuery.pm b/lib/MasterServer/TCP/UCCAppletQuery.pm index f92c20c..e3eb587 100755 --- a/lib/MasterServer/UDP/UCCAppletQuery.pm +++ b/lib/MasterServer/TCP/UCCAppletQuery.pm @@ -1,5 +1,5 @@ -package MasterServer::UDP::UCCAppletQuery; +package MasterServer::TCP::UCCAppletQuery; use strict; use warnings; @@ -7,34 +7,7 @@ use AnyEvent; use AnyEvent::Handle; use Exporter 'import'; -our @EXPORT = qw| ucc_applet_query_scheduler query_applet |; - -################################################################################ -## Query Epic Games'-based UCC applets periodically to get an additional -## list of online UT, Unreal (or other) game servers. -################################################################################ -sub ucc_applet_query_scheduler { - my $self = shift; - $self->log("load", "UCC Applet Query Scheduler is loaded."); - - my $i = 0; - return AnyEvent->timer ( - after => $self->{master_applet_time}[0], - interval => $self->{master_applet_time}[1], - cb => sub { - # check if there's a master server entry to be queried. If not, return - # to zero and go all over again. - $i = 0 unless $self->{master_applet}[$i]; - return if (!defined $self->{master_applet}[$i]); - - # perform the query - $self->query_applet($self->{master_applet}[$i]); - - #increment counter - $i++; - } - ); -} +our @EXPORT = qw| query_applet |; ################################################################################ ## The UCC Applet (Epic Megagames, Inc.) functions as a master server for one @@ -45,7 +18,7 @@ sub query_applet { my ($self, $ms) = @_; # be nice to notify - $self->log("query","start querying $ms->{ip}:$ms->{port} for '$ms->{game}' games"); + $self->log("tcp","start querying $ms->{ip}:$ms->{port} for '$ms->{game}' games"); # list to store all IPs in. my $master_list = ""; @@ -69,9 +42,22 @@ sub query_applet { # part 1: receive \basic\\secure\$key if ($m =~ m/\\basic\\\\secure\\/) { - # skip to part 3: also request the list \list\gamename\ut -- skipped in UCC applets - #$handle->push_write("\\list\\\\gamename\\$ms->{game}"); - $handle->push_write("\\list\\"); + + # received data + my %r; + $m =~ s/\\([^\\]+)\\([^\\]+)/$r{$1}=$2/eg; + + # respond to challenge + my $validate = $self->validate_string(gamename => $ms->{game}, + enctype => $r{enctype}||0, + secure => $r{secure}); + + # send response + $handle->push_write("\\gamename\\$ms->{game}\\location\\0\\validate\\$validate\\final\\"); + + # part 3: also request the list \list\gamename\ut -- skipped in UCC applets + $handle->push_write("\\list\\\\gamename\\$ms->{game}\\final\\"); + } # part 3b: receive the entire list in multiple steps. diff --git a/lib/MasterServer/UDP/BeaconCatcher.pm b/lib/MasterServer/UDP/BeaconCatcher.pm index 0d5ce81..06fd38a 100755 --- a/lib/MasterServer/UDP/BeaconCatcher.pm +++ b/lib/MasterServer/UDP/BeaconCatcher.pm @@ -16,8 +16,8 @@ our @EXPORT = qw| beacon_catcher on_beacon_receive|; sub beacon_catcher { my $self = shift; - # module startup log - $self->log("load","Loading UDP Beacon Catcher."); + # display that the server is up and listening for beacons + $self->log("info", "Listening for UDP beacons on port $self->{beacon_port}."); # UDP server my $udp_server; @@ -30,9 +30,6 @@ sub beacon_catcher { on_recv => sub {$self->on_beacon_receive(@_)}, ); - # display that the server is up and listening for beacons - $self->log("info", "Listening for UT Beacons on port $self->{beacon_port}."); - # allow object to exist beyond this scope. Objects have ambitions too. return $udp_server; } @@ -57,14 +54,18 @@ sub on_beacon_receive { # truncate and try to continue $b = substr $b, 0, 64; } - + # if a heartbeat format was detected... $self->process_udp_beacon($udp, $pa, $b, $peer_addr, $port) if ($b =~ m/\\heartbeat\\/ && $b =~ m/\\gamename\\/); - + # or if this is a secure response, verify the response $self->process_udp_validate($b, $peer_addr, $port, undef) if ($b =~ m/\\validate\\/); + + # or if other masterservers check if we're still alive + $self->process_udp_basic($udp, $pa, $b, $peer_addr) + if ($b =~ m/\\basic\\/ || $b =~ m/\\status\\/ || $b =~ m/\\info\\/); } 1; diff --git a/lib/MasterServer/UDP/BeaconChecker.pm b/lib/MasterServer/UDP/BeaconChecker.pm index a99be72..f74378d 100755 --- a/lib/MasterServer/UDP/BeaconChecker.pm +++ b/lib/MasterServer/UDP/BeaconChecker.pm @@ -6,93 +6,7 @@ use warnings; use AnyEvent::Handle::UDP; use Exporter 'import'; -our @EXPORT = qw| beacon_checker query_udp_server|; - -################################################################################ -## When addresses are stored in the 'pending' list, they are supposed to be -## queried immediately with the secure/validate challenge to testify that -## the server is genuine and alive. -## -## Some servers do not support the secure-challenge on the Uplink port. These -## servers are verified with a secure-challenge on their heartbeat ports, -## which are designed to respond to secure queries, as well as status queries. -## -## Addresses collected by other scripts, whether from the UCC applet or manual -## input via the website, are added to the pending list. It is more -## important to verify pending beacons and new server addresses, than to -## update the status of existing addresses. Therefore, pending addresses are -## prioritized. -################################################################################ -sub beacon_checker { - my $self = shift; - $self->log("load", "UDP Beacon Checker is loaded."); - - # queue -- which address is next in line? - my %q = ( pending_id => 0, server_id => 0, - start_time => time+$self->{beacon_checker_time}[0]-1); #time+grace - - # go through all servers one by one, new and old - my $server_info = AnyEvent->timer ( - after => $self->{beacon_checker_time}[0], - interval => $self->{beacon_checker_time}[1], - cb => sub { - - # first of all, check whether we exceeded our time cap limit - if ( (time - $q{start_time}) >= $self->{beacon_checker_time}[2] ){ - # reset queue variables - $q{pending_id} = 0; - $q{server_id} = 0; - $q{start_time} = time; - } - - # See if there are pending servers, and use existing secure string for - # the challenge. - my $n = $self->get_next_pending($q{pending_id}); - - # if any entries were found, proceed - if ( $n->[0] ) { - - # next pending id will be > $n - $q{pending_id} = $n->[0]; - - # query the server - $self->query_udp_server($n->[1], $n->[2], $n->[3]); - - # work done. Wait for the next round for the next timer tick. - return; - } - - # if no pending servers left, update the other entries - $n = $self->get_next_server($q{server_id}); - - # if any entries were found, proceed - if ( $n->[0] ) { - - # next server id will be > $n - $q{server_id} = $n->[0]; - - # query the server (no secure string) - $self->query_udp_server($n->[1], $n->[2], ""); - - # work done. Wait for the next round for the next task. - return; - } - - # At this point, we are out of server entries. When new servers are - # added, they are immediately queried on the next round. - # From here on, just count down until the cycle is complete and handle - # new entries while they are added to the list. - - } - ); - - # at the start of the module, remind host how often this happens - $self->log("info", "Verifying servers every $self->{beacon_checker_time}[2] seconds."); - - # return the timer object to keep it alive outside of this scope - return $server_info; -} - +our @EXPORT = qw| query_udp_server|; ################################################################################ ## Get the server status from any server over UDP and store the received @@ -100,11 +14,11 @@ sub beacon_checker { ## secure/pending or information. ################################################################################ sub query_udp_server { - my ($self, $ip, $port, $secure) = @_; + my ($self, $id, $ip, $port, $secure, $message_type) = @_; my $buf = ""; # debug spamming - $self->log("udp", "Query server $ip:$port"); + $self->log("udp", "Query server $id ($ip:$port)"); # connect with UDP server my $udp_client; $udp_client = AnyEvent::Handle::UDP->new( @@ -118,40 +32,51 @@ sub query_udp_server { # add packet to buffer $buf .= $_[0]; + # message type 0: \basic\\info\ + # if gamename, ver, hostname and hostport are available, but NOT the value + # "listenserver", it would have been \basic\info + if ($buf =~ m/\\gamename\\/ && + $buf =~ m/\\hostname\\/ && + $buf =~ m/\\hostport\\/ && + $buf !~ m/\\listenserver\\/ ) { + $self->process_query_response($buf, $ip, $port); + } + + # message type 1: \basic\\secure\wookie # if validate, assume that we sent a \basic\secure request. if ($buf =~ m/\\validate\\/){ $self->process_udp_validate($buf, $ip, undef, $port); } - # if gamename, ver, hostname and hostport are available, it should - # have been \basic\info - elsif ($buf =~ m/\\gamename\\/ && $buf =~ m/\\gamever\\/ - && $buf =~ m/\\hostname\\/ && $buf =~ m/\\hostport\\/) { - $self->process_query_response($buf, $ip, $port); + + # message type 2: \status\ + # contains same info as \basic\\info, but also "listenserver". Only for UT. + if ($buf =~ m/\\gamename\\ut/ && + $buf =~ m/\\hostname\\/ && + $buf =~ m/\\hostport\\/ && + $buf =~ m/\\listenserver\\/ ) { + $self->process_status_response($buf, $ip, $port); } + # else partial information received. wait for more. - else{ } + # else { } }, ); # # Send secure message or status, depending on provided variables - # + # Message types can be + # 0: \basic\\info\ + # 1: \basic\\secure\wookie + # 2: \status\ + # - # secure servers enabled and secure key provided - if ($secure ne "" && $self->{require_secure_beacons} > 0) { - # send secure - $udp_client->push_send("\\basic\\\\secure\\$secure"); - - # and log that we sent it - $self->log("udp", "sending secure=\"$secure\" to $ip:$port"); - } - else { - # send information request - $udp_client->push_send("\\basic\\\\info\\"); - - # and log that we sent it - $self->log("udp","sending basic request to $ip:$port"); - } + # determine the message + my $message = "\\basic\\\\info\\"; # default 0 + $message = "\\basic\\\\secure\\$secure" if ($secure ne "" && $self->{require_secure_beacons} > 0); # message_type 1 + $message = "\\status\\" if ($message_type == 2); + + # send selected message + $udp_client->push_send($message); } 1; diff --git a/lib/MasterServer/UDP/DatagramProcessor.pm b/lib/MasterServer/UDP/DatagramProcessor.pm index f80f6fb..863512c 100755 --- a/lib/MasterServer/UDP/DatagramProcessor.pm +++ b/lib/MasterServer/UDP/DatagramProcessor.pm @@ -1,4 +1,3 @@ - package MasterServer::UDP::DatagramProcessor; use strict; @@ -10,6 +9,7 @@ use Exporter 'import'; our @EXPORT = qw| process_udp_beacon process_udp_validate process_query_response + process_status_response process_ucc_applet_query |; ################################################################################ @@ -23,8 +23,10 @@ sub process_udp_beacon { # received heartbeat in $buf: \heartbeat\7778\gamename\ut\ my %r; + my $raw = $buf; # raw buffer for logging if necessary $buf = encode('UTF-8', $buf); $buf =~ s/\\([^\\]+)\\([^\\]+)/$r{$1}=$2/eg; + # check whether the beacon has a gamename if (defined $r{gamename}) { @@ -32,19 +34,37 @@ sub process_udp_beacon { $self->log("beacon", "$peer_addr:$r{heartbeat} for $r{gamename}"); # some games (like bcommander) have a default port and don't send a heartbeat port. - $r{heartbeat} = $self->get_default_port($r{gamename}) if ($r{heartbeat} == 0); + $r{heartbeat} = $self->get_game_props($r{gamename})->{heartbeat} if ($r{heartbeat} == 0); # # verify valid server address (ip+port) if ($self->valid_address($peer_addr,$r{heartbeat})) { + + # check if the entry already was not added within the last 5 seconds, throttle otherwise + my $throttle = $self->get_pending( + ip => $peer_addr, + heartbeat => $r{heartbeat}, + gamename => $r{gamename}, + after => 5, + sort => "added", + limit => 1 + )->[0]; + return if (defined $throttle); # generate a new secure string my $secure = $self->secure_string(); # update beacon in serverlist if it already exists, otherwise update # or add to pending with new secure string. - my $auth = $self->add_beacon($peer_addr, $port, $r{heartbeat}, $r{gamename}, $secure); - + my $auth = $self->add_server_new(ip => $peer_addr, + beaconport => $port, + heartbeat => $r{heartbeat}, + gamename => $r{gamename}, + secure => $secure, + direct => 1, + updated => time, + beacon => time); + # send secure string back if ($auth > 0) { @@ -59,14 +79,21 @@ sub process_udp_beacon { # invalid ip+port combination, like \heartbeat\0\ or local IP else { # Log that beacon had incorrect information, such as port 0 or so. Spams log! - $self->log("invalid","$peer_addr:$r{heartbeat} ($r{heartbeat}) had bad information"); + $self->log("invalid","$peer_addr had bad information --> $raw"); } } - # gamename not valid or not found in supportedgames.pl + # gamename not valid or recognized, display raw buffer in case data could not + # be extrapolated from the heartbeat else { # log - $self->log("support", "received unknown beacon \"$r{gamename}\" from $peer_addr:$r{heartbeat}"); + $self->log("support", "received unknown beacon from $peer_addr --> $raw"); + # + # TODO: more practical way to log this to the database: new table + # named "unsupported" where messages are logged by ip, port, gamename (if + # applicable) and TEXT raw message. + # + } } @@ -78,51 +105,83 @@ sub process_udp_validate { # $self, udp data, ip, port my ($self, $buf, $peer_addr, $port, $heartbeat) = @_; + # debug spamming + # $self->log("udp", "Received response from $peer_addr:$heartbeat, sent |$buf|"); + # received heartbeat in $b: \validate\string\queryid\99.9\ my %r; $buf = encode('UTF-8', $buf); $buf =~ s/\\([^\\]+)\\([^\\]+)/$r{$1}=$2/eg; # get our existing knowledge about this server from the database - # if the heartbeat/queryport known? then use that instead as beacon ports --> may vary after server restarts! - my $pending = (defined $heartbeat) - ? $self->get_pending_info($peer_addr, $heartbeat) - : $self->get_pending_beacon($peer_addr, $port); + my $pending = $self->get_pending( + ip => $peer_addr, + limit => 1, + ($heartbeat ? (heartbeat => $heartbeat) : () ), + ($port ? (beaconport => $port) : () ), + )->[0]; - # if indeed in the pending list, check -- if this entry is not (longer) in the list, it + # if indeed in the pending list, check; -- if this entry is not (longer) in the list, it # was either removed by the BeaconChecker or cleaned out in maintenance (after X hours). if (defined $pending) { #determine if it uses any enctype my $enc = (defined $r{enctype}) ? $r{enctype} : 0; - # database may not contain the correct gamename (ucc applet, incomplete beacon, change of gameserver) - $pending->[4] = (defined $r{gamename}) ? $r{gamename} : $pending->[4]; + # database may not contain the correct gamename (ucc applet, incomplete beacon, other game) + $pending->{gamename} = $r{gamename} if (defined $r{gamename}); - # verify challenge gamename secure enctype validate_response - my $val = $self->validated_beacon($pending->[4], $pending->[5], $enc, $r{validate}); - - # log challenge results ($port may not have been provided) - $port = (defined $port) ? $port : $heartbeat; - $self->log("secure", "$peer_addr:$port validated with $val for $pending->[4]"); + # verify challenge + my $val = $self->compare_challenge( + gamename => $pending->{gamename}, + secure => $pending->{secure}, + enctype => $r{enctype}, + validate => $r{validate}, + ignore => $self->{ignore_beacon_key}, + ); - # if validated, add to db - if ($val > 0) { + # if validated, add server to database + if ($val > 0 || $self->{require_secure_beacons} == 0) { - # successfully added? ip, query port, gamename - my $sa = $self->add_to_serverlist($pending->[1], $pending->[3], $pending->[4]); + # select server from serverlist -- should not exist yet. + my $srv = $self->get_server(ip => $pending->{ip}, port => $pending->{heartbeat})->[0]; - # remove the entry from pending if successfully added - $self->remove_pending($pending->[0]) if ( $sa >= 0); + # was found, then update gamename and remove from pending + if (defined $srv) { + my $sa = $self->update_server_list( + ip => $pending->{ip}, + port => $pending->{heartbeat}, + gamename => $pending->{gamename} + ); + # remove the entry from pending if successfully added + $self->remove_pending($pending->{id}) if ( $sa >= 0); + } + # was not found, insert clean and remove from pending + else { + my $sa = $self->add_server_list( + ip => $pending->{ip}, + port => $pending->{heartbeat}, + gamename => $pending->{gamename} + ); + # remove the entry from pending if successfully added + $self->remove_pending($pending->{id}) if ( $sa > 0); + } } else { - # else failed validation - $self->log("error","beacon $peer_addr:$port failed validation for $pending->[4] (details: $pending->[5] sent, got $r{validate})"); + # else failed validation + # calculate expected result for log + my $validate_string = $self->validate_string( + gamename => $pending->{gamename}, + secure => $pending->{secure} + ); + $self->log("secure","$pending->{id} for $pending->{gamename} sent: $pending->{secure}, got $r{validate}, expected $validate_string"); } } + # if no entry found in pending list else { - # else failed validation - $self->log("error","server not found in pending for $peer_addr and unknown heartbeat/port"); + # 404 not found + $self->log("error","server not found in pending for $peer_addr:", + ($heartbeat ? $heartbeat : "" ), ($port ? $port : "" ), " !"); } } @@ -140,37 +199,116 @@ sub process_query_response { $buf =~ s/\\([^\\]+)\\([^\\]+)/$s{$1}=$2/eg; # check whether the gamename is supported in our db - if (defined $s{gamename} && length $self->get_cipher(lc $s{gamename}) > 1) { + if (defined $s{gamename} && + length $self->get_game_props($s{gamename})->{cipher} > 1) { # parse variables my %nfo = (); - - $nfo{gamename} = lc $s{gamename}; $nfo{gamever} = exists $s{gamever} ? $s{gamever} : ""; $nfo{hostname} = exists $s{hostname} ? $s{hostname} : "$ip:$port"; $nfo{hostport} = exists $s{hostport} ? $s{hostport} : 0; - # some mor0ns have values longer than 100 characters - $nfo{hostname} = substr $nfo{hostname}, 0, 99 if (length $nfo{hostname} >= 99); + # some mor0ns have hostnames longer than 200 characters + $nfo{hostname} = substr $nfo{hostname}, 0, 199 if (length $nfo{hostname} >= 199); # log results - $self->log("hostname", "$ip:$port\t is now known as\t $nfo{hostname}"); + $self->log("hostname", "$ip:$port is now known as $nfo{hostname}"); - # if only validated servers are allowed in the list - if ($self->{require_secure_beacons} > 0) { - # only update in database - $self->update_serverlist($ip, $port, \%nfo); - } - # otherwise also add the server to serverlist if required - else{ - # add to serverlist and update anyway - $self->add_to_serverlist($ip, $port, $nfo{gamename}); - $self->update_serverlist($ip, $port, \%nfo); + # add or update in serverlist (assuming validation is complete) + $self->update_server_list( + ip => $ip, + port => $port, + gamename => $s{gamename}, + %nfo); + + # if address is in pending list, remove it + my $pen = $self->get_pending(ip => $ip, heartbeat => $port)->[0]; + $self->remove_pending($pen->{id}) if $pen; + } +} + +################################################################################ +## Process status data that was obtained with \status\ from the +## UT serverstats checker module. +################################################################################ +sub process_status_response { + # $self, udp data, ip, port + my ($self, $buf, $ip, $port) = @_; + + #process datastream + my %s; + $buf = encode('UTF-8', $buf); + $buf =~ s/\\([^\\]+)\\([^\\]+)/$s{$1}=$2/eg; + + # check whether this server is in our database + my $serverlist_id = $self->get_server(ip => $ip, port => $port)->[0]; + + # only allow servers that were approved/past pending + if (defined $serverlist_id) { + + # + # pre-process variables before putting them in the db + # + + # gamename should in all cases be "ut" (we only allow this for UT games at the moment!) + return if (!defined $s{gamename} || $s{gamename} ne "ut"); + + # some people trying to sneak their Unreal servers into the UT serverlist + return if (!defined $s{gamever} || $s{gamever} eq "227i"); + + # some sanity checks for the presentation + $s{hostname} = substr $s{hostname}, 0, 199 if ($s{hostname} && length $s{hostname} >= 199); + $s{mapname} = substr $s{mapname}, 0, 99 if ($s{mapname} && length $s{mapname} >= 99); + $s{maptitle} = substr $s{maptitle}, 0, 99 if ($s{maptitle} && length $s{maptitle} >= 99); + + # + # Store info in database + # + + # check if the ID already exists in the database + my $utserver_id = $self->get_utserver(id => $serverlist_id->{id})->[0]; + + # add and/or update + $self->add_utserver($ip, $port) if (not defined $utserver_id); + $self->update_utserver($serverlist_id->{id}, %s); + + # + # Player info + # + + # delete all players for this server. + $self->delete_utplayers($serverlist_id->{id}); + + # iterate through all player IDs and add them to the database + for (my $i = 0; exists $s{"player_$i"}; $i++) { - # if address is in pending list, remove it - my $pending = $self->get_pending_info($ip, $port); - $self->remove_pending($pending->[0]) if $pending; + # shorten name (some people might be overcompensating their names) + $s{"player_$i"} = substr $s{"player_$i"}, 0, 39 if (length $s{"player_$i"} > 39); + + my %player = (); + $player{player} = exists $s{"player_$i"} ? $s{"player_$i"} : "Player"; + $player{team} = exists $s{"team_$i"} ? $s{"team_$i"} : 255; + $player{team} = ($player{team} =~ m/^[0-3]/ ) ? int($player{team}) : 255; + $player{frags} = exists $s{"frags_$i"} ? int($s{"frags_$i"}) : 0; + $player{mesh} = exists $s{"mesh_$i"} ? $s{"mesh_$i"} : ""; + $player{skin} = exists $s{"skin_$i"} ? $s{"skin_$i"} : ""; + $player{face} = exists $s{"face_$i"} ? $s{"face_$i"} : ""; + $player{ping} = exists $s{"ping_$i"} ? int($s{"ping_$i"}) : 0; + $player{ngsecret} = exists $s{"ngsecret_$i"} ? $s{"ngsecret_$i"} : ""; # contains bot info + + # write to db + $self->insert_utplayer($serverlist_id->{id}, %player); } + + # + # Prevent null concatenation in logging + $s{numplayers} ||= 0; + $s{maxplayers} ||= 0; + $s{mapname} ||= "Unknown map"; + $s{hostname} ||= "Unknown hostname"; + + # log results + $self->log("utserver", "$serverlist_id->{id}, $ip:$port,\t $s{numplayers}/$s{maxplayers} players, $s{mapname}, $s{hostname}"); } } @@ -204,7 +342,12 @@ sub process_ucc_applet_query { $self->log("add", "applet query added $ms->{game}\t$a\t$p"); # add server - $self->add_pending($a, $p, $ms->{game}, $self->secure_string()); + $self->add_server_new(ip => $a, + beaconport => $p, + heartbeat => $p, + gamename => $ms->{game}, + secure => $self->secure_string(), + updated => time); } # invalid address, log else {$self->log("error", "invalid address found at master applet $ms->{ip}: $l!");} @@ -215,7 +358,7 @@ sub process_ucc_applet_query { $self->{dbh}->commit; # print findings - $self->log("applet","found $c addresses at $ms->{ip} for $ms->{game}."); + $self->log("applet-rx","found $c addresses at $ms->{ip} for $ms->{game}."); } diff --git a/lib/MasterServer/UDP/UDPTicker.pm b/lib/MasterServer/UDP/UDPTicker.pm new file mode 100755 index 0000000..5a34a8f --- /dev/null +++ b/lib/MasterServer/UDP/UDPTicker.pm @@ -0,0 +1,298 @@ + +package MasterServer::UDP::UDPTicker; + +use strict; +use warnings; +use AnyEvent::Handle::UDP; +use Exporter 'import'; + +our @EXPORT = qw| udp_ticker |; + +################################################################################ +## When addresses are stored in the 'pending' list, they are supposed to be +## queried immediately with the secure/validate challenge to testify that +## the server is genuine and alive. +## +## Some servers do not support the secure-challenge on the Uplink port. These +## servers are verified with a secure-challenge on their heartbeat ports, +## which are designed to respond to secure queries, as well as status queries. +## +## Addresses collected by other scripts, whether from the UCC applet or manual +## input via the website, are added to the pending list. It is more +## important to verify pending beacons and new server addresses, than to +## update the status of existing addresses. Therefore, pending addresses are +## prioritized. +## +## Another function required for 333networks is the "server info" part of the +## site. UT servers are queried and stored in the database. This is the lowest +## priority for the masterserver and is therefore performed last. +## +################################################################################ +sub udp_ticker { + my $self = shift; + + # inform that we are running + $self->log("info", "UDP Ticker is loaded."); + + # queue -- which address is next in line? + my %reset = (start => time, id => 0); + my %pending = (%reset, c => 0, limit => 900); # 900s ~ 15m + my %updater = (%reset, c => 0, limit => 1800); # 1800s ~ 30m + my %ut_serv = (%reset, c => 0, limit => 300); # 300s ~ 5m + my %oldserv = (%reset, c => 0, limit => 86400); # 86400s ~ 24h + + my $debug_counter = 0; + + # go through all servers that need querying + my $server_info = AnyEvent->timer ( + after => 75, # first give beacons a chance to uplink + interval => 0.2, # 5 addresses per second is fast enough + cb => sub { + + # after the first full run was completed, reset the counters when loop time expires + if (defined $self->{firstrun}) { + # reset timer + %reset = (start => time, id => 0, c => 0); + + # + # it can happen that a run takes more than the allowed time + # in that case, allow more time + # + + # pending + if (time - $pending{start} > $pending{limit}) { + if ($pending{c} > 0) { + # done within defined time, reset + %pending = (%pending, %reset); + } + } + + # ut servers + if (time - $ut_serv{start} > $ut_serv{limit}) { + if ($ut_serv{c} > 0) { + # done within defined time, reset + %ut_serv = (%ut_serv, %reset) + } + } + + # updater + if (time - $updater{start} > $updater{limit}) { + if ($updater{c} > 0) { + # done within defined time, reset + %updater = (%updater, %reset); + } + } + + # old servers + if (time - $oldserv{start} > $oldserv{limit}) { + if ($oldserv{c} > 0) { + %oldserv = (%oldserv, %reset); + } + } + + # + # else { print "Making overtime!" } + +=pod + # FIXME remove this if above works + + # debug: detect premature resets + if (time - $pending{start} > $pending{limit}) { + if ($pending{c} == 0) { + print "Premature pending reset\n" ; + } + else{$pending{c} = 0;} + } + + if (time - $updater{start} > $updater{limit}) { + if ($updater{c} == 0) { + print "Premature updater reset\n" ; + } + else{$updater{c} = 0;} + } + + if (time - $ut_serv{start} > $ut_serv{limit}) { + if ($ut_serv{c} == 0) { + print "Premature ut_serv reset\n" ; + } + else{$ut_serv{c} = 0;} + } + + if (time - $oldserv{start} > $oldserv{limit}) { + if ($oldserv{c} == 0) { + print "Premature oldserv reset\n" ; + } + else{$oldserv{c} = 0;} + } + + # are we making overtime on any of the counters yet? + %pending = (%pending, %reset) if (time - $pending{start} > $pending{limit}); + %updater = (%updater, %reset) if (time - $updater{start} > $updater{limit}); + %ut_serv = (%ut_serv, %reset) if (time - $ut_serv{start} > $ut_serv{limit}); + %oldserv = (%oldserv, %reset) if (time - $oldserv{start} > $oldserv{limit}); +=cut + } + + # + # Check pending beacons + # + + # pending beacons/servers (15 seconds grace time) + my $n = $self->get_pending( + next_id => $pending{id}, + added => 15, + sort => "id", + limit => 1 + )->[0] if $self->{beacon_checker_enabled}; + + # if next pending server/address exists: + if ( $n ) { + # next pending id will be > $n + $pending{id} = $n->{id}; + + # query the server using the heartbeat port provided in the beacon/manual add + $self->query_udp_server( + $n->{id}, + $n->{ip}, + $n->{heartbeat}, + $n->{secure}, # secure string necessary! + 1, # request secure challenge + ); + + # our work is done for this cycle. + return; + } + + # pending are done and is allowed to reset at a later stadium + $pending{c}++; + + + # + # Query Unreal Tournament 99 (demo) servers for serverstats + # + + # next server in line + $n = $self->get_server( + next_id => $ut_serv{id}, + updated => 3600, + gamename => "ut", + sort => "id", + limit => 1, + )->[0] if $self->{utserver_query_enabled}; + + # if next server/address exists: + if ( $n ) { + #next pending id will be > $n + $ut_serv{id} = $n->{id}; + + # query the server (no secure string) + $self->query_udp_server( + $n->{id}, + $n->{ip}, + $n->{port}, + "", # no secure string necessary + 2, # request full status info + ); + + # our work is done for this cycle. + return; + } + + # ut servers are done and is allowed to reset at a later stadium + $ut_serv{c}++; + + # + # update existing servers (both ut/non-ut) + # + + # next server in line + $n = $self->get_server( + next_id => $updater{id}, + updated => 7200, + sort => "id", + limit => 1, + )->[0] if $self->{beacon_checker_enabled}; + + # if next server/address exists: + if ( $n ) { + #next pending id will be > $n + $updater{id} = $n->{id}; + + # query the server (no secure string) + $self->query_udp_server( + $n->{id}, + $n->{ip}, + $n->{port}, + "", # no secure string necessary + 0, # request info + ); + + # our work is done for this cycle. + return; + } + + # updating servers is done and is allowed to reset at a later stadium + $updater{c}++; + + # + # Query servers older than 2 hours + # + + # next server in line + $n = $self->get_server( + next_id => $oldserv{id}, + before => 7200, + sort => "id", + limit => 1, + )->[0] if $self->{beacon_checker_enabled}; + + # if next server/address exists: + if ( $n ) { + #next old server id will be > $n + $oldserv{id} = $n->{id}; + + # query the server (no secure string) + $self->query_udp_server( + $n->{id}, + $n->{ip}, + $n->{port}, + "", # no secure string necessary + 0, # request info + ); + + # our work is done for this cycle. + return; + } + + # old servers are done and is allowed to reset at a later stadium + $oldserv{c}++; + + # and notify about first run being completed + if (!defined $self->{firstrun}) { + # inform that first run is completed + my $t = time-$self->{firstruntime}; + my $t_readable = ($t > 60) ? (($t/60). ":". ($t%60). "minutes") : ($t. "seconds"); + + $self->log("info", "First run completed after $t_readable."); + $self->{firstrun} = 0; + + # reset all counters and follow procedure + %reset = (start => time, id => 0, c => 0); + %pending = (%pending, %reset); + %updater = (%updater, %reset); + %ut_serv = (%ut_serv, %reset); + %oldserv = (%oldserv, %reset); + } + + # At this point, we are out of server entries. From here on, just count + # down until the cycle is complete and handle new entries while they are + # added to the list. + + } + ); + + # return the timer object to keep it alive outside of this scope + return $server_info; +} + +1; diff --git a/lib/MasterServer/UDP/UpLink.pm b/lib/MasterServer/UDP/UpLink.pm new file mode 100755 index 0000000..e5c703b --- /dev/null +++ b/lib/MasterServer/UDP/UpLink.pm @@ -0,0 +1,169 @@ +package MasterServer::UDP::UpLink; + +use strict; +use warnings; +use Encode; +use AnyEvent::Handle::UDP; +use Socket qw(sockaddr_in inet_ntoa); +use Exporter 'import'; + +our @EXPORT = qw| send_heartbeats + do_uplink + process_uplink_response + process_udp_secure + process_udp_basic |; + +################################################################################ +## Broadcast heartbeats to other masterservers +## +################################################################################ +sub send_heartbeats { + my $self = shift; + + # in order to be permitted to sync, you need to share your address too so + # others can sync from you too. + if ($self->{sync_enabled}) { + + # uplink to every entry of the masterserver brotherhood list + foreach my $uplink (values %{$self->masterserver_list()}) { + # send uplink + $self->do_uplink($uplink->{ip}, $uplink->{udp}); + } + } +} + + +################################################################################ +## Do an uplink to other 333networks-based masterservers so we can be shared +## along the 333networks synchronization protocol. Other 333networks-based +## masterservers are shared in this way too. +################################################################################ +sub do_uplink { + my ($self, $ip, $port) = @_; + + # do not proceed if not all information is available + return unless (defined $ip && defined $port && $port > 0); + + # debug spamming + $self->log("uplink", "Uplink to Masterserver $ip:$port"); + + # connect with UDP server + my $udp_client; $udp_client = AnyEvent::Handle::UDP->new( + # Bind to this host and port + connect => [$ip, $port], + timeout => 5, + on_timeout => sub {$udp_client->destroy();}, # don't bother reporting timeouts + on_error => sub {$udp_client->destroy();}, # or errors + on_recv => sub {$self->process_uplink_response(@_)}, + ); + + # Send heardbeat + $udp_client->push_send("\\heartbeat\\$self->{beacon_port}\\gamename\\333networks"); +} + +################################################################################ +## Process requests received after uplinking +## +################################################################################ +sub process_uplink_response { + # $self, beacon address, handle, packed client address + my ($self, $b, $udp, $pa) = @_; + + # unpack ip from packed client address + my ($port, $iaddr) = sockaddr_in($pa); + my $peer_addr = inet_ntoa($iaddr); + + # if the beacon has a length longer than a certain amount, assume it is + # a fraud or crash attempt + if (length $b > 64) { + # log + $self->log("attack","length exceeded in uplink response: $peer_addr:$port sent $b"); + + # truncate and try to continue + $b = substr $b, 0, 64; + } + + # check if this is a secure challenge + $self->process_udp_secure($udp, $pa, $b, $peer_addr) + if ($b =~ m/\\secure\\/); +} + + +################################################################################ +## Process the received secure query and respond with the correct response +## +################################################################################ +sub process_udp_secure { + # $self, handle, packed address, udp data, peer ip address, $port + my ($self, $udp, $pa, $buf, $peer_addr) = @_; + + # received secure in $buf: \basic\secure\l8jfVy + my %r; + my $raw = $buf; # raw buffer for logging if necessary + $buf = encode('UTF-8', $buf); + $buf =~ s/\\\\/\\undef\\/; + $buf =~ s/\n//; + $buf =~ s/\\([^\\]+)\\([^\\]+)/$r{$1}=$2/eg; + + # scope + my $response = ""; + + # provide basic information if asked for (not uncommon) + if (defined $r{basic}) { + # compile basic string (identical to process_udp_basic) + + # format: \gamename\ut\gamever\348\minnetver\348\location\0\final\\queryid\16.1 + $response .= "\\gamename\\333networks" + . "\\gamever\\$self->{short_version}" + . "\\location\\0" + . "\\hostname\\$self->{masterserver_hostname}" + . "\\hostport\\$self->{listen_port}"; + } + + # we only respond with gamename = 333networks + if (defined $r{secure}) { + # get response + $response .= "\\validate\\" + . $self->validate_string(gamename => "333networks", + enctype => 0, + secure => $r{secure}); + } + + # send the response to the \basic\\secure\wookie query + $udp->push_send("$response\\final\\", $pa); +} + +################################################################################ +## Respond to basic or status queries +## TODO: abstract function for this -- otherwise these functions pile up. +################################################################################ +sub process_udp_basic { + # $self, handle, packed address, udp data, peer ip address, $port + my ($self, $udp, $pa, $buf, $peer_addr) = @_; + + # received basic or status in $buf: \basic\ or \status\ + my %r; + $buf = encode('UTF-8', $buf); + $buf =~ s/\\\\/\\undef\\/; + $buf =~ s/\n//; + $buf =~ s/\\([^\\]+)\\([^\\]+)/$r{$1}=$2/eg; + + # scope + my $basic = ""; + # provide basic information + + if (defined $r{basic} || defined $r{status} || defined $r{info}) { + # compile basic string (identical to process_udp_basic) + + # format: \gamename\ut\gamever\348\minnetver\348\location\0\final\\queryid\16.1 + $basic = "\\gamename\\333networks" + . "\\gamever\\$self->{short_version}" + . "\\location\\0" + . "\\hostname\\$self->{masterserver_hostname}" + . "\\hostport\\$self->{listen_port}"; + } + + # send the response to the \basic\ or \status\ + $udp->push_send("$basic\\final\\", $pa); +} +1; diff --git a/lib/MasterServer/Util/KFStatsWatcher.pm b/lib/MasterServer/Util/KFStatsWatcher.pm new file mode 100755 index 0000000..916446e --- /dev/null +++ b/lib/MasterServer/Util/KFStatsWatcher.pm @@ -0,0 +1,59 @@ + +package MasterServer::Util::KFStatsWatcher; + +use strict; +use warnings; +use AnyEvent::IO; +use Exporter 'import'; + +our @EXPORT = qw| read_kfstats |; + +################################################################################ +## Read Killing Floor Statistics from the file. +################################################################################ +sub read_kfstats { + my ($self) = shift; + + # open file and read content + return aio_load($self->{kfstats_file}, + sub { + my $f = shift; + + # process player data as blocks + my $block = ""; + + # read player stats + for my $l (split /^/, $f) { + + # add data to block + $block .= $l; + + # if block contains last item GamesLost, process block + if ($l =~ m/^(GamesLost=)/i){ + + # treat as array + my @s = split "\n", $block; + + # process items + my %h; + for my $m (@s) { + if ($m =~ m/(KFPlayerStats\])$/i) { $h{UTkey} = substr $m, 1, index($m, " ")-1; } + if ($m =~ m/=/) {$h{substr $m, 0, index($m, "=")} = substr $m, index($m, "=")+1; } + } + + # store in db + $self->write_kfstats(\%h); + + # clear block for next player + $block = ""; + } + } + + #notify + $self->log("kfstat", "Updated Killing Floor player stats."); + } + ); +} + + +1; |