diff options
Diffstat (limited to 'lib')
37 files changed, 1176 insertions, 2494 deletions
diff --git a/lib/MasterServer/Core/Core.pm b/lib/MasterServer/Core/Core.pm index 4d1e47b..db04344 100755 --- a/lib/MasterServer/Core/Core.pm +++ b/lib/MasterServer/Core/Core.pm @@ -5,32 +5,20 @@ use warnings; use AnyEvent; use Exporter 'import'; use DBI; -$|++; - our @EXPORT = qw | halt select_database_type main |; ################################################################################ ## Handle shutting down the program in case a fatal error occurs. +## clear all other timers, network servers, etc ################################################################################ sub halt { my $self = shift; - - # log shutdown - $self->log("stop", "Stopping the masterserver."); - - # clear all other timers, network servers, etc + $self->log("stop", "stopping the masterserver!"); $self->{dbh}->disconnect() if (defined $self->{dbh}); $self->{dbh} = undef; $self->{scope} = undef; - - # and send signal to condition var to let the loops end $self->{must_halt}->send; - - # log halt - $self->log("stop", "Shutting down NOW!"); - - # time for a beer. - exit; + exit; # time for a beer. } ################################################################################ @@ -39,28 +27,17 @@ sub halt { ################################################################################ sub select_database_type { my $self = shift; - - # read from login - my @db_type = split(':', $self->{dblogin}->[0]); + my @db_type = split(':', $self->{dblogin}->[0]); # from config file # format supported? if ( "Pg SQLite mysql" =~ m/$db_type[1]/i) { - - # inform us what DB we try to load - $self->log("debug","Loading $db_type[1] database module."); - - # load dbd and tables/queries for this db type + # load database for this 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."); + else { # we can not continue without database + $self->log("fatal", "the masterserver could not determine the chosen database type"); $self->halt(); } } @@ -70,88 +47,47 @@ sub select_database_type { ################################################################################ sub main { my $self = shift; - - # condition var prevents or allows the program from ending $self->{must_halt} = AnyEvent->condvar; - - # load version info $self->version(); - # print startup + # startup print "Running 333networks Master Server Application...\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", "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}"); + $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 + # load database and set up scope for timers/network $self->select_database_type(); - - ### - # - # execute necessary tasks for running the masterserver - # - ### - + $self->{scope} = (); + # load the list with ciphers from the config file if no ciphers were detected - # update manually with util/tools/db_load_ciphers.pl - # then unload the game variables from masterserver memory $self->load_ciphers() unless $self->check_cipher_count(); $self->{game} = undef; - # (re)load the list with masterservers and master applets from config - # does not clear out old entries, but resets "last_updated" to now + # reload the list with masterservers and master applets from config $self->load_sync_masters(); $self->load_applet_masters(); - # set first run flag to avoid ignoring/deleting servers after downtime + # first run flag for all startup actions $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) + # beacons and serverlists (listen for UDP beacons / TCP requests) $self->{scope}->{beacon_catcher} = $self->beacon_catcher(); - # - # provide server lists to clients with the browser host server $self->{scope}->{browser_host} = $self->browser_host(); - - ### - # + + # recurring tasks (sync and updates) + $self->{scope}->{long_periodic_tasks} = $self->long_periodic_tasks(); + $self->{scope}->{short_periodic_tasks} = $self->short_periodic_tasks(); + + # verify and update server status + $self->{scope}->{udp_ticker} = $self->udp_ticker() if $self->{beacon_checker_enabled}; + # all modules loaded. Running... - # - ### - $self->log("info", "All modules loaded. Masterserver is now running."); - - # prevent main program from ending as long as no fatal errors occur + $self->log("info", "all modules loaded. Masterserver is now running!"); $self->{must_halt}->recv; } diff --git a/lib/MasterServer/Core/LoadConfig.pm b/lib/MasterServer/Core/LoadConfig.pm index e209848..f0d0671 100755 --- a/lib/MasterServer/Core/LoadConfig.pm +++ b/lib/MasterServer/Core/LoadConfig.pm @@ -2,11 +2,9 @@ package MasterServer::Core::LoadConfig; use strict; use warnings; -use AnyEvent; +use DBI; use POSIX qw/strftime/; use Exporter 'import'; -use DBI; - our @EXPORT = qw | load_applet_masters load_sync_masters add_sync_master |; @@ -17,53 +15,33 @@ our @EXPORT = qw | load_applet_masters sub load_applet_masters { my $self = shift; - # loop through config entries + # iterate through all games per entry foreach my $master_applet (@{$self->{master_applet}}) { - # master_applet contains - # address --> domain - # port --> tcp port - # games --> array of gamenames - - # iterate through all games per entry for my $gamename (@{$master_applet->{games}}) { # resolve domain names my $applet_ip = $self->host2ip($master_applet->{address}); # check if all credentials are valid - if ($applet_ip && - $master_applet->{port} && - $gamename) - { - # add to database + if ($applet_ip && $master_applet->{port} && $gamename) { $self->add_master_applet( ip => $applet_ip, - port => $master_applet->{port}, + hostport => $master_applet->{port}, gamename => $gamename, ); - - #log $self->log("add", "added applet $master_applet->{address}:$master_applet->{port} for $gamename"); - } # else: insufficient info available - else { - $self->log("fail", "Could not add master applet: ". - ($applet_ip || "unknown ip"). ", ". - ($master_applet->{port} || "0"). ", ". - ($gamename || "game"). "." - ); - } + else { $self->log("fail", "could not add master applet: ". + ($applet_ip || "unknown ip"). ", ". + ($master_applet->{port} || "0"). ", ". + ($gamename || "game"));} } # end gamename } # end master_applet - # reset added/updated time to last current time - $self->reset_master_applets(); - - # clear out the original variable, we don't use it anymore + # reset added/updated time clear the applet list from memory + $self->reset_master_applets; $self->{master_applet} = (); - - # report - $self->log("info", "Applet database successfully updated!"); + $self->log("info", "applet database successfully updated"); } @@ -76,18 +54,13 @@ sub load_applet_masters { sub load_sync_masters { my $self = shift; - # loop through config entries + # add config entries to database foreach my $sync_host (@{$self->{sync_masters}}) { + $self->add_sync_master($sync_host);} - # add them to database - $self->add_sync_master($sync_host); - } - - # clear out the original variable, we don't use it anymore + # clear list from memory $self->{sync_masters} = (); - - # report - $self->log("info", "Sync server database successfully updated!"); + $self->log("info", "sync server database successfully updated"); } @@ -97,53 +70,18 @@ sub load_sync_masters { ################################################################################ sub add_sync_master { my ($self, $sync_host) = @_; - - # sync_host contains - # address --> domain - # port --> tcp port - # beacon --> udp port - - # resolve domain names my $sync_ip = $self->host2ip($sync_host->{address}); # check if all credentials are valid - if ($sync_ip && - $sync_host->{beacon} && - $sync_host->{port}) - { - # select sync master from serverlist - my $entry = $self->get_server(ip => $sync_ip, - port => $sync_host->{beacon})->[0]; - - # was found, update the entry - if (defined $entry) { - # update the serverlist with - my $sa = $self->update_server_list( - ip => $sync_ip, - port => $sync_host->{beacon}, - hostport => $sync_host->{port}, - gamename => "333networks", - ); - } - # was not found, insert clean entry - else { - my $sa = $self->add_server_list( - ip => $sync_ip, - port => $sync_host->{beacon}, - hostport => $sync_host->{port}, - gamename => "333networks", - ); - - #log - $self->log("add", "added sync $sync_host->{address}:$sync_host->{port},$sync_host->{beacon}"); - } + if ($sync_ip && $sync_host->{beacon}) { + # add it to the pending list so it gets picked up with the "normal" status update + $self->insert_pending(ip => $sync_ip, port => $sync_host->{beacon}); + $self->log("add", "added sync $sync_host->{address}:$sync_host->{beacon}"); } # else: insufficient info available - else { - $self->log("fail", "Could not add sync master: ". - ($sync_ip || "ip"). ", ". - ($sync_host->{beacon} || "0"). ", ". - ($sync_host->{port} || "0"). "." - ); + else { $self->log("fail", "failed to add sync master: ". + ($sync_host->{address}|| "domain"). ", ". + ($sync_ip || "invalid ip"). ", ". + ($sync_host->{beacon} || "invalid beacon port") ); } } diff --git a/lib/MasterServer/Core/Logging.pm b/lib/MasterServer/Core/Logging.pm index 416a97f..d2094ed 100755 --- a/lib/MasterServer/Core/Logging.pm +++ b/lib/MasterServer/Core/Logging.pm @@ -5,9 +5,8 @@ use warnings; use Switch; use POSIX qw/strftime/; use Exporter 'import'; -$|++; - our @EXPORT = qw| log error |; +$|++; ################################################################################ ## Split up errors in multiple log types for suppressing @@ -16,33 +15,18 @@ our @EXPORT = qw| log error |; sub error { my ($self, $error, $instigator) = @_; - # which error? + # which one? switch ($error) { - # connection timed out - case m/Connection timed out/i { - $self->log("timeout", "on $instigator."); - } - + case m/Connection timed out/i {$self->log("timeout", "on $instigator.");} # connection reset by peer - case m/Connection reset by peer/i { - $self->log("reset", "on $instigator."); - } - + case m/Connection reset by peer/i {$self->log("reset", "on $instigator.");} # connection refused - case m/Connection refused/i { - $self->log("refused", "on $instigator."); - } - + case m/Connection refused/i {$self->log("refused", "on $instigator.");} # no such device or address - case m/No such device or address/i { - $self->log("nodevice", "on $instigator."); - } - + case m/No such device or address/i {$self->log("nodevice", "on $instigator.");} # if all else fails - else { - $self->log("error", "$error on $instigator."); - } + else {$self->log("error", "$error on $instigator.");} } } @@ -54,7 +38,8 @@ sub log { my ($self, $type, $msg) = @_; # is the message suppressed in config? - return if (defined $type && $self->{suppress} =~ m/$type/i); + return if ($self->{suppress} =~ m/$type/i); + $type = "unknown" unless $type; # parse time of log entry and prep for rotating log my $time = strftime('%Y-%m-%d %H:%M:%S',localtime); @@ -71,11 +56,8 @@ sub log { # put log filename together my $logfile = $self->{log_dir}.((substr($self->{log_dir},-1) eq "/")?"":"/").$f; - - # print to stdout if enabled - print "[$time]\t[$type]\t$msg\n" if $self->{printlog}; - # temporarily disable the warnings-to-log, to avoid infinite recursion if + # temporarily disable the warnings-to-log, to avoid recursion if # this function throws a warning. my $old = $SIG{__WARN__}; $SIG{__WARN__} = undef; @@ -90,6 +72,19 @@ sub log { close $F; } $SIG{__WARN__} = $old; + + # color codes for fancy terminal output (not to file) + $type = "\e[1m\e[91m$type\e[0m" if ($type =~ m/(fatal|fail|error|stop)/i);# bold red + $type = "\e[91m$type\e[0m" if ($type =~ m/(refused|nodevice|timeout)/i); # red + $type = "\e[93m$type\e[0m" if ($type =~ m/(reset|warning|secure|unset)/i);# yellow + $type = "\e[95m$type\e[0m" if ($type =~ m/(add|update|delete)/i); # magenta + $type = "\e[96m$type\e[0m" if ($type =~ m/(list|uplink)/i); # cyan + $type = "\e[94m$type\e[0m" if ($type =~ m/(beacon|syncer)/i); # blue + $type = "\e[92m$type\e[0m" if ($type =~ m/(stat|kfnew)/i); # green + $type = "\e[1m\e[92m$type\e[0m" if ($type =~ m/(info|debug)/i); # bold green + + # print to stdout if enabled + print "[$time]\t[$type]\t$msg\n" if $self->{printlog}; } 1; diff --git a/lib/MasterServer/Core/Schedulers.pm b/lib/MasterServer/Core/Schedulers.pm index cee4e5c..230a423 100755 --- a/lib/MasterServer/Core/Schedulers.pm +++ b/lib/MasterServer/Core/Schedulers.pm @@ -6,11 +6,8 @@ use AnyEvent; use POSIX qw/strftime/; use Exporter 'import'; use DBI; - -our @EXPORT = qw | - long_periodic_tasks - short_periodic_tasks -|; +our @EXPORT = qw | long_periodic_tasks + short_periodic_tasks |; ################################################################################ ## tasks that are executed only once or twice per hour @@ -20,20 +17,18 @@ sub long_periodic_tasks { my $prev = 0; return AnyEvent->timer ( - after => 30, # 30 seconds grace time - interval => 3600, # execute every hour + after => 90, # grace time receiving beacons + interval => 3600, cb => sub { # update Killing Floor stats - $self->read_kfstats() if $self->{kfstats_enabled}; + $self->read_kfstats if $self->{kfstats_enabled}; # delete old masterserver applets that have been unresponsive for a while now - $self->remove_unresponsive_applets() if (defined $self->{firstrun}); + $self->remove_unresponsive_applets if (defined $self->{firstrun}); - # time spacer - my $t = 0; - # clean out handles from the previous round (executed or not) + my $t = 0; $self->{scope}->{sync} = (); # Synchronize with all other 333networks masterservers that are uplinking, @@ -42,7 +37,7 @@ sub long_periodic_tasks { # get serverlist my $masterserverlist = $self->get_server( - updated => 3600, + updated => 7200, gamename => "333networks", ); @@ -50,7 +45,7 @@ sub long_periodic_tasks { # add 5 second delay to spread network/server load $self->{scope}->{sync}->{$t} = AnyEvent->timer( after => 5*$t++, - cb => sub{$self->sync_with_master($ms)} + cb => sub{$self->synchronize($ms, "333nwm")} ) if ($ms->{hostport} > 0); } } @@ -63,22 +58,20 @@ sub long_periodic_tasks { if ($self->{master_applet_enabled}) { # get applet list - my $appletlist = $self->get_masterserver_applets(); + my $appletlist = $self->get_masterserver_applets; for my $ms (@{$appletlist}) { # add 5 second delay to spread network/server load $self->{scope}->{sync}->{$t} = AnyEvent->timer( after => 5*$t++, - cb => sub{$self->query_applet($ms)} + cb => sub{$self->synchronize($ms, "applet")} ); } } - # - # very long-running tasks, like database dumps + # very long-running tasks, like database dumps. # interval from config - # my $curr = 0; $curr = strftime('%d',localtime) if ($self->{dump_db} =~ /^daily$/i ); $curr = strftime('%U',localtime) if ($self->{dump_db} =~ /^weekly$/i ); @@ -87,19 +80,11 @@ sub long_periodic_tasks { # on change, execute if ($prev < $curr) { + # skip on first run and update timer + if ($prev == 0) { $prev = $curr; return; } - # skip on first run - if ($prev == 0) { - # update timer and loop - $prev = $curr; - return; - } - - # dump db - $self->dump_database(); - - # update timekeeper - $prev = $curr; + # dump db and update timer + $self->dump_database; $prev = $curr; } }, ); @@ -110,25 +95,21 @@ sub long_periodic_tasks { ################################################################################ sub short_periodic_tasks { my $self = shift; - return AnyEvent->timer ( - after => 10, + after => 5, interval => 120, cb => sub { - # update stats on direct beacons and total number of servers - $self->update_stats(); + $self->update_stats; # determine whether servers are still uplinking to us. If not, toggle. - $self->write_direct_beacons() if (defined $self->{firstrun}); + $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, so other - # masterservers can find us too - $self->send_heartbeats(); + # delete old servers from the "pending" list + $self->delete_old_pending; + # uplink to other 333networks masterservers so others can find us too + $self->send_heartbeats; }, ); } diff --git a/lib/MasterServer/Core/Secure.pm b/lib/MasterServer/Core/Secure.pm index 125e276..b3e401c 100755 --- a/lib/MasterServer/Core/Secure.pm +++ b/lib/MasterServer/Core/Secure.pm @@ -4,11 +4,11 @@ use strict; use warnings; use POSIX qw/strftime/; use Exporter 'import'; - our @EXPORT = qw| load_ciphers - secure_string - validate_string - compare_challenge |; + secure_string + auth_browser + auth_server + validate_string |; ################################################################################ ## Supported Games list ciphers @@ -24,13 +24,11 @@ sub load_ciphers { # first delete the old cipher database $self->clear_ciphers(); - # start inserting ciphers (use transactions for slow systems) + # start inserting ciphers (bulk) $self->{dbh}->begin_work; - # iterate through the game list + # iterate through the game list and insert entries for (keys %{$self->{game}}) { - - # verify entries my %opt = (); $opt{gamename} = lc $_; $opt{cipher} = $self->{game}->{$_}->{key}; @@ -40,13 +38,14 @@ sub load_ciphers { # insert the game/cipher in the db or halt on error if ($self->insert_cipher(%opt) < 0) { $self->{dbh}->rollback; + $self->log("fatal", "could not update cipher database"); $self->halt(); } } # commit $self->{dbh}->commit; - $self->log("info", "Cipher database successfully updated!"); + $self->log("info", "cipher database successfully updated"); } ################################################################################ @@ -61,42 +60,51 @@ sub secure_string { } ################################################################################ -# authenticate the \validate\ response for the \secure\ challenge. +# authenticate browser response for secure/validate challenge # returns 1 on valid response, 0 on invalid ################################################################################ -sub compare_challenge { - my ($self, %o) = @_; - - # debugging enabled? Then don't care about validation +sub auth_browser { + my ($self, %o) = @_; + # exceptions (debugging, exclusion) return 1 if ($self->{debug_validate}); - - # ignore this game if asked to do so - if ($self->{ignore_browser_key} =~ m/$o{gamename}/i){ - $self->log("ignore", "ignored beacon validation for $o{gamename}"); - return 1; - } - + return 1 if ($self->{ignore_browser_key} =~ m/$o{gamename}/i); + # calculate validate string my $val = get_validate_string( $self->get_game_props(gamename => $o{gamename})->[0]->{cipher}, $o{secure}, $o{enctype} || 0 ); - # return match or no match - return ($val eq ($o{validate} || "")); + return ( $o{validate} && ($val eq $o{validate}) ); } ################################################################################ -# obtain the secure/validate challenge string +# authenticate server response for secure/validate challenge +# returns 1 on valid response, 0 on invalid ################################################################################ -sub validate_string { +sub auth_server { my ($self, %o) = @_; + # exceptions (debugging, exclusion) + return 1 if ($self->{debug_validate}); + return 1 if ($self->{ignore_beacon_key} =~ m/$o{gamename}/i); - # secure string too long? discard as hack. - return 0 if (length $o{secure} > 6); + # calculate validate string + my $val = get_validate_string( + $self->get_game_props(gamename => $o{gamename})->[0]->{cipher}, + $o{secure}, + $o{enctype} || 0 + ); + # return match or no match + return ( $o{validate} && ($val eq $o{validate}) ); +} - # calculate and return validate string +################################################################################ +# calculate and return validate string +# requires gamename +################################################################################ +sub validate_string { + my ($self, %o) = @_; return get_validate_string( $self->get_game_props(gamename => $o{gamename})->[0]->{cipher}, $o{secure}, @@ -146,8 +154,8 @@ sub get_validate_string { my ($cipher_string, $secure_string, $enctype) = @_; # convert to array of characters - my @cip = split "", $cipher_string; - my @sec = split "", $secure_string; + my @cip = split "", $cipher_string || ""; + my @sec = split "", $secure_string || ""; # length of strings/arrays which should be 6 my $sec_len = scalar @sec; @@ -161,8 +169,8 @@ sub get_validate_string { my ($i,$j,$k,$l,$m,$n,$p); # too short or too long -- return empty string - return "" if ($sec_len <= 0 || $sec_len >= 32); - return "" if ($cip_len <= 0 || $cip_len >= 32); + return "" if ($sec_len <= 0 || $sec_len > 8); + return "" if ($cip_len <= 0 || $cip_len > 8); # temporary array with ascii characters my @enc; diff --git a/lib/MasterServer/Core/Stats.pm b/lib/MasterServer/Core/Stats.pm index 8e9eb95..4f23723 100755 --- a/lib/MasterServer/Core/Stats.pm +++ b/lib/MasterServer/Core/Stats.pm @@ -4,7 +4,6 @@ use strict; use warnings; use AnyEvent::IO; use Exporter 'import'; - our @EXPORT = qw| update_stats |; ################################################################################ @@ -13,25 +12,38 @@ our @EXPORT = qw| update_stats |; 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}) { + # find all gamenames with 1 server or more + my $in_slist = $self->get_gamenames(); + my $in_glist = $self->get_listedstats(); + + # list of unique gamenames + my %games; $games{$_->[0]} = 1 for (@{$in_slist}, @{$in_glist}); + + # update stats per gamename + for my $gamename (sort keys %games) { + + # get statistics per game + my $num = $self->get_gamestats($gamename)->[0]; - # 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); + # update in db + my $u = $self->write_stat( + gamename => $gamename, + num_uplink => $num->{num_uplink} || 0, + num_total => $num->{num_total} || 0, + ); + + # log stats too + if ( int($u) > 0) { + # log the statistics + $self->log("update", "updated stats ($num->{num_uplink}/$num->{num_total}) for $gamename"); + } else { + # report unable to update stats + $self->log("error", "can not update stats for $gamename"); + } } - - # done - $self->log("stat", "Updated all game statistics."); + + # notify + $self->log("stat", "updated all game statistics"); } 1; diff --git a/lib/MasterServer/Core/Util.pm b/lib/MasterServer/Core/Util.pm index 682335c..5af8264 100755 --- a/lib/MasterServer/Core/Util.pm +++ b/lib/MasterServer/Core/Util.pm @@ -2,12 +2,28 @@ package MasterServer::Core::Util; use strict; use warnings; -use IP::Country::Fast; use Socket; +use Encode; +use IP::Country::Fast; use POSIX qw/strftime/; use Exporter 'import'; +our @EXPORT = qw| data2hashref + ip2country + host2ip + valid_address + db_all + sqlprint |; -our @EXPORT = qw| ip2country host2ip valid_address db_all sqlprint |; +################################################################################ +## process udp/tcp data strings from \key\value to hash +################################################################################ +sub data2hashref { + my ($self, $str) = @_; + my @a = split /\\/, encode('UTF-8', $str||""); + shift @a; + my %h = (@a, (scalar @a % 2 == 1) ? "dummy" : () ); + return \%h; +} ################################################################################ ## return the abbreviated country name based on IP diff --git a/lib/MasterServer/Core/Version.pm b/lib/MasterServer/Core/Version.pm index 4a49392..0b4d058 100755 --- a/lib/MasterServer/Core/Version.pm +++ b/lib/MasterServer/Core/Version.pm @@ -3,10 +3,8 @@ package MasterServer::Core::Version; use strict; use warnings; use Exporter 'import'; - our @EXPORT = qw| version |; - ################################################################################ ## ## Version information @@ -29,13 +27,13 @@ sub version { $self->{build_type} = "333networks Masterserver-Perl Multidb"; # version - $self->{build_version} = "2.3.1"; + $self->{build_version} = "2.4.0"; # short version for uplinks $self->{short_version} = "MS-perl $self->{build_version}"; # date yyyy-mm-dd - $self->{build_date} = "2017-07-06"; + $self->{build_date} = "2017-08-22"; #author, email $self->{build_author} = "Darkelarious, darkelarious\@333networks.com"; diff --git a/lib/MasterServer/Database/Pg/dbAddServers.pm b/lib/MasterServer/Database/Pg/dbAddServers.pm index 31deb08..6befd83 100755 --- a/lib/MasterServer/Database/Pg/dbAddServers.pm +++ b/lib/MasterServer/Database/Pg/dbAddServers.pm @@ -4,159 +4,78 @@ 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 |; +our @EXPORT = qw| insert_server + update_server + insert_pending |; ################################################################################ -## Update an existing address or add a new address to the pending list. -## opts: direct beacon, set update, game +## Insert minimalistic game data into serverlist +## params: ip, port, hostport ################################################################################ -sub add_server_new { +sub insert_server { 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}) : (), - - # some applets have incorrect gamename lists, let udpticker update this - # entry instead. this way, applets don't overwrite with incorrect data - #$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{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); + my %o = (@_); - # 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); + return $self->{dbh}->do( + "INSERT INTO serverlist (ip, port, hostport, country) VALUES (?, ?, ?, ?)", + undef, $o{ip}, $o{port}, $o{hostport}, $self->ip2country($o{ip}) ); } ################################################################################ ## Update the server info in the serverlist +## required: id or ip + port/hostport ################################################################################ -sub update_server_list { +sub update_server { my $self = shift; - my %o = ( - updated => time, - @_); + my %o = (updated => time, @_); + + # either id, ip+port or ip+hostport are provided. + my %W = ( + $o{id} ? ( 'id = ?' => $o{id}) : (), + $o{ip} ? ( 'ip = ?' => $o{ip}) : (), + $o{port} ? ( 'port = ?' => $o{port}) : (), + $o{hostport} ? ('hostport = ?' => $o{hostport}) : (), + ); - # try updating it in serverlist + # update where possible 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}) : (), + $o{direct} ? ( 'b333ms = CAST(? AS BOOLEAN)' => $o{direct}) : (), + $o{direct} ? ( 'beacon = to_timestamp(?)' => $o{updated}) : (), + $o{updated} ? ( 'updated = to_timestamp(?)' => $o{updated}) : (), ); - my($q, @p) = sqlprint("UPDATE serverlist !H - WHERE ip = ? AND port = ?", \%H, $o{ip}, $o{port}); - + my($q, @p) = sqlprint("UPDATE serverlist !H !W", \%H, \%W); return $self->{dbh}->do($q, undef, @p); } ################################################################################ -## beacon was verified or otherwise accepted and will now be added to the -## serverlist. +## check if an ip, port/hostport combination is recent in the serverlist. +## if not, add the address to the pending list ################################################################################ -sub add_server_list { +sub insert_pending { my $self = shift; - my %o = @_; + my %o = (updated => 3600, @_ ); - # 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 count(*) FROM serverlist - WHERE ip = ? - AND port = ? - AND updated > to_timestamp(?)", - undef, $ip, $port, time-7200); - - # if found, return 0 - return 0 if ($u > 0); + # selection criteria + my %W = ( + $o{ip} ? ( 'ip = ?' => $o{ip}) : (), + $o{port} ? ( 'port = ?' => $o{port}) : (), + $o{updated} ? ('updated > to_timestamp(?)' => (time-$o{updated})) : (), + ); - # 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); + # determine if it already exsits + my($q, @p) = sqlprint("SELECT id FROM serverlist !W", \%W); + my $u = $self->{dbh}->do($q, undef, @p); + return 0 if int($u); - # notify (debug) - #$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 (debug) - #$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; + # else, insert in pending (duplicates may exist -- see remove_pending) + return $self->{dbh}->do("INSERT INTO pending (ip, heartbeat) VALUES (?, ?)", + undef, $o{ip}, $o{port} ); } 1; diff --git a/lib/MasterServer/Database/Pg/dbAppletActions.pm b/lib/MasterServer/Database/Pg/dbAppletActions.pm index dc7d941..9dcb3e7 100755 --- a/lib/MasterServer/Database/Pg/dbAppletActions.pm +++ b/lib/MasterServer/Database/Pg/dbAppletActions.pm @@ -3,7 +3,6 @@ package MasterServer::Database::Pg::dbAppletActions; use strict; use warnings; use Exporter 'import'; - our @EXPORT = qw| add_master_applet update_master_applet reset_master_applets @@ -18,19 +17,20 @@ sub add_master_applet { my %o = @_; my $u = $self->{dbh}->do( - "SELECT * FROM appletlist - WHERE ip = ? - AND port = ? + "SELECT * FROM appletlist + WHERE ip = ? + AND hostport = ? AND gamename = ?", - undef, $o{ip}, $o{port}, lc $o{gamename}); + undef, $o{ip}, $o{hostport}, lc $o{gamename}); # return if found return if ($u > 0); # insert applet data - return $self->{dbh}->do("INSERT INTO appletlist (ip, port, gamename) - SELECT ?, ?, ?", undef, - $o{ip}, $o{port}, lc $o{gamename}); + return $self->{dbh}->do( + "INSERT INTO appletlist (ip, hostport, gamename) + SELECT ?, ?, ?", + undef, $o{ip}, $o{hostport}, lc $o{gamename}); } ################################################################################ @@ -38,10 +38,11 @@ sub add_master_applet { ################################################################################ sub reset_master_applets { my $self = shift; - return $self->{dbh}->do("UPDATE appletlist - SET added = to_timestamp(?), - updated = to_timestamp(?)", - undef, time, time); + return $self->{dbh}->do( + "UPDATE appletlist + SET added = to_timestamp(?), + updated = to_timestamp(?)", + undef, time, time); } ################################################################################ @@ -50,12 +51,13 @@ sub reset_master_applets { sub update_master_applet { my ($self, %o) = @_; - return $self->{dbh}->do("UPDATE appletlist - SET updated = to_timestamp(?) - WHERE ip = ? - AND port = ? + return $self->{dbh}->do( + "UPDATE appletlist + SET updated = to_timestamp(?) + WHERE ip = ? + AND hostport = ? AND gamename = ?", - undef, time, $o{ip}, $o{port}, lc $o{gamename}); + undef, time, $o{ip}, $o{hostport}, lc $o{gamename}); } ################################################################################ @@ -66,10 +68,10 @@ sub get_masterserver_applets { my $self = shift; return $self->db_all( - "SELECT * - FROM appletlist - WHERE updated > to_timestamp(?)", - time-604800); + "SELECT * + FROM appletlist + WHERE updated > to_timestamp(?)", + time-604800); } ################################################################################ @@ -82,11 +84,12 @@ sub remove_unresponsive_applets { # remove entries my $u = $self->{dbh}->do( - "DELETE FROM appletlist - WHERE updated < to_timestamp(?)", undef, time-604800); + "DELETE FROM appletlist + WHERE updated < to_timestamp(?)", + undef, time-604800); # notify - $self->log("delete", "Removed $u entries from applet list.") if ($u > 0); + $self->log("delete", "Removed $u entries from applet list") if ($u > 0); } 1; diff --git a/lib/MasterServer/Database/Pg/dbCiphers.pm b/lib/MasterServer/Database/Pg/dbCiphers.pm index 5343065..6dde097 100755 --- a/lib/MasterServer/Database/Pg/dbCiphers.pm +++ b/lib/MasterServer/Database/Pg/dbCiphers.pm @@ -3,19 +3,17 @@ package MasterServer::Database::Pg::dbCiphers; use strict; use warnings; use Exporter 'import'; - our @EXPORT = qw| check_cipher_count clear_ciphers insert_cipher - get_game_props - get_gamenames |; + get_game_props |; ################################################################################ ## Check if ciphers exist ################################################################################ sub check_cipher_count { my $self = shift; - return $self->db_all('SELECT count(*) as num from games')->[0]->{num}; + return $self->db_all('SELECT count(gamename) as num from games')->[0]->{num}; } ################################################################################ @@ -23,9 +21,7 @@ sub check_cipher_count { ################################################################################ sub clear_ciphers { my $self = shift; - - # delete ALL entries - my $u = $self->{dbh}->do("DELETE FROM games"); + $self->{dbh}->do("DELETE FROM games"); } ################################################################################ @@ -56,10 +52,7 @@ sub insert_cipher { ################################################################################ sub get_game_props { my $s = shift; - my %o = ( - sort => '', - @_ - ); + my %o = (sort => '', @_); my %where = ( $o{gamename} ? ('gamename = ?' => lc $o{gamename}) : (), @@ -90,18 +83,4 @@ sub get_game_props { ); } - -################################################################################ -## 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/Pg/dbCore.pm b/lib/MasterServer/Database/Pg/dbCore.pm index 0891012..4b2d16f 100755 --- a/lib/MasterServer/Database/Pg/dbCore.pm +++ b/lib/MasterServer/Database/Pg/dbCore.pm @@ -4,50 +4,30 @@ use strict; use warnings; use POSIX qw/strftime/; use Exporter 'import'; - our @EXPORT = qw| database_login dump_database |; ################################################################################ ## 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; - - # get db info my @db_type = split(':', $self->{dblogin}->[0]); - - # inform what db we try to load - $self->log("info","Database: $db_type[1], $db_type[2]"); - - # create the dbi object + + # connect to Pg database my $dbh = DBI->connect(@{$self->{dblogin}}, {PrintError => 1}); # 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 + $self->log("info","Connected to $db_type[1] database $db_type[2]"); $dbh->{printerror} = 1; - - # 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; } ################################################################################ @@ -56,23 +36,15 @@ sub database_login { ################################################################################ sub dump_database { my $self = shift; - - # filename / time my $time = strftime('%Y-%m-%d-%H-%M',localtime); - - # FIXME - # separate absolute path and relative path, - # split database filename for dump filename. - + # read db credentials from db login my @db_type = split(':', $self->{dblogin}->[0]); $db_type[2] =~ s/dbname=//; # use pg_dump to dump Postgresql databases system("pg_dump $db_type[2] -U $self->{dblogin}->[1] > $self->{root}/data/dumps/Pg-$time-$db_type[2].db"); - - # log - $self->log("dump", "Dumping database to /data/dumps/$db_type[1]-$time.db"); + $self->log("dump", "Dumping database to /data/dumps/Pg-$time-$db_type[2].db"); } diff --git a/lib/MasterServer/Database/Pg/dbExtendedInfo.pm b/lib/MasterServer/Database/Pg/dbExtendedInfo.pm new file mode 100755 index 0000000..8ecc624 --- /dev/null +++ b/lib/MasterServer/Database/Pg/dbExtendedInfo.pm @@ -0,0 +1,88 @@ +package MasterServer::Database::Pg::dbExtendedInfo; + +use strict; +use warnings; +use MasterServer::Core::Util 'sqlprint'; +use Exporter 'import'; +our @EXPORT = qw| insert_extended + update_extended + delete_players + insert_players |; + +################################################################################ +## Add extended server information for a new server. +## opts: ipm hostport +################################################################################ +sub insert_extended { + my $self = shift; + my %o = ( @_); + return $self->{dbh}->do( + "INSERT INTO extended_info (server_id) + SELECT (SELECT id FROM serverlist WHERE ip = ? AND hostport = ?)", + undef, $o{ip}, $o{hostport}); +} + +################################################################################ +## Update serverinfo for an existing address to the utserver list. +## opts: all server info data fields. +################################################################################ +sub update_extended { + my $self = shift; + my %o = (updated => time, @_); + + # try updating it in serverlist + my %H = ( + $o{minnetver} ? ( 'minnetver = ?' => $o{minnetver} ) : (), + $o{location} ? ( 'location = ?' => $o{location} ) : (), + $o{listenserver} ? ( 'listenserver = ?' => $o{listenserver}) : (), + $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}) : ('numplayers = ?' => 0), + $o{maxplayers} ? ( 'maxplayers = ?' => $o{maxplayers}) : ('maxplayers = ?' => 0), + $o{minplayers} ? ( 'minplayers = ?' => $o{minplayers}) : ('minplayers = ?' => 0), + $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} ? ( 'mutators = ?' => $o{mutators}) : ('mutators = ?' => "None"), + $o{updated} ? ('updated = to_timestamp(?)' => $o{updated}) : (), + ); + + my($q, @p) = sqlprint("UPDATE extended_info !H WHERE server_id = ?", \%H, $o{sid}); + return $self->{dbh}->do($q, undef, @p); +} + +################################################################################ +## Delete all players from a certain server ID +## opts: server id +################################################################################ +sub delete_players { + my ($self, $sid) = @_; + + # delete players with server_id + return $self->{dbh}->do( + "DELETE FROM player_info WHERE server_id = ?", + undef, $sid); +} + +################################################################################ +## Insert player info for a single player in server sid +## opts: server id, player info +################################################################################ +sub insert_players { + my ($self, @pl) = @_; + my($q, @p) = sqlprint("INSERT INTO player_info (server_id, player, team, frags, mesh, skin, face, ping, ngsecret) VALUES (!l)", \@pl); + return $self->{dbh}->do($q, undef, @p); +} + +1; diff --git a/lib/MasterServer/Database/Pg/dbGetServers.pm b/lib/MasterServer/Database/Pg/dbGetServers.pm index e9bfaec..827443a 100755 --- a/lib/MasterServer/Database/Pg/dbGetServers.pm +++ b/lib/MasterServer/Database/Pg/dbGetServers.pm @@ -3,37 +3,35 @@ package MasterServer::Database::Pg::dbGetServers; use strict; use warnings; use Exporter 'import'; - our @EXPORT = qw| get_server get_pending |; ################################################################################ ## get server details for one or multiple servers -## opts: limit, see $order +## opts: limit, see %where or $order ################################################################################ sub get_server { my $s = shift; - my %o = ( - sort => '', - @_ - ); + my %o = (sort => '', blacklisted => 0, @_); 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{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{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})) : (), + + # never process blacklisted servers, unless explicitly specified + ('blacklisted = CAST(? AS BOOLEAN)' => $o{blacklisted}), ); my @select = ( qw| @@ -79,45 +77,29 @@ sub get_server { ################################################################################ ## get server details for one or multiple pending servers -## opts: limit, next_id, beaconport, heartbeat, gamename, secure, enctype, added +## opts: limit, next_id, ip, heartbeat port ################################################################################ sub get_pending { my $s = shift; - my %o = ( - sort => '', - @_ - ); + 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 @select = ( qw| id ip heartbeat 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 ?" : ""), + return $s->db_all( q| SELECT !s FROM pending !W ORDER BY !s| + .($o{limit} ? " LIMIT ?" : ""), join(', ', @select), \%where, $order, ($o{limit} ? $o{limit} : ()), ); } diff --git a/lib/MasterServer/Database/Pg/dbMaintenance.pm b/lib/MasterServer/Database/Pg/dbMaintenance.pm index 7a4fc23..f6c39b7 100755 --- a/lib/MasterServer/Database/Pg/dbMaintenance.pm +++ b/lib/MasterServer/Database/Pg/dbMaintenance.pm @@ -3,7 +3,6 @@ package MasterServer::Database::Pg::dbMaintenance; use strict; use warnings; use Exporter 'import'; - our @EXPORT = qw| delete_old_pending remove_pending |; @@ -12,14 +11,10 @@ our @EXPORT = qw| delete_old_pending ## where the server is unresponsive for more than 1 hour ################################################################################ sub delete_old_pending { - my ($self) = shift; - - # remove servers + my $self = shift; 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); } @@ -28,13 +23,11 @@ sub delete_old_pending { ## 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); + my $self = shift; + my %o = ( @_); + my $u = $self->{dbh}->do("DELETE FROM pending WHERE ip = ? AND heartbeat = ?", + undef, $o{ip}, $o{port}); + $self->log("delete", "removed $o{ip}, $o{port} from pending (".$u."x)") if ($u > 0); } 1; diff --git a/lib/MasterServer/Database/Pg/dbStats.pm b/lib/MasterServer/Database/Pg/dbStats.pm index 6e92ab6..cfd61a4 100755 --- a/lib/MasterServer/Database/Pg/dbStats.pm +++ b/lib/MasterServer/Database/Pg/dbStats.pm @@ -3,41 +3,47 @@ package MasterServer::Database::Pg::dbStats; use strict; use warnings; use Exporter 'import'; - -our @EXPORT = qw| get_gamelist_stats - write_direct_beacons +our @EXPORT = qw| get_gamenames + get_gamestats + get_listedstats write_stat + write_direct_beacons write_kfstats |; ################################################################################ -# calculate stats for all individual games +## get a list of distinct gamenames currently in the server list ################################################################################ -sub get_gamelist_stats { +sub get_gamenames { 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); + "SELECT distinct gamename + FROM serverlist"); } ################################################################################ -# 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. +## get statistics (num_direct, num_total) per gamename ################################################################################ -sub write_direct_beacons { +sub get_gamestats { + my ($self, $gn) = @_; + return $self->db_all( + "SELECT COUNT(CASE WHEN b333ms THEN 1 END) as num_uplink, count(*) as num_total + FROM serverlist + WHERE gamename = ? AND updated > to_timestamp(?)", + lc $gn, time-7200); +} + +################################################################################ +## 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_listedstats { 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); + return $self->{dbh}->selectall_arrayref( + "SELECT gamename + FROM games + WHERE num_uplink > 0 + OR num_total > 0"); } ################################################################################ @@ -45,19 +51,28 @@ sub write_direct_beacons { # 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( + my ($self, %o) = @_; + return $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); + undef, $o{num_uplink}, $o{num_total}, lc $o{gamename}); +} +################################################################################ +# 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); + $self->log("unset", "Lost $u direct beacons.") if ($u > 0); } ################################################################################ @@ -66,7 +81,7 @@ sub write_stat { sub write_kfstats { my ($self, $h) = @_; - # check if entry already excists. + # check if entry already exists. my $u = $self->{dbh}->selectall_arrayref( "SELECT * FROM kfstats WHERE UTkey = ? ", undef, $h->{UTkey}); @@ -74,13 +89,11 @@ sub write_kfstats { $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 + $self->{dbh}->do("UPDATE kfstats SET Username = ?, CurrentVeterancy = ?, TotalKills = ?, diff --git a/lib/MasterServer/Database/Pg/dbUTServerInfo.pm b/lib/MasterServer/Database/Pg/dbUTServerInfo.pm deleted file mode 100755 index 0bf005e..0000000 --- a/lib/MasterServer/Database/Pg/dbUTServerInfo.pm +++ /dev/null @@ -1,237 +0,0 @@ -package MasterServer::Database::Pg::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/SQLite/dbAddServers.pm b/lib/MasterServer/Database/SQLite/dbAddServers.pm index 592ab7b..88b1bc8 100755 --- a/lib/MasterServer/Database/SQLite/dbAddServers.pm +++ b/lib/MasterServer/Database/SQLite/dbAddServers.pm @@ -1,163 +1,81 @@ - package MasterServer::Database::SQLite::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 |; +our @EXPORT = qw| insert_server + update_server + insert_pending |; ################################################################################ -## Update an existing address or add a new address to the pending list. -## opts: direct beacon, set update, game +## Insert minimalistic game data into serverlist +## params: ip, port, hostport ################################################################################ -sub add_server_new { +sub insert_server { 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 = datetime(?, \'unixepoch\')' => $o{updated}) : (), - $o{beacon} ? ( 'beacon = datetime(?, \'unixepoch\')' => $o{beacon}) : (), - - # some applets have incorrect gamename lists, let udpticker update this - # entry instead. this way, applets don't overwrite with incorrect data - #$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{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); + my %o = (@_); - # 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); + return $self->{dbh}->do( + "INSERT INTO serverlist (ip, port, hostport, country) VALUES (?, ?, ?, ?)", + undef, $o{ip}, $o{port}, $o{hostport}, $self->ip2country($o{ip}) ); } ################################################################################ ## Update the server info in the serverlist +## required: id or ip + port/hostport ################################################################################ -sub update_server_list { +sub update_server { my $self = shift; - my %o = ( - updated => time, - @_); + my %o = (updated => time, @_); + + # either id, ip+port or ip+hostport are provided. + my %W = ( + $o{id} ? ( 'id = ?' => $o{id}) : (), + $o{ip} ? ( 'ip = ?' => $o{ip}) : (), + $o{port} ? ( 'port = ?' => $o{port}) : (), + $o{hostport} ? ('hostport = ?' => $o{hostport}) : (), + ); - # try updating it in serverlist + # update where possible 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 = datetime(?, \'unixepoch\')' => $o{updated}) : (), + $o{direct} ? ( 'b333ms = CAST(? AS BOOLEAN)' => $o{direct}) : (), + $o{direct} ? ( 'beacon = datetime(?, \'unixepoch\')' => $o{updated}) : (), + $o{updated} ? ( 'updated = datetime(?, \'unixepoch\')' => $o{updated}) : (), ); - my($q, @p) = sqlprint("UPDATE serverlist !H - WHERE ip = ? AND port = ?", \%H, $o{ip}, $o{port}); - + my($q, @p) = sqlprint("UPDATE serverlist !H !W", \%H, \%W); return $self->{dbh}->do($q, undef, @p); } ################################################################################ -## beacon was verified or otherwise accepted and will now be added to the -## serverlist. +## check if an ip, port/hostport combination is recent in the serverlist. +## if not, add the address to the pending list ################################################################################ -sub add_server_list { +sub insert_pending { my $self = shift; - my %o = @_; + my %o = (updated => 3600, @_ ); - # 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 count(*) FROM serverlist - WHERE ip = ? - AND port = ? - AND updated > datetime(?, 'unixepoch')", - undef, $ip, $port, time-7200); - - # if found, return 0 - return 0 if ($u > 0); + # selection criteria + my %W = ( + $o{ip} ? ( 'ip = ?' => $o{ip}) : (), + $o{port} ? ( 'port = ?' => $o{port}) : (), + $o{updated} ? ('updated > datetime(?, \'unixepoch\')' => (time-$o{updated})) : (), + ); - # 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); + # determine if it already exsits + my($q, @p) = sqlprint("SELECT id FROM serverlist !W", \%W); + my $u = $self->{dbh}->do($q, undef, @p); + return 0 if int($u); - # 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; + # else, insert in pending (duplicates may exist -- see remove_pending) + return $self->{dbh}->do("INSERT INTO pending (ip, heartbeat) VALUES (?, ?)", + undef, $o{ip}, $o{port} ); } 1; diff --git a/lib/MasterServer/Database/SQLite/dbAppletActions.pm b/lib/MasterServer/Database/SQLite/dbAppletActions.pm index d2421fc..1d9c975 100755 --- a/lib/MasterServer/Database/SQLite/dbAppletActions.pm +++ b/lib/MasterServer/Database/SQLite/dbAppletActions.pm @@ -3,7 +3,6 @@ package MasterServer::Database::SQLite::dbAppletActions; use strict; use warnings; use Exporter 'import'; - our @EXPORT = qw| add_master_applet update_master_applet reset_master_applets @@ -18,19 +17,20 @@ sub add_master_applet { my %o = @_; my $u = $self->{dbh}->do( - "SELECT * FROM appletlist - WHERE ip = ? - AND port = ? + "SELECT * FROM appletlist + WHERE ip = ? + AND hostport = ? AND gamename = ?", - undef, $o{ip}, $o{port}, lc $o{gamename}); + undef, $o{ip}, $o{hostport}, lc $o{gamename}); # return if found return if ($u > 0); # insert applet data - return $self->{dbh}->do("INSERT INTO appletlist (ip, port, gamename) - SELECT ?, ?, ?", undef, - $o{ip}, $o{port}, lc $o{gamename}); + return $self->{dbh}->do( + "INSERT INTO appletlist (ip, hostport, gamename) + SELECT ?, ?, ?", + undef, $o{ip}, $o{hostport}, lc $o{gamename}); } ################################################################################ @@ -38,10 +38,11 @@ sub add_master_applet { ################################################################################ sub reset_master_applets { my $self = shift; - return $self->{dbh}->do("UPDATE appletlist - SET added = datetime(?, \'unixepoch\'), - updated = datetime(?, \'unixepoch\')", - undef, time, time); + return $self->{dbh}->do( + "UPDATE appletlist + SET added = datetime(?, \'unixepoch\'), + updated = datetime(?, \'unixepoch\')", + undef, time, time); } ################################################################################ @@ -50,12 +51,13 @@ sub reset_master_applets { sub update_master_applet { my ($self, %o) = @_; - return $self->{dbh}->do("UPDATE appletlist - SET updated = datetime(?, \'unixepoch\') - WHERE ip = ? - AND port = ? + return $self->{dbh}->do( + "UPDATE appletlist + SET updated = datetime(?, \'unixepoch\') + WHERE ip = ? + AND hostport = ? AND gamename = ?", - undef, time, $o{ip}, $o{port}, lc $o{gamename}); + undef, time, $o{ip}, $o{hostport}, lc $o{gamename}); } ################################################################################ @@ -66,10 +68,10 @@ sub get_masterserver_applets { my $self = shift; return $self->db_all( - "SELECT * - FROM appletlist - WHERE updated > datetime(?, \'unixepoch\')", - time-604800); + "SELECT * + FROM appletlist + WHERE updated > datetime(?, \'unixepoch\')", + time-604800); } ################################################################################ @@ -82,11 +84,12 @@ sub remove_unresponsive_applets { # remove entries my $u = $self->{dbh}->do( - "DELETE FROM appletlist - WHERE updated < datetime(?, \'unixepoch\')", undef, time-604800); + "DELETE FROM appletlist + WHERE updated < datetime(?, \'unixepoch\')", + undef, time-604800); # notify - $self->log("delete", "Removed $u entries from applet list.") if ($u > 0); + $self->log("delete", "Removed $u entries from applet list") if ($u > 0); } 1; diff --git a/lib/MasterServer/Database/SQLite/dbCiphers.pm b/lib/MasterServer/Database/SQLite/dbCiphers.pm index f257b7b..1032b4e 100755 --- a/lib/MasterServer/Database/SQLite/dbCiphers.pm +++ b/lib/MasterServer/Database/SQLite/dbCiphers.pm @@ -3,19 +3,17 @@ package MasterServer::Database::SQLite::dbCiphers; use strict; use warnings; use Exporter 'import'; - our @EXPORT = qw| check_cipher_count clear_ciphers insert_cipher - get_game_props - get_gamenames |; + get_game_props |; ################################################################################ ## Check if ciphers exist ################################################################################ sub check_cipher_count { my $self = shift; - return $self->db_all('SELECT count(*) as num from games')->[0]->{num}; + return $self->db_all('SELECT count(gamename) as num from games')->[0]->{num}; } ################################################################################ @@ -23,9 +21,7 @@ sub check_cipher_count { ################################################################################ sub clear_ciphers { my $self = shift; - - # delete ALL entries - my $u = $self->{dbh}->do("DELETE FROM games"); + $self->{dbh}->do("DELETE FROM games"); } ################################################################################ @@ -56,10 +52,7 @@ sub insert_cipher { ################################################################################ sub get_game_props { my $s = shift; - my %o = ( - sort => '', - @_ - ); + my %o = (sort => '', @_); my %where = ( $o{gamename} ? ('gamename = ?' => lc $o{gamename}) : (), @@ -90,18 +83,4 @@ sub get_game_props { ); } - -################################################################################ -## 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/SQLite/dbCore.pm b/lib/MasterServer/Database/SQLite/dbCore.pm index 0772a4e..d16cb26 100755 --- a/lib/MasterServer/Database/SQLite/dbCore.pm +++ b/lib/MasterServer/Database/SQLite/dbCore.pm @@ -4,72 +4,47 @@ use strict; use warnings; use POSIX qw/strftime/; use Exporter 'import'; - our @EXPORT = qw| database_login dump_database |; ################################################################################ ## 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; - - # get db info my @db_type = split(':', $self->{dblogin}->[0]); - # inform what db we try to load - $self->log("info","Database: $db_type[1], $db_type[2]"); - # check if database file exists my $db_file = [split(':', $self->{dblogin}->[0])]->[2]; $db_file =~ s/dbname=//i; + # fatal error if database does not exist unless (-e $db_file) { - # fatal error $self->log("fatal", "Database file $db_file does not exist!"); - - # end program $self->halt(); } - # create the dbi object + # connect to SQLite database my $dbh = DBI->connect(@{$self->{dblogin}}, {PrintError => 1}); # 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 + $self->log("info","Connected to the $db_type[1] database $db_type[2]"); $dbh->{printerror} = 1; - # 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.. + # synchronous read/writing to the SQLite file OFF. Faster, but risk on data + # loss on crashes, premature exits or power failure. $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; } ################################################################################ @@ -78,21 +53,15 @@ sub database_login { ################################################################################ sub dump_database { my $self = shift; - - # filename / time my $time = strftime('%Y-%m-%d-%H-%M',localtime); # read db credentials from db login my @db_type = split ':', $self->{dblogin}->[0]; $db_type[2] =~ s/dbname=//; - - # split db path my @db_path = split '/', $db_type[2]; - # use pg_dump to dump Postgresql databases + # make a copy of the database file system("cp $db_type[2] $self->{root}/data/dumps/SQLite-$time-$db_path[-1]"); - - # log $self->log("dump", "Dumping database to /data/dumps/SQLite-$time-$db_path[-1]"); } diff --git a/lib/MasterServer/Database/SQLite/dbGetServers.pm b/lib/MasterServer/Database/SQLite/dbGetServers.pm index 719e00a..7ddce2b 100755 --- a/lib/MasterServer/Database/SQLite/dbGetServers.pm +++ b/lib/MasterServer/Database/SQLite/dbGetServers.pm @@ -3,37 +3,35 @@ package MasterServer::Database::SQLite::dbGetServers; use strict; use warnings; use Exporter 'import'; - our @EXPORT = qw| get_server get_pending |; ################################################################################ ## get server details for one or multiple servers -## opts: limit, see $order +## opts: limit, see %where or $order ################################################################################ sub get_server { my $s = shift; - my %o = ( - sort => '', - @_ - ); + my %o = (sort => '', blacklisted => 0, @_); 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{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{added} ? ( 'added < datetime(?, \'unixepoch\')' => (time-$o{added})) : (), $o{beacon} ? ( 'beacon > datetime(?, \'unixepoch\')' => (time-$o{beacon})) : (), $o{updated} ? ('updated > datetime(?, \'unixepoch\')' => (time-$o{updated})) : (), $o{before} ? ('updated < datetime(?, \'unixepoch\')' => (time-$o{before})) : (), + + # never process blacklisted servers, unless explicitly specified + ('blacklisted = CAST(? AS BOOLEAN)' => $o{blacklisted}), ); my @select = ( qw| @@ -79,45 +77,29 @@ sub get_server { ################################################################################ ## get server details for one or multiple pending servers -## opts: limit, next_id, beaconport, heartbeat, gamename, secure, enctype, added +## opts: limit, next_id, ip, heartbeat port ################################################################################ sub get_pending { my $s = shift; - my %o = ( - sort => '', - @_ - ); + 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 < datetime(?, \'unixepoch\')' => (time-$o{added})) : (), - $o{after} ? ('added > datetime(?, \'unixepoch\')' => (time-$o{after})) : (), ); - my @select = ( qw| id ip beaconport heartbeat gamename secure enctype added |,); + my @select = ( qw| id ip heartbeat 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 ?" : ""), + return $s->db_all( q| SELECT !s FROM pending !W ORDER BY !s| + .($o{limit} ? " LIMIT ?" : ""), join(', ', @select), \%where, $order, ($o{limit} ? $o{limit} : ()), ); } diff --git a/lib/MasterServer/Database/SQLite/dbMaintenance.pm b/lib/MasterServer/Database/SQLite/dbMaintenance.pm index 019f31f..ec9b5cc 100755 --- a/lib/MasterServer/Database/SQLite/dbMaintenance.pm +++ b/lib/MasterServer/Database/SQLite/dbMaintenance.pm @@ -1,9 +1,8 @@ -package MasterServer::Database::SQLite::dbMaintenance; +package MasterServer::Database::Pg::dbMaintenance; use strict; use warnings; use Exporter 'import'; - our @EXPORT = qw| delete_old_pending remove_pending |; @@ -12,14 +11,10 @@ our @EXPORT = qw| delete_old_pending ## where the server is unresponsive for more than 1 hour ################################################################################ sub delete_old_pending { - my ($self) = shift; - - # remove servers + my $self = shift; my $u = $self->{dbh}->do( "DELETE FROM pending - WHERE added < datetime(?, 'unixepoch')", undef, time-3600); - - # notify + WHERE added < datetime(?, \'unixepoch\')", undef, time-3600); $self->log("delete", "Removed $u entries from pending.") if ($u > 0); } @@ -28,13 +23,11 @@ sub delete_old_pending { ## 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); + my $self = shift; + my %o = ( @_); + my $u = $self->{dbh}->do("DELETE FROM pending WHERE ip = ? AND heartbeat = ?", + undef, $o{ip}, $o{port}); + $self->log("delete", "removed $o{ip}, $o{port} from pending (".$u."x)") if ($u > 0); } 1; diff --git a/lib/MasterServer/Database/SQLite/dbStats.pm b/lib/MasterServer/Database/SQLite/dbStats.pm index 1cf94e6..57d3100 100755 --- a/lib/MasterServer/Database/SQLite/dbStats.pm +++ b/lib/MasterServer/Database/SQLite/dbStats.pm @@ -3,41 +3,47 @@ package MasterServer::Database::SQLite::dbStats; use strict; use warnings; use Exporter 'import'; - -our @EXPORT = qw| get_gamelist_stats - write_direct_beacons +our @EXPORT = qw| get_gamenames + get_gamestats + get_listedstats write_stat + write_direct_beacons write_kfstats |; ################################################################################ -# calculate stats for all individual games +## get a list of distinct gamenames currently in the server list ################################################################################ -sub get_gamelist_stats { +sub get_gamenames { my $self = shift; - return $self->{dbh}->selectall_arrayref( - "SELECT DISTINCT gamename AS gamename, - COUNT(NULLIF(b333ms AND updated > datetime(?, 'unixepoch'), 0)) AS numdirect, - COUNT(NULLIF(updated > datetime(?, 'unixepoch'), 0)) AS numtotal - FROM serverlist - GROUP BY gamename", undef, time-7200, time-7200); + "SELECT distinct gamename + FROM serverlist"); } ################################################################################ -# 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. +## get statistics (num_direct, num_total) per gamename ################################################################################ -sub write_direct_beacons { +sub get_gamestats { + my ($self, $gn) = @_; + return $self->db_all( + "SELECT COUNT(CASE WHEN b333ms THEN 1 END) as num_uplink, count(*) as num_total + FROM serverlist + WHERE gamename = ? AND updated > datetime(?, \'unixepoch\')", + lc $gn, time-7200); +} + +################################################################################ +## 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_listedstats { my $self = shift; - my $u = $self->{dbh}->do( - "UPDATE serverlist - SET b333ms = 0 - WHERE beacon < datetime(?, 'unixepoch') AND b333ms", - undef, time-3600); - - # notify - $self->log("unset", "Lost $u direct beacons.") if ($u > 0); + return $self->{dbh}->selectall_arrayref( + "SELECT gamename + FROM games + WHERE num_uplink > 0 + OR num_total > 0"); } ################################################################################ @@ -45,19 +51,28 @@ sub write_direct_beacons { # 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( + my ($self, %o) = @_; + return $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); + undef, $o{num_uplink}, $o{num_total}, lc $o{gamename}); +} +################################################################################ +# 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 < datetime(?, \'unixepoch\') AND b333ms", + undef, time-3600); + $self->log("unset", "Lost $u direct beacons.") if ($u > 0); } ################################################################################ @@ -66,7 +81,7 @@ sub write_stat { sub write_kfstats { my ($self, $h) = @_; - # check if entry already excists. + # check if entry already exists. my $u = $self->{dbh}->selectall_arrayref( "SELECT * FROM kfstats WHERE UTkey = ? ", undef, $h->{UTkey}); @@ -74,13 +89,11 @@ sub write_kfstats { $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 + $self->{dbh}->do("UPDATE kfstats SET Username = ?, CurrentVeterancy = ?, TotalKills = ?, diff --git a/lib/MasterServer/Database/SQLite/dbUTServerInfo.pm b/lib/MasterServer/Database/SQLite/dbUTServerInfo.pm index 119900b..5a579ac 100755 --- a/lib/MasterServer/Database/SQLite/dbUTServerInfo.pm +++ b/lib/MasterServer/Database/SQLite/dbUTServerInfo.pm @@ -5,127 +5,12 @@ use warnings; use MasterServer::Core::Util 'sqlprint'; use Exporter 'import'; -our @EXPORT = qw| get_utserver - add_utserver +our @EXPORT = qw| 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 > datetime(?, \'unixepoch\')'=> (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. ################################################################################ diff --git a/lib/MasterServer/TCP/BrowserHost.pm b/lib/MasterServer/TCP/BrowserHost.pm index c53ae42..316a135 100755 --- a/lib/MasterServer/TCP/BrowserHost.pm +++ b/lib/MasterServer/TCP/BrowserHost.pm @@ -5,59 +5,89 @@ use warnings; use AnyEvent::Socket; use AnyEvent::Handle; use Exporter 'import'; +our @EXPORT = qw| browser_host |; -our @EXPORT = qw| browser_host clean_tcp_handle|; +# keep handle alive and store authentication info +my %conn = (); ################################################################################ ## wait for incoming TCP connections from game clients and other masterservers. -## respond with secure/validate, contact info and/or server lists. +## respond with secure/validate and/or server lists. ## allow other masterservers to synchronize ################################################################################ sub browser_host { my $self = shift; my $browser = tcp_server undef, $self->{listen_port}, sub { - my ($fh, $a, $p) = @_; - - # validated? yes = 1 no = 0 + my ($fh, $addr, $port) = @_; my $auth = 0; - # debug -- new connection opened - #$self->log("tcp","New connection from $a:$p"); - - # prep a challenge + # prepare a secure/validate challenge my $secure = $self->secure_string(); - - # handle received data - my $h; $h = AnyEvent::Handle->new( + + # handle for client connection + my $client; $client = AnyEvent::Handle->new( fh => $fh, poll => 'r', timeout => $self->{timeout_time}, - on_eof => sub {$self->log("tcp","eof on $a:$p" ); $self->clean_tcp_handle(@_)}, - on_error => sub {$self->error($!, "browser $a:$p"); $self->clean_tcp_handle(@_)}, - on_read => sub {$self->read_tcp_handle($h, $a, $p, $secure, @_)}, + on_eof => sub {drop_handle($client);}, + on_error => sub {drop_handle($client);$self->error($!, "client $addr:$port");}, + on_read => sub { + # receive data + my $rx = $self->data2hashref($client->rbuf);$client->rbuf = ""; + + # Support echo: log, but don't respond (or recursive echo abuse) + $self->log("echo","msg $addr:$port: $rx->{echo}") if $rx->{echo}; + + # first check for validation info + if ($rx->{validate} && $rx->{gamename}) { + $auth = $self->auth_browser( + gamename => $rx->{gamename}, + secure => $secure, + enctype => $rx->{enctype}, + validate => $rx->{validate}, + ); + $conn{$client}[1] = $auth; + $self->log("secure", "client $addr:$port failed validation $rx->{gamename}") unless $auth;} + + # list request with valid gamename / challenge + if ($auth && $rx->{gamename} && exists $rx->{list}) { + $client->push_write($self->generate_list($rx->{gamename}, $rx->{list})."\\final\\"); + $self->log("list","$addr:$port retrieved the list for $rx->{gamename}"); + drop_handle($client)} + + # sync request with valid gamename / challenge + if ($auth && $rx->{sync}) { + $client->push_write($self->generate_sync($rx->{sync})."\\final\\"); + $self->log("syncer","$addr:$port synchronized $rx->{sync}"); + drop_handle($client)} + + # request without valid gamename and/or authentication + if (!$auth && ($rx->{sync} || exists $rx->{list}) ) { + $client->push_write("\\echo\\You failed to authenticate. See 333networks.com for more info.\\final\\"); + $self->log("warning","$addr:$port failed to authenticate before requesting a list/sync"); + drop_handle($client);} + }, ); # part 1: send \basic\\secure\$key\ - $h->push_write("\\basic\\\\secure\\$secure\\final\\"); + $client->push_write("\\basic\\\\secure\\$secure\\final\\"); - # keep handle alive longer and store authentication info - $self->{browser_clients}->{$h} = [$h, $auth]; - return; + # keep handle alive and store authentication info + $conn{$client} = [$client, $auth]; }; # startup of TCP server complete - $self->log("info", "Listening for TCP connections on port $self->{listen_port}."); + $self->log("info", "listening for TCP connections on port $self->{listen_port}"); return $browser; } ################################################################################ ## clean handles on timeouts, completed requests and/or errors ################################################################################ -sub clean_tcp_handle{ - my ($self, $c) = @_; - # clean and close the connection - delete ($self->{browser_clients}->{$c}); +sub drop_handle { + my $c = shift; + delete $conn{$c}; $c->destroy(); } diff --git a/lib/MasterServer/TCP/Handler.pm b/lib/MasterServer/TCP/Handler.pm deleted file mode 100755 index eb0094d..0000000 --- a/lib/MasterServer/TCP/Handler.pm +++ /dev/null @@ -1,211 +0,0 @@ -package MasterServer::TCP::Handler; - -use strict; -use warnings; -use AnyEvent::Socket; -use AnyEvent::Handle; -use Exporter 'import'; - -our @EXPORT = qw| read_tcp_handle - handle_validate - handle_list - handle_sync |; - -################################################################################ -## wait for incoming TCP connections from game clients and other masterservers. -## respond with secure/validate, contact info and/or server lists. -## allow other masterservers to synchronize -################################################################################ -sub read_tcp_handle { - my ($self, $h, $a, $p, $secure, $c) = @_; - - # clear the buffer - my $m = $c->rbuf; - $c->rbuf = ""; - - # did the client validate already? - my $val = $self->{browser_clients}->{$h}[1]; - - # in case of errors, log the original message - my $rxbuf = $m; - #$self->log("debug","$a:$p sent $rxbuf"); - - # allow multiple blocks to add to the response string - my $response = ""; - - # 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/\\$/\\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); - - # return address list - # 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 ("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\"."); - } # end if weird query - else { - $c->push_write($response . "\\final\\") if ($response ne ""); - } -} - -################################################################################ -## The master server opens the connection with the \secure\ challenge. The -## client should respond with basic information about itself and the -## \validate\ response. In this code block we verify the challenge/response. -################################################################################ -sub handle_validate { - my ($self, $r, $h, $secure, $a, $p) = @_; - - # auth var init - my $val = 0; - - # pass or fail the secure challenge - if (exists $r->{gamename} && $self->get_game_props(gamename => $r->{gamename})) { - - # game exists and we have the key to verify the response - $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."); - } - - # log (debug) - #$self->log("secure","$a:$p validated with $val for $r->{gamename}, $secure, $r->{validate}"); - - # return auth status - return $val; -} - -################################################################################ -## At this point, the client should be validated and ready to request with -## the \secure\ command and is allowed to ask for the list. -################################################################################ -sub handle_list { - my ($self, $val, $r, $c, $a, $p) = @_; - - # confirm validation - if ($val && exists $r->{gamename}) { - - # prepare the list - my $data = ""; - - # determine the return format - if ($r->{list} =~ /^cmp$/i) { - # return addresses as byte format (ip=ABCD port=EF) - $data .= $self->compile_list_cmp($r->{gamename}); - } - else { - # return addresses as regular \ip\127.0.0.1:7777\ format - $data .= $self->compile_list($r->{gamename}); - } - - # finalize response string - $data .= "\\final\\"; - - # immediately send to client - $c->push_write($data); - - # log successful - $self->log("list","$a:$p successfully retrieved the list for $r->{gamename}."); - - # clean and close the connection - #$self->log("tcp","closing $a:$p"); - $self->clean_tcp_handle($c); - } - - # proper syntax/protocol, but incorrect validation. Therefore respond with - # an 'empty' list, returning only \final\. - else { - # return error/empty list - $c->push_write("\\echo\\333networks failed to validate your request. Use the correct authorization cipher!\\final\\"); - - # log it too - $self->log("error","browser $a:$p failed validation for $r->{gamename}"); - - # clean and close the connection - #$self->log("tcp","closing $a:$p"); - $self->clean_tcp_handle($c); - } -} - -################################################################################ -## Respond to \sync\ requests from other 333networks-based masterservers. After -## validation, sync behaves in much the same way as \list\, -################################################################################ -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."); - - if ($val && exists $r->{sync}) { - - # compile list of addresses - my $data = $self->compile_sync($r->{sync}); - $data .= "\\final\\"; - - # send to remote client - $c->push_write($data); - - # log successful (debug) - $self->log("sync-tx","$a:$p successfully synced."); - - # clean and close the connection - #$self->log("tcp","closing $a:$p"); - $self->clean_tcp_handle($c); - - } - # proper syntax/protocol, but incorrect validation. Therefore respond with - # an 'empty' list, returning only \final\. - else { - - # return error/empty list - $c->push_write("\\echo\\333networks failed to validate your request. Use a proper authorization key!\\final\\"); - - # log it too - $self->log("error","$a:$p failed synchronization."); - - # clean and close the connection - #$self->log("tcp","closing $a:$p"); - $self->clean_tcp_handle($c); - } -} - -1; diff --git a/lib/MasterServer/TCP/ListCompiler.pm b/lib/MasterServer/TCP/ListCompiler.pm index c035008..edced5e 100755 --- a/lib/MasterServer/TCP/ListCompiler.pm +++ b/lib/MasterServer/TCP/ListCompiler.pm @@ -3,120 +3,75 @@ package MasterServer::TCP::ListCompiler; use strict; use warnings; use Exporter 'import'; - -our @EXPORT = qw| compile_list compile_list_cmp compile_sync |; +our @EXPORT = qw| generate_list generate_sync compile_sync |; ################################################################################ ## compile the list of \ip\ip:port\ addresses and parse them into the -## plaintext return string. +## plaintext or compressed address string. ################################################################################ -sub compile_list { - my ($self, $gamename) = @_; +sub generate_list { + # gamename and \list\(|cmp) + my ($self, $gamename, $cmp) = @_; # get the list from database my $serverlist = $self->get_server( - updated => 3600, - gamename => $gamename, - ); - - # prepare empty return string - my $response_string = ""; - - # add address as regular \ip\127.0.0.1:7777\ format - for (@{$serverlist}){ - - # append \ip\ip:port to string - $response_string .= "\\ip\\$_->{ip}:$_->{port}"; - } + updated => 3600, + gamename => $gamename, + ); - # return the string with data - return $response_string; -} - -################################################################################ -## compile the list of binary ip:port addresses and parse them into the -## ABCDE return string. -################################################################################ -sub compile_list_cmp { - my ($self, $gamename) = @_; - - # get the list from database - my $serverlist = $self->get_server( - updated => 3600, - gamename => $gamename, - ); - - # prepare empty return string - my $response_string = ""; - - # compile a return string - for (@{$serverlist}){ - - # convert ip address to ABCDEF mode - 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); - - # append to list of addresses - $response_string .= $bin; + my $list = ""; + # which format? + if ($cmp eq "cmp") { + # compressed format (ABCDEF format) + for (@{$serverlist}) { + 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); + my $bin = ""; $bin .= (chr $A) . (chr $B) . (chr $C) . (chr $D) . (chr $E) . (chr $F); + $list .= $bin;} } - - # return the string with data - return $response_string; + else { + # normal format (regular \ip\127.0.0.1:7777\ format) + for (@{$serverlist}) { + $list .= "\\ip\\$_->{ip}:$_->{port}";} + } + + # list ready + return $list; } - ################################################################################ -## compile a list of all requested games --or-- if not specified, a list of -## all games +## compile a list of addresses for all available or requested games. +## opts: all | list of games ################################################################################ -sub compile_sync { +sub generate_sync { my ($self, $sync) = @_; - - # prepare empty return string - my $response_string = ""; - my @games; - - # client requests to sync all games + my $list = ""; + my %games = (); + + # prepare list of games + my $avail = $self->get_gamenames(); if ($sync eq "all") { - # get array of gamenames from db - my $sg = $self->get_gamenames(); - for (@{$sg}) {push @games, $_->[0];} - } - # only selected games + # if "all" is requested, check which games we have available + $games{$_->[0]} = 1 for (@{$avail}); } else { - # split request into array - @games = split " ", $sync; - } + # otherwise, see which of the requested addresses match our db + for (@{$avail}) {$games{$_->[0]} = 1 if ($sync =~ m/$_->[0]/i); } } - # only get unique values from array - my %games = map { $_ => 1 } @games; - # get the list for every requested gamename - for my $g (keys %games) { - - # $g is now a gamename -- check if it's supported. Else ignore. - if ($self->get_game_props(gamename => $g)) { + for my $gamename (keys %games) { # get list from database - my $list = $self->get_server( - updated => 7200, - gamename => $g, - ); + my $listref = $self->get_server(gamename => $gamename, updated => 3600); # add all games to string separated by spaces - my $gamestring = ""; - foreach $_ (@{$list}) {$gamestring .= "$_->{ip}:$_->{port} ";} + my $addresses = ""; + foreach (@{$listref}) {$addresses .= "$_->{ip}:$_->{port} ";} # if it contains at least one entry, add the list to the response list - $response_string .= "\\$g\\$gamestring" if (length $gamestring >= 7); - } + $list .= "\\$gamename\\$addresses" if (length $addresses >= 7); } - - # return \gamename\addresses\gamename2\addresses2 list - return $response_string; + # list ready + return $list; } 1; diff --git a/lib/MasterServer/TCP/Syncer.pm b/lib/MasterServer/TCP/Syncer.pm index d890f00..cf7ee5b 100755 --- a/lib/MasterServer/TCP/Syncer.pm +++ b/lib/MasterServer/TCP/Syncer.pm @@ -5,152 +5,156 @@ use warnings; use AnyEvent; use AnyEvent::Handle; use Exporter 'import'; - -our @EXPORT = qw| sync_with_master - process_sync_list |; +our @EXPORT = qw| synchronize + process_applet + process_syncer |; ################################################################################ -## Sends synchronization request to another 333networks based master server and -## receives the list of games. +## Synchronize with UCC Applets (Epic Megagames, Inc.) or other 333networks +## based masterservers. ################################################################################ -sub sync_with_master { - my ($self, $ms) = @_; - - # announce - $self->log("tcp", "Attempting to synchronize with $ms->{ip}"); +sub synchronize { + my ($self, $ms, $type) = @_; + my $ipbuflist = ""; - # list to store all IPs in. - my $sync_list = ""; - # connection handle - my $handle; - $handle = new AnyEvent::Handle( + my $handle; $handle = new AnyEvent::Handle( connect => [$ms->{ip} => $ms->{hostport}], timeout => $self->{timeout_time}, poll => 'r', - on_error => sub {$self->error($!, "$ms->{ip}:$ms->{hostport}"); $handle->destroy;}, - on_eof => sub {$self->process_sync_list($sync_list, $ms); $handle->destroy;}, + on_error => sub {$handle->destroy; $self->error($!, "$ms->{ip}:$ms->{hostport}");}, + on_eof => sub { + $handle->destroy; + if ($type eq "applet") {$self->process_applet($ipbuflist, $ms);} + if ($type eq "333nwm") {$self->process_syncer($ipbuflist, $ms);} + }, on_read => sub { - # receive and clear buffer my $m = $_[0]->rbuf; $_[0]->rbuf = ""; - # remove string terminator: sometimes trailing slashes, line endings or - # string terminators are added or forgotten by sender, so \secure\abcdef - # is actually \secure\abcdef{\0} - chop $m if $m =~ m/secure/; - # part 1: receive \basic\\secure\$key - if ($m =~ m/basic\\\\secure/) { + if ($m =~ m/\\basic\\\\secure\\/) { - # hash $m into %r - my %r = (); - $m =~ s/\\\\/\\undef\\/; - $m =~ s/\n//; - $m =~ s/\\([^\\]+)\\([^\\]+)/$r{$1}=$2/eg; + # use provided gamename for applet or 333networks for syncer + my $gamename = ""; + $gamename = $ms->{gamename} if ($type eq "applet"); + $gamename = "333networks" if ($type eq "333nwm"); - # respond to the validate challenge + # processess received data and respond to challenge + my $rx = $self->data2hashref($m); my $validate = $self->validate_string( - gamename => "333networks", - secure => $r{secure}, - enctype => $r{enctype} - ); + gamename => $gamename, + enctype => $rx->{enctype}, + secure => $rx->{secure} + ); + + # send challenge response + $handle->push_write("\\gamename\\$gamename\\location\\0\\validate\\$validate\\final\\"); + + # part 3a: also request the list \list\\gamename\ut + my $request = ""; + if ($type eq "applet") { + $request = "\\list\\\\gamename\\$ms->{gamename}\\final\\";} + # part 3b: request the list \sync\[gamenames] consisting of space-seperated game names or "all" + if ($type eq "333nwm") { + $request = "\\sync\\".($self->{sync_games}[0] == 0 ? "all" : $self->{sync_games}[1] )."\\final\\";} - # 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" - # compatibility note: old queries use "new", instead treat them as "all". - my $request = "\\sync\\" - . (($self->{sync_games}[0] == 0) ? ("all") : $self->{sync_games}[1]) - . "\\final\\"; - # push the request to remote host $handle->push_write($request); - - # clean up $m for future receivings - $m = ""; - - } # end secure + } - # part 4: receive the entire list in multiple steps - $sync_list .= $m; - }, + # part 4: receive the entire list in multiple steps. + # continue receiving data and adding to the buffer + else {$ipbuflist .= $m;} + } ); } ################################################################################ -## Process the list of addresses that was received after querying the UCC applet -## and store them in the pending list. +## Process the list of addresses received from the UCC applet masterserver and +## move new addresses to the pending list. ################################################################################ -sub process_sync_list { - my ($self, $m, $ms) = @_; - - # replace empty values for the string "undef" and replace line endings from netcatters - # parse hash {gamename => list of ips seperated by space} - my %r = (); - $m =~ s/\\\\/\\undef\\/; - $m =~ s/\n//; - $m =~ s/\\([^\\]+)\\([^\\]+)/$r{$1}=$2/eg; +sub process_applet { + my ($self, $buf, $ms) = @_; + my $new = 0; my $tot = 0; + + # database types such as SQLite are slow, therefore use transactions. + $self->{dbh}->begin_work; + + # parse $buf into an array of [ip, port] + foreach my $l (split /\\/, $buf) { + + # search for \ip\255.255.255.255:7778\ and capture ip and port + if (my ($address,$port) = $l =~ /([\.\w]+):(\d+)/ ) { + # check if address entry is valid + if ($self->valid_address($address,$port)) { + + # add server and count new/total addresses + $new += $self->insert_pending(ip => $address, port => $port); + $tot++; + } + # invalid address, log + else {$self->log("error", "invalid address found at $ms->{ip}:$ms->{hostport} > $l (applet)");} + } + } # end foreach - # counter - my $c = 0; + # complete transaction + $self->{dbh}->commit; + + # update time if successful applet query + $self->update_master_applet(ip => $ms->{ip}, port => $ms->{hostport}, gamename => $ms->{gamename} ) + if ($tot > 0); + + # print findings + $self->log("syncer","found $tot ($new new) addresses at $ms->{ip},$ms->{hostport} for $ms->{gamename} (applet)"); +} + +################################################################################ +## Process the list of addresses received from the 333networks masterserver and +## move new addresses to the pending list. +################################################################################ +sub process_syncer { + my ($self, $buf, $ms) = @_; + my $new = 0; my $tot = 0; + + # extract to hash: gamename => ( address list ) + my $rx = $self->data2hashref($buf); - if (exists $r{echo}) { - # remote address says... - $self->log("echo", "$ms->{ip} replied: $r{echo}"); - } + # use transactions for large numbers of ip/ports + $self->{dbh}->begin_work; # iterate through the gamenames and addresses - while ( my ($gn,$addr) = each %r) { - - # process all games wether we have a cipher for them. - if (defined $gn) { - - # some database types, such as SQLite, are slow - therefore use transactions. - $self->{dbh}->begin_work; - - # l(ocations, \label\ip:port\) split up in a(ddress) and p(ort) - foreach my $l (split(/ /, $addr)) { - - # search for \255.255.255.255:7778\, contains ':' - if ($l =~ /:/) { - my ($a,$p) = $l =~ /(.*):(.*)/; - - # check if address entry is valid - if ($self->valid_address($a,$p)) { - # count number of valid addresses - $c++; - - # add server - $self->syncer_add($a, $p, $gn, $self->secure_string()); - - # print address (debug) - # $self->log("add", "syncer added $gn\t$a\t$p"); - } - else { - # invalid address, log - $self->log("error", "invalid address found while syncing at $ms->{ip}: $l!"); - } - - } # endif ($l =~ /:/) - } # end for / / - - # end transaction, commit - $self->{dbh}->commit; + while ( my ($gamename,$addresslist) = each %{$rx}) { + + # parse $buf into an array of [ip, port] + foreach my $l (split / /, $addresslist) { + + # search for \ip\255.255.255.255:7778\ and capture ip and port + if (my ($address,$port) = $l =~ /([\.\w]+):(\d+)/ ) { - } # end defined $gn + # check if address entry is valid + if ($self->valid_address($address,$port)) { + # add server and count new/total addresses + $new += $self->insert_pending(ip => $address, port => $port); + $tot++; + + } + # invalid address, log + else {$self->log("error", "invalid address found at $ms->{ip}:$ms->{hostport} > $l (333nwm)");} + } + } # end foreach } # end while - # update this sync master in the gamelist with lastseen time - $self->update_server_list( - ip => $ms->{ip}, - port => $ms->{port}, - ) if ($c > 0); + # complete transaction + $self->{dbh}->commit; + + # update time if successful sync master query + $self->update_server(ip => $ms->{ip}, hostport => $ms->{hostport}) + if ($tot > 0); # end message - $self->log("sync-rx", "received $c addresses after syncing from $ms->{ip}:$ms->{hostport}"); + $self->log("syncer", "found $tot ($new new) addresses at $ms->{ip},$ms->{hostport} (333nwm)"); } 1; diff --git a/lib/MasterServer/TCP/UCCAppletQuery.pm b/lib/MasterServer/TCP/UCCAppletQuery.pm deleted file mode 100755 index 2c32de9..0000000 --- a/lib/MasterServer/TCP/UCCAppletQuery.pm +++ /dev/null @@ -1,72 +0,0 @@ -package MasterServer::TCP::UCCAppletQuery; - -use strict; -use warnings; -use AnyEvent; -use AnyEvent::Handle; -use Exporter 'import'; - -our @EXPORT = qw| query_applet |; - -################################################################################ -## The UCC Applet (Epic Megagames, Inc.) functions as a master server for one -## single game. However, it does not always follow the defined protocol. -## This module connects with UCC masterserver applets to receive the list. -################################################################################ -sub query_applet { - my ($self, $ms) = @_; - - # be nice to notify - $self->log("tcp","start querying $ms->{ip}:$ms->{port} for '$ms->{gamename}' games"); - - # list to store all IPs in. - my $master_list = ""; - - # connection handle - my $handle; - $handle = new AnyEvent::Handle( - connect => [$ms->{ip} => $ms->{port}], - timeout => $self->{timeout_time}, - poll => 'r', - on_error => sub {$self->error($!, "$ms->{ip}:$ms->{port}"); $handle->destroy;}, - on_eof => sub {$self->process_ucc_applet_query($master_list, $ms); $handle->destroy;}, - on_read => sub { - - # receive and clear buffer - my $m = $_[0]->rbuf; - $_[0]->rbuf = ""; - - # remove string terminator - chop $m if $m =~ m/secure/; - - # part 1: receive \basic\\secure\$key - if ($m =~ m/\\basic\\\\secure\\/) { - - # received data - my %r; - $m =~ s/\\([^\\]+)\\([^\\]+)/$r{$1}=$2/eg; - - # respond to challenge - my $validate = $self->validate_string(gamename => $ms->{gamename}, - enctype => $r{enctype}||0, - secure => $r{secure}); - - # send response - $handle->push_write("\\gamename\\$ms->{gamename}\\location\\0\\validate\\$validate\\final\\"); - - # part 3: also request the list \list\gamename\ut -- skipped in UCC applets - $handle->push_write("\\list\\\\gamename\\$ms->{gamename}\\final\\"); - - } - - # part 3b: receive the entire list in multiple steps. - # $m contains \ip\ or part of that string - else { - # add buffer to the list - $master_list .= $m; - } - } - ); -} - -1; diff --git a/lib/MasterServer/UDP/BeaconCatcher.pm b/lib/MasterServer/UDP/BeaconCatcher.pm index 7c98f57..6058bfa 100755 --- a/lib/MasterServer/UDP/BeaconCatcher.pm +++ b/lib/MasterServer/UDP/BeaconCatcher.pm @@ -5,8 +5,7 @@ use warnings; use AnyEvent::Handle::UDP; use Socket qw(sockaddr_in inet_ntoa); use Exporter 'import'; - -our @EXPORT = qw| beacon_catcher on_beacon_receive|; +our @EXPORT = qw| beacon_catcher recv_beacon |; ################################################################################ ## Receive UDP beacons with \heartbeat\7778\gamename\ut\ format @@ -14,64 +13,86 @@ our @EXPORT = qw| beacon_catcher on_beacon_receive|; ################################################################################ sub beacon_catcher { my $self = shift; - - # 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; - $udp_server = AnyEvent::Handle::UDP->new( - - # Bind to this host and use the port specified in the config file + my $udp_server; $udp_server = AnyEvent::Handle::UDP->new( bind => ['0.0.0.0', $self->{beacon_port}], - - # when datagrams are received - on_recv => sub {$self->on_beacon_receive(@_)}, + on_recv => sub {$self->recv_beacon(@_)}, ); - - # allow object to exist beyond this scope. Objects have ambitions too. + $self->log("info", "listening for UDP beacons on port $self->{beacon_port}"); return $udp_server; } ################################################################################ -## Determine the content of the received information and process it. +# Receive Beacon (Spellchecker suggestion: "Bacon") +# Check for heartbeats, determine if the server is already in the database +# or trigger challenge with secure/validate if necessary. ################################################################################ -sub on_beacon_receive { - # $self, beacon address, handle, packed client address - my ($self, $b, $udp, $pa) = @_; +sub recv_beacon { + # $self, received data, handle, packed client address + my ($self, $buffer, $handle, $paddress) = @_; # unpack ip from packed client address - my ($port, $iaddr) = sockaddr_in($pa); - my $peer_addr = inet_ntoa($iaddr); + my ($port, $iaddr) = sockaddr_in($paddress); + my $beacon_address = inet_ntoa($iaddr); + + # determine and process heartbeat + if ($buffer =~ m/\\heartbeat\\/) { - # assume fraud/crash attempt if response too long - if (length $b > 64) { - # log - $self->log("attack","length exceeded in beacon: $peer_addr:$port sent $b"); + # process data and get gamename info from the database + my $rx = $self->data2hashref($buffer); - # truncate and try to continue - $b = substr $b, 0, 64; - } - - # FIXME: note to self: order is important when having combined queries! - # TODO: find a more elegant and long-time solution for this. + # some games use heartbeat = 0 because of default ports. Check. + if ($rx->{heartbeat} == 0 && $rx->{gamename}) { + + # overwrite the heartbeat port with a known default port, or zero + $rx->{heartbeat} = $self->get_game_props(gamename => $rx->{gamename})->[0]->{default_qport} || 0; + + # if no default port is listed, log and return. !! can spam the logs !! + if ($rx->{heartbeat} == 0) { + $self->log("invalid", "$beacon_address has no default heartbeat port listed"); + return; + } + } - # if this is a secure response, verify the response - $self->process_udp_validate($b, $peer_addr, $port, undef) - if ($b =~ m/\\validate\\/); + # update the timestamp in the database if the server already exists + my $upd = $self->update_server( + ip => $beacon_address, + port => $rx->{heartbeat}, + direct => 1, + ); + + # did the update succeed? + if ($upd > 0) { + # then we're done here. log and return. + $self->log("beacon", "heartbeat from $beacon_address, $rx->{heartbeat}". + ($rx->{gamename} ? (" for $rx->{gamename}") : "") ); + } + # if no update occurred, query server + else { + # assign BeaconChecker to query the server for secure challenge and status + $self->query_udp_server( + ip => $beacon_address, + port => $rx->{heartbeat}, + need_validate => 1, + direct_uplink => 1, + ); + } + return; + } - # if a heartbeat format was detected... - $self->process_udp_beacon($udp, $pa, $b, $peer_addr, $port) - if ($b =~ m/\\heartbeat\\/ && $b =~ m/\\gamename\\/); + # other masterservers check if we're still alive, respond with complient data + if ($buffer =~ m/\\(secure|basic|rules|info|players|status)\\/i) { + $self->handle_status_query($handle, $paddress, $buffer); + $self->log("uplink", "responding to $beacon_address, $port (sent $buffer)"); + return; + } - # if other masterservers check if we're still alive - $self->handle_status_query($udp, $pa, $b, $peer_addr) - if ($b =~ m/\\secure\\/ || - $b =~ m/\\basic\\/ || - $b =~ m/\\info\\/ || - $b =~ m/\\rules\\/ || - $b =~ m/\\players\\/|| - $b =~ m/\\status\\/); + # Util::UDPBrowser (optional) + if ($buffer =~ m/^\\echo\\request/i) { + $self->udpbrowser_host($handle, $paddress, $buffer); + return; + } + } 1; diff --git a/lib/MasterServer/UDP/BeaconChecker.pm b/lib/MasterServer/UDP/BeaconChecker.pm index 73220cf..9c95455 100755 --- a/lib/MasterServer/UDP/BeaconChecker.pm +++ b/lib/MasterServer/UDP/BeaconChecker.pm @@ -4,80 +4,52 @@ use strict; use warnings; use AnyEvent::Handle::UDP; use Exporter 'import'; - our @EXPORT = qw| query_udp_server |; ################################################################################ ## Get the server status from any server over UDP and store the received ## information in the database. $secure determines the type of query: ## secure/pending or information. +## options: ip, port, need_validate, direct_uplink ################################################################################ sub query_udp_server { - my ($self, $id, $ip, $port, $secure, $message_type) = @_; - my $buf = ""; - - # debug logging - # $self->log("debug", "Query server $id ($ip:$port)"); + my ($self, %o) = @_; + my $buffer = ""; + + # if a secure/validate challenge is still required, generate secure string + my $secure = $self->secure_string if $o{need_validate}; # connect with UDP server my $udp_client; $udp_client = AnyEvent::Handle::UDP->new( - connect => [$ip, $port], - timeout => $self->{timeout_time}, - on_timeout => sub {$udp_client->destroy();}, # do not report timeouts - on_error => sub {$udp_client->destroy();}, # or errors + connect => [$o{ip}, $o{port}], + timeout => $self->{timeout_time}, + on_timeout => sub {$udp_client->destroy;}, + on_error => sub {$udp_client->destroy;}, on_recv => sub { - - # add packet to buffer - $buf .= $_[0]; - - # FIXME: note to self: order is important when having combined queries! - # TODO: find a more elegant and long-time solution for this. + # add received data to buffer + $buffer .= $_[0]; - # 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); + # buffer completed receiving all relevant information? + if ($buffer =~ m/\\final\\/) { + + # try to process datagram + $self->process_datagram( + ip => $o{ip}, + port => $o{port}, + rxbuf => $buffer, + secure => $secure, + direct => $o{direct_uplink}, + ); } - # 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 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 { } }, ); - # - # Send secure message or status, depending on provided variables - # Message types can be - # 0: \basic\\info\ - # 1: \basic\\secure\wookie - # 2: \status\ - # - - # 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); + # determine the requests and send message + $udp_client->push_send("\\secure\\$secure") if $o{need_validate}; + $udp_client->push_send("\\status\\"); } 1; diff --git a/lib/MasterServer/UDP/DatagramProcessor.pm b/lib/MasterServer/UDP/DatagramProcessor.pm index 006871d..5587875 100755 --- a/lib/MasterServer/UDP/DatagramProcessor.pm +++ b/lib/MasterServer/UDP/DatagramProcessor.pm @@ -2,393 +2,166 @@ package MasterServer::UDP::DatagramProcessor; use strict; use warnings; -use Encode; -use AnyEvent::Handle::UDP; use Exporter 'import'; +our @EXPORT = qw| process_datagram |; -our @EXPORT = qw| process_udp_beacon - process_udp_validate - process_query_response - process_status_response - process_ucc_applet_query |; - -################################################################################ -## Process datagrams from beacons that have \heartbeat\ and \gamename\ keys -## in the stringbuffer. If necessary, authenticate first with the secure/val -## challenge. -################################################################################ -sub process_udp_beacon { - # $self, handle, packed address, udp data, peer ip address, $port - my ($self, $udp, $pa, $buf, $peer_addr, $port) = @_; - - # 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}) { - # log the beacon - $self->log("beacon", "$peer_addr:$r{heartbeat} for $r{gamename}"); - - # check if game is actually supported in our db - my $game_props = $self->get_game_props(gamename => $r{gamename})->[0]; - - # if no entry exists, report error. - if (defined $game_props) { - - # validate heartbeat data - my $heartbeat = ($r{heartbeat} || ($game_props->{default_qport} || 0)); - - # - # verify valid server address (ip+port) - if ($self->valid_address($peer_addr,$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 => $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_server_new(ip => $peer_addr, - beaconport => $port, - heartbeat => $heartbeat, - gamename => $r{gamename}, - secure => $secure, - direct => 1, - updated => time, - beacon => time); - - # send secure string back - if ($auth > 0) { - - # verify that this is a legitimate client by sending the "secure" query - $udp->push_send("\\secure\\$secure\\final\\", $pa); - - # log this as a new beacon (debug) - #$self->log("secure", "challenged new beacon $peer_addr:$port with $secure."); - } - } - - # 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 had bad information --> $raw"); - } - - } - # unknown game - else { - $self->log("support","$peer_addr tries to identify as unknown game \"$r{gamename}\"."); - } - - } - - # 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 from $peer_addr --> '$raw'"); - } -} - -################################################################################ -## Process the received validate query and determine whether the server is -## allowed in our database. Either provide heartbeat OR port, not both. ################################################################################ -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 - 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 - # 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, other game) - $pending->{gamename} = $r{gamename} if (defined $r{gamename}); - - # verify challenge - my $val = $self->compare_challenge( - gamename => lc $pending->{gamename}, - secure => $pending->{secure}, - enctype => $r{enctype}, - validate => $r{validate}, - ignore => $self->{ignore_beacon_key}, - ); +## Process datagrams after querying a server. +## %o contains ip, port, recv buffer, secure string +################################################################################ +sub process_datagram { + my ($self, %o) = @_; + my $rx = $self->data2hashref($o{rxbuf}); + + # can not proceed if validate was provided, but not gamename + return 0 if ( $rx->{validate} && not($rx->{gamename}) ); + # do not process data if no hostport was provided. + return 0 unless $rx->{hostport}; + + # truncate excessively long fields like hostname + $rx->{hostname} = substr $rx->{hostname}, 0, 199 if (length $rx->{hostname} >= 199); + + # try updating serverlist info based on ip/hostport + my $update = $self->update_server( + ip => $o{ip}, + hostport => $rx->{hostport}, + direct => $o{direct}, + %{$rx}, + ); + + # if not found, insert it in the table, after verification + if ($update == 0) { + # can not proceed if gamename was provided, but not validate + return 0 if ( not($rx->{validate}) && $rx->{gamename} ); + + # does the recv buffer contain a validation segment? + my $auth = $self->auth_server( + gamename => lc $rx->{gamename}, + secure => $o{secure}, + enctype => $rx->{enctype}, + validate => $rx->{validate}, + ) if ($rx->{validate} && $rx->{gamename}); + + # if authenticated, or known to be incapable of authenticating (tribesv) + if ($auth || $self->{secure_unsupported} =~ m/$rx->{gamename}/i ) { + # add to the database in three steps. First, insert basic data. + $self->insert_server( + ip => $o{ip}, + port => $o{port}, + hostport => $rx->{hostport}, + ); + # second, update the entry with all available information + $self->update_server( + ip => $o{ip}, + hostport => $rx->{hostport}, + direct => $o{direct}, + %{$rx}, + ); + # third, insert an entry for extended server information + $self->insert_extended( + ip => $o{ip}, + hostport => $rx->{hostport} + ); + # log new beacon + $self->log("add", "new server $o{ip}, $rx->{hostport}". + ($rx->{gamename} ? (" for $rx->{gamename}") : "") ); - # if validated, add server to database - if ($val > 0 || $self->{require_secure_beacons} == 0) { - - # select server from serverlist -- should not exist yet. - my $srv = $self->get_server(ip => $pending->{ip}, port => $pending->{heartbeat})->[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 in serverlist, 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); - } + # addresses are often added through pending list. delete if successful + $self->remove_pending(ip => $o{ip}, port => $o{port}); } else { - # else failed validation - # calculate expected result for log - - my $validate_string = ""; - if ($pending->{gamename} && $pending->{secure}) { - $validate_string = $self->validate_string( - gamename => $pending->{gamename}, - secure => $pending->{secure} - ); - } - $self->log("secure","$pending->{id} for ". - ($pending->{gamename} || "empty_p_gamename") - ." sent: '". ($pending->{secure} || "empty_p_secure") - ."', expected '". ($validate_string || "empty_v_string") - ."', got '". ($r{validate} || "empty_r_validate") + # log: failed secure test + my $val_str = $self->validate_string( + gamename => lc $rx->{gamename}, + secure => $o{secure}, + enctype => $rx->{enctype}, + validate => $rx->{validate}, + ); + $self->log("secure","$o{ip}, $o{port} failed validation for ". + ($rx->{gamename} || "empty_gamename") + ."; sent: '". ($o{secure} || "empty_secure") + ."', expected '". ($val_str || "empty_v_string") + ."', got '". ($rx->{validate} || "empty_r_validate") + ."' with cipher '". ($self->get_game_props(gamename => $rx->{gamename})->[0]->{cipher} || "empty_cipher") ."'" ); + + # remove addresses anyway to prevent error spamming in log + $self->remove_pending(ip => $o{ip}, port => $o{port}); + return 0; } } - # if no entry found in pending list - else { - # not found - $self->log("error","server not found in pending for ". - ($peer_addr || "ip") .":". - ($heartbeat || "0") .",". - ($port || "0") ." !"); - } -} - -################################################################################ -## Process query data that was obtained with \basic\ and/or \info\ from the -## beacon checker module. -## FIXME: error checking and data processing. ($_ || "default") instead. -################################################################################ -sub process_query_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; + # select server id for faster/easier referencing + my $sid = $self->get_server( + ip => $o{ip}, + hostport => $rx->{hostport}, + limit => 1 + )->[0]->{id} || 0; - - # check whether the gamename is supported in our db - if (exists $s{gamename} && $self->get_game_props(gamename => $s{gamename})) { - - # parse variables - my %nfo = (); - $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 hostnames longer than 200 characters - $nfo{hostname} = substr $nfo{hostname}, 0, 199 if (length $nfo{hostname} >= 199); - - # log results (debug) - # $self->log("hostname", "$ip:$port is now known as $nfo{hostname}"); - - # add or update in serverlist (assuming validation is complete) - my $result = $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; - - # log potential error - $self->log("support", "no entries were updated for $ip:$port ($s{gamename}), but it was still removed from pending!") if ($result == 0 && $pen); - } -} + # server not found in db. strange. manually deleted? ignore and return. + return 0 unless $sid; -################################################################################ -## 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; + # update extended information with the unified/new info columns + my ($uei, $upi) = unify_information($sid,$rx); + my $u = $self->update_extended(sid => $sid, %{$uei}); - # check whether this server is in our database - my $serverlist_id = $self->get_server(ip => $ip, port => $port)->[0]; + # update player information (first delete, then add new) + $self->delete_players($sid); + for my $pl (@{$upi}) {$self->insert_players(@{$pl});} - # 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++) { - - # 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); - } - - # log results (debug) - #$self->log("utserver", - # "$serverlist_id->{id}, $ip:$port,\t". - # ($s{numplayers} || "0") ."/". - # ($s{maxplayers} || "0") ."players, ". - # ($s{mapname} || "mapname") .",". - # ($s{hostname} || "hostname") - #); - } -} - -################################################################################ -## Process the list of addresses that was received after querying the UCC applet -## and store them in the pending list. -################################################################################ -sub process_ucc_applet_query { - my ($self, $buf, $ms) = @_; - $buf = encode('UTF-8', $buf); + # return true when all done + return 1 if int($u || 0); - # counter - my $c = 0; + # update possibly failed because we migrated from an older serverlist. + $self->log("warning", "no extended information for $o{ip}, $rx->{hostport} to update"); - # database types such as SQLite are slow, therefore use transactions. - $self->{dbh}->begin_work; + # insert extended table entry again + $self->insert_extended( + ip => $o{ip}, + hostport => $rx->{hostport} + ); - # parse $buf into an array of [ip, port] - foreach my $l (split(/\\/, $buf)) { + # and try to update it again (players were already added independently) + $u = $self->update_extended(sid => $sid, %{$uei}); - # search for \ip\255.255.255.255:7778\, contains ':' - if ($l =~ /:/) { - my ($a,$p) = $l =~ /(.*):(.*)/; - - # check if address entry is valid - if ($self->valid_address($a,$p)) { - # count number of valid addresses - $c++; - - # print address (debug) - # $self->log("add", "applet query added $ms->{gamename}\t$a\t$p"); - - # add server - $self->add_server_new(ip => $a, - beaconport => $p, - heartbeat => $p, - gamename => $ms->{gamename}, - secure => $self->secure_string(), - updated => time); - } - # invalid address, log - else {$self->log("error", "invalid address found at master applet $ms->{ip}, $l!");} - } - } + # return true when all done + return 1 if int($u || 0); - # end transaction, commit - $self->{dbh}->commit; + # now we're toast + $self->log("error", "failed to insert $o{ip}, $rx->{hostport} extended information twice"); + return 0; +} - # update time if successful applet query - $self->update_master_applet( - ip => $ms->{ip}, - port => $ms->{port}, - gamename => $ms->{gamename}, - ) if ($c > 0); - - # print findings - $self->log("applet-rx","found $c addresses at $ms->{ip} for $ms->{gamename}."); +################################################################################ +## Process data into readable player stat columns +## server id, received data buffer hash +## returns unified extended info, unified player info +################################################################################ +sub unify_information { + my ($sid, $rx) = @_; + my %uei; # unified extended info + my @upi; # unified player info + + # FIXME unify with player playername name + + # first process all available player entries + for (my $i = 0; exists $rx->{"player_$i"}; $i++) { + # add player info to UPI and remove from hash + my @player; + push @player, $sid; + push @player, delete $rx->{"player_$i"} || "Derp"; + push @player, delete $rx->{"team_$i"}; + push @player, int (delete $rx->{"frags_$i"} || 0); + push @player, delete $rx->{"mesh_$i"}; + push @player, delete $rx->{"skin_$i"}; + push @player, delete $rx->{"face_$i"}; + push @player, int (delete $rx->{"ping_$i"} || 0); + push @player, delete $rx->{"ngsecret_$i"}; + push @upi, \@player; + } + # return remaining values, player array + return ($rx, \@upi); } 1; diff --git a/lib/MasterServer/UDP/UDPTicker.pm b/lib/MasterServer/UDP/UDPTicker.pm index 6b3a681..0566449 100755 --- a/lib/MasterServer/UDP/UDPTicker.pm +++ b/lib/MasterServer/UDP/UDPTicker.pm @@ -4,253 +4,93 @@ use strict; use warnings; use AnyEvent::Handle::UDP; use Exporter 'import'; -use Data::Dumper 'Dumper'; - 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. +## When addresses are provided from secondary sources (master applets, +## synchronization or manual addition, they are queried by this udp_ticker. +## When they validate (which also implies correct router settings) they are +## added to the masterserver list. ## -## 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. +## Some servers do not support the secure-challenge or do not respond to +## queries directly. By retrieving the server information we are able to +## make exceptions on a case to case basis. ## +## Other than previous MS-Perl versions, unresponsive servers are no longer +## checked. When servers become fail to report in after 2 hours, they remain +## are considered offline and will remain archived. This server can become +## active again by uplinking to one of the affiliated masterservers. ################################################################################ sub udp_ticker { my $self = shift; - # inform that we are running - $self->log("info", "UDP Ticker is loaded."); + # queue: start time, server id, counter, time limit + my %p = (start => time, id => 0, c => 0, limit => 900); # pending: 15m + my %u = (start => time, id => 0, c => 0, limit => 300); # updater: 5m - # 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 + # tick through pending list and server list my $server_info = AnyEvent->timer ( - after => 120, # first give beacons a chance to uplink - interval => 0.2, # 5 addresses per second is fast enough + after => 120, # grace time receiving beacons + interval => 0.2, # ~5 servers/s 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); - } - } - } - - # - # 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; + # reset counters if minimum time before reset passed + list processed + if ($self->{firstrun}) { + if ($p{c} && time - $p{start} > $p{limit}) { # pending reset + %p = (%p, start => time, id => 0, c => 0); } + if ($u{c} && time - $u{start} > $u{limit}) { # updater reset + %u = (%u, start => time, id => 0, c => 0); } } - # 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}; + # Check pending addresses + if ( my $n = $self->get_pending(next_id => $p{id}, limit => 1)->[0] ) { + $p{id} = $n->{id}; # next id will be >$n - # query the server (no secure string) + # assign BeaconChecker to query the server for validate, status $self->query_udp_server( - $n->{id}, - $n->{ip}, - $n->{port}, - "", # no secure string necessary - 2, # request full status info + ip => $n->{ip}, + port => $n->{heartbeat}, + need_validate => 1, ); - - # our work is done for this cycle. return; } + $p{c}++; # all pending addresses were processed - # 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}; + # Update server status + if ( my $n = $self->get_server( + next_id => $u{id}, + updated => 7200, # count >2h as unresponsive + limit => 1 + )->[0] ) { + $u{id} = $n->{id}; # next id will be >$n - # query the server (no secure string) + # assign BeaconChecker to query the server for status (no validate) $self->query_udp_server( - $n->{id}, - $n->{ip}, - $n->{port}, - "", # no secure string necessary - 0, # request info + ip => $n->{ip}, + port => $n->{port}, ); - - # 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 - # + } + $u{c}++; # all servers were processed - # next server in line - $n = $self->get_server( - next_id => $oldserv{id}, - before => 7200, - (defined $self->{firstrun}) ? () : (updated => 86400), # FIXME long firstrun time fixed now? - 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. + # first run complete? + if ($self->{firstrun}) { + # done. no other actions required 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 + } else { + # notify about first run being completed and reset my $t = time-$self->{firstruntime}; my $t_readable = ($t > 60) ? (int($t/60). " minutes ". ($t%60). " seconds") : ($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. + $self->log("info", "first run completed after $t_readable"); + delete $self->{firstruntime}; + $self->{firstrun} = 1; + } + # Run complete. Count down until the minimum time has elapsed and handle + # new server entries as they are added to the list. } ); - - # return the timer object to keep it alive outside of this scope + # allow object to exist beyond this scope. Objects have ambitions too. + $self->log("info", "UDP ticker is loaded"); return $server_info; } diff --git a/lib/MasterServer/UDP/UpLink.pm b/lib/MasterServer/UDP/UpLink.pm index 01e806e..d523ad0 100755 --- a/lib/MasterServer/UDP/UpLink.pm +++ b/lib/MasterServer/UDP/UpLink.pm @@ -2,11 +2,9 @@ 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_udp_secure @@ -52,7 +50,7 @@ sub do_uplink { return unless (defined $ip && defined $port && $port > 0); # report uplinks to log - $self->log("uplink", "Uplink to Masterserver $ip:$port"); + $self->log("uplink", "uplink to Masterserver $ip:$port"); # connect with UDP server my $udp_client; $udp_client = AnyEvent::Handle::UDP->new( @@ -77,44 +75,35 @@ sub do_uplink { ## Note: this replaces the \about\ query in the TCP handler! ################################################################################ sub handle_status_query { - my ($self, $udp, $pa, $buf) = @_; - - # hotfix for one-word queries - $buf .= "\\dummy\\"; - my %r; - - $buf = encode('UTF-8', $buf); - $buf =~ s/\n//; - $buf =~ s/\\\\/\\undef\\/g; # where to add the +? seperate perl script! - $buf =~ s/\\([^\\]+)\\([^\\]+)/$r{$1}=$2/eg; - - # response string + # self, handle, packed address, buffer + my ($self, $udp, $paddress, $buffer) = @_; + my $rx = $self->data2hashref($buffer); my $response = ""; # for compliance, query ids between 0-99 - $query_id = ($query_id >= 99) ? 1 : ++$query_id; + $query_id = ($query_id >= 98) ? 1 : ++$query_id; my $sub_id = 1; - # get database info to present game stats as players, where num_total > 0 + # get database info to present game stats, where num_total > 0 my $maxgames = $self->check_cipher_count(); my $gameinfo = $self->get_game_props( - num_gt => 1, - sort => "num_total", - reverse => 1 + num_gt => 1, + sort => "num_total", + reverse => 1 ); # secure challenge - if (defined $r{secure}) { + if (defined $rx->{secure}) { $response .= "\\validate\\" . $self->validate_string( gamename => "333networks", enctype => 0, - secure => $r{secure} + secure => $rx->{secure} ); } # basic query - if (defined $r{basic} || defined $r{status}) { + if (defined $rx->{basic} || defined $rx->{status}) { $response .= "\\gamename\\333networks" . "\\gamever\\$self->{short_version}" . "\\location\\0" @@ -122,37 +111,36 @@ sub handle_status_query { } # info query - if (defined $r{info} || defined $r{status}) { - $response .= "\\hostname\\$self->{masterserver_hostname}" + if (defined $rx->{info} || defined $rx->{status}) { + $response .= "\\hostname\\".($self->{masterserver_hostname} || "") . "\\hostport\\$self->{listen_port}" . "\\gametype\\MasterServer" - . "\\numplayers\\". scalar @{$gameinfo} - . "\\maxplayers\\$maxgames" + . "\\mapname\\333networks" + . "\\numplayers\\".(scalar @{$gameinfo} || 0) + . "\\maxplayers\\".($maxgames || 0) . "\\gamemode\\openplaying" . "\\queryid\\$query_id.".$sub_id++; } # rules query - if (defined $r{rules} || defined $r{status}) { - $response .= "\\mutators\\333networks synchronization, master applet synchronization" - . "\\AdminName\\$self->{masterserver_name}" - . "\\AdminEMail\\$self->{masterserver_contact}" + if (defined $rx->{rules} || defined $rx->{status}) { + $response .= "\\mutators\\333networks synchronization, UCC Master applet synchronization, Display Stats As Players" + . "\\AdminName\\".($self->{masterserver_name} || "") + . "\\AdminEMail\\".($self->{masterserver_contact} || "") . "\\queryid\\$query_id.".$sub_id++; } # players query - if (defined $r{players} || defined $r{status}) { - # list game stats as if they were players, with game description as - # player_$, gamename as skin_$, total servers as frags_$ and number of - # direct uplinks as deaths_$ + if (defined $rx->{players} || defined $rx->{status}) { + # list game stats as if they were players. let the client figure out how + # to list this information on their website (hint: that's us) my $c = 0; - foreach my $p (@{$gameinfo}) { - $c++; # count players - $response .= "\\player_$c\\$p->{description}" - . "\\skin_$c\\$p->{gamename}" - . "\\frags_$c\\$p->{num_total}" - . "\\deaths_$c\\$p->{num_uplink}"; + $response .= "\\player_$c\\".($p->{description} || "") + . "\\team_$c\\" .($p->{gamename} || "") + . "\\skin_$c\\" .($p->{num_total} || 0) . " total" + . "\\mesh_$c\\" .($p->{num_uplink} || 0) . " direct"; + $c++; # start with player_0, increment } $response .= "\\queryid\\$query_id.".$sub_id++; } @@ -163,10 +151,10 @@ sub handle_status_query { # split the response in chunks of 512 bytes and send while (length $response > 512) { my $chunk = substr $response, 0, 512, ''; - $udp->push_send($chunk, $pa); + $udp->push_send($chunk, $paddress); } # last <512 chunk - $udp->push_send($response, $pa); + $udp->push_send($response, $paddress); } 1; diff --git a/lib/MasterServer/Util/KFStatsWatcher.pm b/lib/MasterServer/Util/KFStatsWatcher.pm index 6601aa3..d78fbf9 100755 --- a/lib/MasterServer/Util/KFStatsWatcher.pm +++ b/lib/MasterServer/Util/KFStatsWatcher.pm @@ -4,51 +4,41 @@ 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; + 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 + # add data to "player" 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; } + 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."); } ); diff --git a/lib/MasterServer/Util/UDPBrowser.pm b/lib/MasterServer/Util/UDPBrowser.pm new file mode 100755 index 0000000..045a7a8 --- /dev/null +++ b/lib/MasterServer/Util/UDPBrowser.pm @@ -0,0 +1,54 @@ +package MasterServer::Util::UDPBrowser; + +use strict; +use warnings; +use AnyEvent::Handle::UDP; +use Socket qw(sockaddr_in inet_ntoa); +use Exporter 'import'; +our @EXPORT = qw| udpbrowser_host |; + +################################################################################ +## Wait for incoming UDP messages from game clients and other masterservers. +## In contrary to the compliant TCP browser host, this function handles the +## request in a single query and responds with a single udp list. +## This read-only method is slightly unsafe as it bypasses the secure/validate +## challenge; however, this list is freely available over the JSON api, so not +## worth protecting against exploits. +## Request format: \echo\request\gamename\postal2\list\\final\ +################################################################################ +sub udpbrowser_host { + # self, handle, packed address, buffer + my ($self, $udp, $paddress, $buffer) = @_; + my $rx = $self->data2hashref($buffer); + my $response = ""; + + # unpack ip from packed client address + my ($port, $iaddr) = sockaddr_in($paddress); + my $addr = inet_ntoa($iaddr); + + # list request with valid gamename and list request + if ($rx->{gamename} && exists $rx->{list}) { + # get list and log + $response = $self->generate_list($rx->{gamename}, $rx->{list}); + $self->log("list","$addr:$port retrieved the list for $rx->{gamename} over UDP"); + } + else { + # log error + $response = "\\echo\\incorrect request format"; + $self->log("warning","$addr:$port failed to retrieve the list over UDP for ". + ($rx->{gamename} || "empty_gamename")); + } + + # close query with final tag + $response .= "\\final\\"; + + # split the response in chunks of 512 bytes and send (for large lists) + while (length $response > 512) { + my $chunk = substr $response, 0, 512, ''; + $udp->push_send($chunk, $paddress); + } + # last <512 chunk + $udp->push_send($response, $paddress); +} + +1; |