receive UDP beacons, validate them and store with country indicator

11 files changed, 947 insertions, 0 deletions

diff --git a/lib/MasterServer.pm b/lib/MasterServer.pm
new file mode 100755
index 0000000..c0bd914
--- /dev/null
+++ b/lib/MasterServer.pm
@@ -0,0 +1,50 @@
+
+package MasterServer;
+
+use strict;
+use warnings;
+
+our $OBJ = bless {}, 'MasterServer::Object';
+
+# Load modules, recursively
+# All submodules should be under the same directory in @INC
+# Greets to Yorhel for this one.
+sub load_recursive {
+  my $rec;
+  $rec = sub {
+    my($d, $f, $m) = @_;
+    for my $s (glob "$d/$f/*") {
+      $OBJ->_load_module("${m}::$1") if -f $s && $s =~ /([^\/]+)\.pm$/;
+      $rec->($d, "$f/$1", "${m}::$1") if -d $s && $s =~ /([^\/]+)$/;
+    }
+  };
+  for my $m (@_) {
+    (my $f = $m) =~ s/::/\//g;
+    my $d = (grep +(-d "$_/$f" or -s "$_/$f.pm"), @INC)[0];
+    $OBJ->_load_module($m) if -s "$d/$f.pm";
+    $rec->($d, $f, $m) if -d "$d/$f";
+  }
+}
+
+# Load modules
+sub load {
+  $OBJ->_load_module($_) for (@_);
+}
+
+# run our master server
+sub run {
+  $OBJ->main();
+}
+
+# The namespace which inherits all functions to be available in the global
+# object.
+package MasterServer::Object;
+
+# load modules
+sub _load_module {
+  my($self, $module) = @_;
+  die $@ if !eval "use $module; 1";
+}
+
+
+1;
diff --git a/lib/MasterServer/Core/Core.pm b/lib/MasterServer/Core/Core.pm
new file mode 100755
index 0000000..d49e36b
--- /dev/null
+++ b/lib/MasterServer/Core/Core.pm
@@ -0,0 +1,147 @@
+
+package MasterServer::Core::Core;
+
+use strict;
+use warnings;
+use AnyEvent;
+use Exporter 'import';
+use Data::Dumper 'Dumper';
+use DBI;
+
+our @EXPORT = qw | halt main |;
+
+##
+## Halt
+## Handle shutting down the program for whatever reason.
+sub halt {
+  my $self = shift;
+  
+  # When other processes are still 
+  # running, set all other scopes 
+  # to null/undef?
+
+  # log shutdown
+  $self->log("stop", "Stopping the masterserver now.");
+  
+  # and send signal to condition var
+  $self->{must_halt}->send;
+  
+  # allow everything to be written to the logs
+  sleep(2);
+  
+  exit;
+}
+
+##
+## Main
+## Initialize all processes and start them
+sub main {
+  my $self = shift;
+  
+  # condition var prevents or allows the program from ending
+  $self->{must_halt} = AnyEvent->condvar;
+  
+  # determine version info
+  $self->version();
+  
+  # keep several objects alive outside their original scope
+  $self->{scope} = ();
+  
+  
+  # Startup procedure
+  $self->log("info", "333networks Master Server Application.");
+  $self->log("info", "Build:   $self->{build_type}");
+  $self->log("info", "Version: $self->{build_version}");
+  $self->log("info", "   Written by $self->{build_author}");
+  $self->log("info", "Logs are written to $self->{log_dir}");
+  
+  
+  # determine the type of database and load the appropriate module
+  { # start db type
+    # read from login
+    my @db_type = split(':', $self->{dblogin}->[0]);
+
+    # format supported (yet)?
+    if ( "Pg SQLite" =~ m/$db_type[1]/i) {
+      
+      # inform us what DB we try to load
+      $self->log("loader","Loading $db_type[1] database module.");
+    
+      # load dbd and tables/queries for this db type
+      MasterServer::load_recursive("MasterServer::Database::$db_type[1]");
+      
+      # Connect to database
+      $self->{dbh} = $self->database_login(); #FIXME!!!!
+    }
+    else {
+      # raise error and halt
+      $self->log("fatal", "The masterserver could not determine the chosen database type.");
+      $self->halt();
+    }
+  }  # end db type
+  
+  
+  # start the listening service (listen for UDP beacons)
+  $self->{scope}->{beacon_catcher} = $self->beacon_catcher();
+  
+  
+  $self->log("info", "All modules loaded. Starting...");
+
+  
+=pod  
+
+  ##############################################################################
+  ##
+  ##   Initiate Scheduled tasks
+  ##
+  ##   Main Tasks
+  ##      beacon_catcher   (udp server)
+  ##      beacon_checker   (udp client, timer)
+  ##      browser_server   (tcp server)
+  ##      
+  ##   Synchronization
+  ##      ucc_applet_query (tcp client, timer)
+  ##      syncer_scheduler (tcp client, timer)
+  ##
+  ##   333networks website specific
+  ##      ut_server_query  (udp client, timer)
+  ##
+  ##   Core Functions
+  ##      maintenance      (timer, dbi)
+  ##      statistics       (timer, dbi)
+  ##
+  ## (store objects in hash to keep them alive outside their own scopes)
+  ##############################################################################
+  
+  ## servers
+   $ae{beacon_catcher}    = $self->beacon_catcher();
+   $ae{beacon_checker}    = $self->beacon_checker_scheduler();
+   $ae{browser_server}    = $self->browser_server();
+
+   # synchronizing
+   $ae{ucc_applet_query}  = $self->ucc_applet_query_scheduler();
+   $ae{syncer_scheduler}  = $self->syncer_scheduler();
+
+   # status info for UT servers (333networks site)
+   $ae{ut_server_scheduler} = $self->ut_server_scheduler();  
+   
+   # maintenance
+   $ae{maintenance_runner}  = $self->maintenance_runner();
+   $ae{stats_runner}        = $self->stats_runner();
+=cut
+
+
+
+
+
+
+
+
+
+
+  # prevent main program from ending prematurely
+  $self->{must_halt}->recv;
+  $self->log("stop", "Logging off. Enjoy your day.");
+}
+
+1;
diff --git a/lib/MasterServer/Core/Logging.pm b/lib/MasterServer/Core/Logging.pm
new file mode 100755
index 0000000..efd2123
--- /dev/null
+++ b/lib/MasterServer/Core/Logging.pm
@@ -0,0 +1,66 @@
+
+package MasterServer::Core::Logging;
+
+use strict;
+use warnings;
+use POSIX qw/strftime/;
+use Exporter 'import';
+
+our @EXPORT = qw| log |;
+
+################################################################################
+#
+# Log to file and print to screen.
+# args: $self, message_type, message
+#
+################################################################################
+sub log {
+  my ($self, $type, $msg) = @_;
+  
+  # parse time of log entry and prep for rotating log
+  my $time    = strftime('%Y-%m-%d %H:%M:%S',localtime);
+  my $yearly  = strftime('-%Y',localtime);
+  my $monthly = strftime('-%Y-%m',localtime);
+  my $weekly  = strftime('-%Y-week%U',localtime);
+  my $daily   = strftime('-%Y-%m-%d',localtime);
+  
+  # is the message suppressed in config?
+  if (defined $type && $self->{suppress} =~ m/$type/i){
+    print "[$time] [SUPPRESSED] [$type] $msg\n"; #FIXME
+   return; # return if <$>
+  }
+  
+  # determine filename
+  my $f = "MasterServer-333networks";
+  
+  # rotate log filename according to config
+  $f .= $daily    if ($self->{log_rotate} =~ /^daily$/i   );
+  $f .= $weekly   if ($self->{log_rotate} =~ /^weekly$/i  );
+  $f .= $monthly  if ($self->{log_rotate} =~ /^monthly$/i );
+  $f .= $yearly   if ($self->{log_rotate} =~ /^yearly$/i  );
+  $f .= ".log";
+  
+  # put log filename together
+  my $logfile = $self->{log_dir}.((substr($self->{log_dir},-1) eq "/")?"":"/").$f;
+
+  print "[$time] [$type] > $msg\n" if $self->{printlog};
+  
+  # temporarily disable the warnings-to-log, to avoid infinite recursion if
+  # this function throws a warning.
+  my $old = $SIG{__WARN__};
+  $SIG{__WARN__} = undef;
+
+  chomp $msg;
+  $msg =~ s/\n/\n  | /g;
+  if($logfile && open my $F, '>>:utf8', $logfile) {
+    flock $F, 2;
+    seek $F, 0, 2;
+    print $F "[$time]\t[$type]\t$msg\n";
+    flock $F, 4;
+    close $F;
+  }
+  $SIG{__WARN__} = $old;
+}
+
+
+1;
diff --git a/lib/MasterServer/Core/Secure.pm b/lib/MasterServer/Core/Secure.pm
new file mode 100755
index 0000000..dbe9c1f
--- /dev/null
+++ b/lib/MasterServer/Core/Secure.pm
@@ -0,0 +1,210 @@
+
+package MasterServer::Core::Secure;
+
+use strict;
+use warnings;
+use POSIX qw/strftime/;
+use Exporter 'import';
+
+our @EXPORT = qw| secure_string validated_beacon validated_request validate_string charshift get_validate_string|;
+
+## generate a random string of 6 characters long for the \secure\ challenge
+sub secure_string {
+  # spit out a random string, only uppercase characters
+  my @c = ('A'..'Z');
+  my $s = "";
+  $s .= $c[rand @c] for 1..6;
+  
+  # return random string
+  return $s;
+}
+
+## Check if beacon has a valid response.
+sub validated_beacon {
+  my ($self, $gamename, $secure, $enctype, $validate) = @_;
+  
+  # debugging enabled? Then don't care about validation
+  return 1 if ($self->{debug_validate});
+  
+  # enctype given? 
+  $enctype = 0 unless $enctype;
+  
+  if ($self->{ignore_beacon_key} =~ m/$gamename/i){
+    $self->log("secure", "Ignored beacon validation for $gamename.");
+    return 1;
+  }
+  
+  # compare received response with challenge
+  return ($self->validate_string($gamename, $secure, $enctype) eq $validate) || 0;
+}
+
+## Check if request has valid response
+sub validated_request {
+  my ($self, $gamename, $secure, $enctype, $validate) = @_;
+  
+  # debugging enabled? Then don't care about validation
+  return 1 if ($self->{debug_validate});
+  
+  # enctype given? 
+  $enctype = 0 unless $enctype;
+  
+  # ignore games and beacons that are listed
+  if ($self->{ignore_browser_key} =~ m/$gamename/i){
+    $self->log("secure", "Ignored browser validation for $gamename.");
+    return 1;
+  }
+  
+  # compare received response with challenge
+  return ($self->validate_string($gamename, $secure, $enctype) eq $validate) || 0;
+}
+
+################################################################################
+# calculate the \validate\ response for the \secure\ challenge. 
+# args: gamename, secure_string, encryption type
+# returns: validate string (usually 8 characters long)
+# !! requires cipher hash to be configured in config! (imported or else)
+################################################################################
+sub validate_string {
+  my ($self, $game, $sec, $enc)  = @_;
+  
+  # get cipher from gamename
+  my $cip = $self->{game}->{$game}->{key} || "XXXXXX";
+  
+  # don't accept challenge longer than 16 characters -- usually h@xx0rs
+  if (length $sec > 16) {
+    return "0"}
+  
+  # check for valid encryption choises
+  my $enc_val = (defined $enc && 0 <= $enc && $enc <= 2) ? $enc : 0;
+  
+  # calculate and return validate string
+  return $self->get_validate_string($cip, $sec, $enc_val);
+}
+
+################################################################################
+# rotate characters as part of the secure/validate algorithm.
+# arg and return: int (representing a character)
+################################################################################
+sub charshift {
+  my ($self, $reg) = @_;
+    return($reg + 65) if ($reg <  26);
+    return($reg + 71) if ($reg <  52);
+    return($reg - 4)  if ($reg <  62);
+    return(43)        if ($reg == 62);
+    return(47)        if ($reg == 63);
+    
+    # if all else fails
+    return(0);
+}
+
+################################################################################
+# algorithm to calculate the response to the secure/validate query. processes
+# the secure_string and returns the challenge_string with which GameSpy secure
+# protocol authenticates games.
+#
+# the following algorithm is based on gsmsalg.h in GSMSALG 0.3.3 by Luigi 
+# Auriemma, aluigi@autistici.org, aluigi.org, copyright 2004-2008. GSMSALG 0.3.3
+# was released under the GNU General Public License, for more information, see
+# the original software at http://aluigi.altervista.org/papers.htm#gsmsalg
+#
+# conversion and modification of the algorithm by Darkelarious, June 2014.
+#
+# args: game cipher, 6-char challenge string, encryption type
+# returns: validate string (usually 8 characters long)
+# !! requires cipher hash to be configured in config! (imported or else)
+################################################################################
+sub get_validate_string {
+  my ($self, $cipher_string, $secure_string, $enctype) = @_;
+  
+  # import pre-built rotations from config for enctype 
+  # -- see GSMSALG 0.3.3 reference for copyright and more information
+  my @enc_chars = $self->{enc_chars};
+
+  # convert to array of characters
+  my @cip = split "", $cipher_string;
+  my @sec = split "", $secure_string;
+
+  # length of strings/arrays which should be 6
+  my $sec_len = scalar @sec;
+  my $cip_len = scalar @cip;
+  
+  # from this point on, work with ordinal values
+  for (0..$sec_len-1) { $sec[$_] = ord $sec[$_]; }
+  for (0..$cip_len-1) { $cip[$_] = ord $cip[$_]; }
+  
+  # helper vars
+  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);
+  
+  # temporary array with ascii characters
+  my @enc;
+  for(0..255) {$enc[$_] = $_;}
+
+  $j = 0;
+  for(0..255) {
+      $j += $enc[$_] + $cip[$_ % $cip_len];
+      $j = $j % 256;
+      $l = $enc[$j];
+      $enc[$j] = $enc[$_];
+      $enc[$_] = $l;
+  }
+
+  # store temporary positions  
+  my @tmp;
+  
+  $j = 0;
+  $k = 0;
+  for($i = 0; $sec[$i]; $i++) {
+      $j += $sec[$i] + 1;
+      $j = $j % 256;
+      $l = $enc[$j];
+      $k += $l;
+      $k = $k % 256;
+      $m = $enc[$k];
+      $enc[$k] = $l;
+      $enc[$j] = $m;
+      $tmp[$i] = $sec[$i] ^ $enc[($l + $m) & 0xff];
+  }
+  
+# part of the enctype 1-2 process
+  for($sec_len = $i; $sec_len % 3; $sec_len++) {
+      $tmp[$sec_len] = 0;
+  }
+  
+  if ($enctype == 1) {
+    for (0..$sec_len-1) {
+      $tmp[$_] = $enc_chars[$tmp[$_]];
+    }
+  }
+  elsif ($enctype == 2) {
+    for (0..$sec_len-1) {
+      $tmp[$_] ^= $cip[$_ % $cip_len];
+    }
+  }  
+  
+  # parse the validate array
+  $p = 0;
+  my @val;
+  for($i = 0; $i < $sec_len; $i += 3) {
+      $l = $tmp[$i];
+      $m = $tmp[$i + 1];
+      $m = $m % 256;
+      $n = $tmp[$i + 2];
+      $n = $n % 256;
+      $val[$p++] = $self->charshift($l >> 2);
+      $val[$p++] = $self->charshift((($l & 3 ) << 4) | ($m >> 4));
+      $val[$p++] = $self->charshift((($m & 15) << 2) | ($n >> 6));
+      $val[$p++] = $self->charshift($n & 63);
+  }
+  
+  # return to ascii characters
+  my $str = "";
+  for (@val) { $str .= chr $_}
+  
+  return $str;
+}
+
+1;
diff --git a/lib/MasterServer/Core/Util.pm b/lib/MasterServer/Core/Util.pm
new file mode 100755
index 0000000..001137d
--- /dev/null
+++ b/lib/MasterServer/Core/Util.pm
@@ -0,0 +1,35 @@
+
+package MasterServer::Core::Util;
+
+use strict;
+use warnings;
+use IP::Country::Fast;
+use POSIX qw/strftime/;
+use Exporter 'import';
+
+our @EXPORT = qw| valid_address ip2country |;
+
+## return the abbreviated country based on IP
+sub ip2country {
+my ($self, $ip) = @_;
+  my $reg = IP::Country::Fast->new();
+  return $reg->inet_atocc($ip);
+}
+
+## Verify whether a given domain name or IP address and port are valid.
+## returns true/false if valid ip + port
+sub valid_address {
+  my ($self, $a, $p) = @_;
+  
+  # check if ip and port are in valid range
+  my $val_addr = ($a =~ '\b(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\b');
+  my $val_port = (0 < $p && $p <= 65535);
+  
+  # exclude addresses where we don't want people sniffing
+  for (qw|192.168.(.\d*).(.\d*) 127.0.(.\d*).(.\d*) 10.0.(.\d*).(.\d*)|){$val_addr = 0 if ($a =~ m/$_/)}
+  
+  # only return true if both are valid  
+  return ($val_addr && $val_port);
+}
+
+1;
diff --git a/lib/MasterServer/Core/Version.pm b/lib/MasterServer/Core/Version.pm
new file mode 100755
index 0000000..5bd3f1c
--- /dev/null
+++ b/lib/MasterServer/Core/Version.pm
@@ -0,0 +1,41 @@
+
+package MasterServer::Core::Version;
+
+use strict;
+use warnings;
+use Exporter 'import';
+
+our @EXPORT = qw| version |;
+
+
+################################################################################
+#
+# Version information
+#
+################################################################################
+sub version {
+  my $self = shift;
+  
+  # version and author information
+  # -- addition to the LICENCE, you are only allowed to modify these lines
+  # if you send Darkelarious a postcard or email with your compliments or,
+  # in case of a company editing, a letter of commendation.
+  #
+  # You are not allowed to modify these variables without making (significant)
+  # alterations to the source code of this master server program. Only changing
+  # these fields does not count as a significant alteration.
+
+  # master type
+  $self->{build_type}     = "333networks Masterserver-Perl";
+  
+  # version
+  $self->{build_version}  = "0.2";
+  
+  # date yyyy-mm-dd
+  $self->{build_date}     = "2015-01-31";
+  
+  #author, email
+  $self->{build_author}   = "Darkelarious, darkelarious\@333networks.com";
+}
+
+1;
diff --git a/lib/MasterServer/Database/Pg/dbBeacon.pm b/lib/MasterServer/Database/Pg/dbBeacon.pm
new file mode 100755
index 0000000..a234b25
--- /dev/null
+++ b/lib/MasterServer/Database/Pg/dbBeacon.pm
@@ -0,0 +1,123 @@
+
+package MasterServer::Database::Pg::dbBeacon;
+
+use strict;
+use warnings;
+use Exporter 'import';
+
+our @EXPORT = qw| add_beacon get_pending_beacon remove_pending set_direct_beacon |;
+
+## Update beacon in serverlist or pending list. Add if beacon does not exist in
+## either list. Return 0,1,2 if success in adding or -1 on error
+sub add_beacon {
+  my ($self, $ip, $beaconport, $heartbeat, $gamename, $secure) = @_;
+
+  # if address is in list, update the timestamp
+  my $u = $self->{dbh}->do(
+     "UPDATE serverlist 
+      SET beacon   = NOW(),
+          updated  = NOW(),
+          gamename = ?,
+          b333ms   = TRUE
+      WHERE ip = ? 
+      AND port = ?",
+      undef, lc $gamename, $ip, $heartbeat);
+  
+  # notify
+  $self->log("updated", "beacon heartbeat for $ip:$heartbeat") if ($u > 0);
+  
+  # if serverlist was updated return 0
+  return 0 if ($u > 0);
+
+  # if it is already in the pending list, update it with a new challenge
+     $u = $self->{dbh}->do(
+     "UPDATE pending 
+      SET added       = NOW(),
+          beaconport  = ?,
+          gamename    = ?,
+          secure      = ?
+      WHERE ip = ? 
+      AND heartbeat = ?",
+      undef, $beaconport, lc $gamename, $secure, $ip, $heartbeat);  
+                            
+  # notify
+  $self->log("updated", "beacon heartbeat $ip:$beaconport pending $gamename:$heartbeat") if ($u > 0);
+  
+  # beacon was already in pending list and was updated
+  return 1 if ($u > 0);
+  
+  # if not found, add it
+     $u = $self->{dbh}->do(
+     "INSERT INTO pending (ip, beaconport, heartbeat, gamename, secure) 
+      SELECT ?, ?, ?, ?, ?",
+      undef, $ip, $beaconport, $heartbeat, lc $gamename, $secure);
+                      
+   # notify 
+   $self->log("added", "beacon heartbeat $ip:$beaconport pending $gamename:$heartbeat") if ($u > 0);
+   
+   # it was added to pending
+   return 2 if ($u > 0);
+   
+  # or else report error
+  $self->log("error", "an error occurred adding beacon $ip:$beaconport with $gamename:$heartbeat to the pending list");
+  return -1;
+}
+
+
+##   Get pending server by ip, beacon port.
+sub get_pending_beacon {
+  my ($self, $ip, $port) = @_;
+  
+  # if address is in list, update the timestamp
+  return $self->{dbh}->selectall_arrayref(
+            "SELECT * FROM pending
+             WHERE ip = ? 
+             AND beaconport = ?",
+            undef, $ip, $port)->[0];
+}
+
+
+##  server checks out, remove entry from the pending list.
+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("deleted", "removed pending id $id from the list of pending servers") if ($u > 0);
+  
+  # it was added to pending
+  return 2 if ($u > 0);
+  
+  # or else report error
+  $self->log("error", "an error occurred deleting server $id from the pending list");
+  return -1;
+}
+
+
+## mark server as "direct beacon to this masterserver"
+sub set_direct_beacon {
+  my ($self, $ip, $port) = @_;
+  
+  # update or add server to serverlist
+  my $u = $self->{dbh}->do("UPDATE serverlist 
+                            SET b333ms   = TRUE
+                            WHERE ip = ? 
+                            AND port = ?",
+                            undef, $ip, $port);
+
+  # notify
+  $self->log("updated", "$ip:$port is a direct beacon.") if ($u > 0);
+  
+  # if found, updated; done
+  return 0 if ($u > 0);
+  
+  # or else report error
+  $self->log("error", "an error occurred setting server $ip:$port as direct beacon");
+  return -1;
+}
+
+
+
+1;
diff --git a/lib/MasterServer/Database/Pg/dbCore.pm b/lib/MasterServer/Database/Pg/dbCore.pm
new file mode 100755
index 0000000..c6e3182
--- /dev/null
+++ b/lib/MasterServer/Database/Pg/dbCore.pm
@@ -0,0 +1,44 @@
+
+package MasterServer::Database::Pg::dbCore;
+
+use strict;
+use warnings;
+use Exporter 'import';
+
+our @EXPORT = qw| database_login |;
+
+################################################################################
+## database_login
+## login to the database with credentials provided in the config file.
+## returns dbh object
+################################################################################
+sub database_login {
+  my $self = shift;
+
+  # create the dbi object
+  my $dbh = DBI->connect(@{$self->{dblogin}}, {PrintError => 0});
+  
+  # verify that the database connected
+  if (defined $dbh) {
+    # log the event
+    $self->log("database","Connected to the Postgres database.");
+    
+    # turn on error printing
+    $dbh->{printerror} = 1;
+    
+    # return the dbi object for further use
+    return $dbh;
+  }
+  else {
+    # fatal error
+    $self->log("fatal", "$DBI::errstr!");
+    
+    # end program
+    $self->halt();
+  }
+  
+  # unreachable
+  return undef;
+}
+
+1;
diff --git a/lib/MasterServer/Database/Pg/dbServerlist.pm b/lib/MasterServer/Database/Pg/dbServerlist.pm
new file mode 100755
index 0000000..8d1a2b2
--- /dev/null
+++ b/lib/MasterServer/Database/Pg/dbServerlist.pm
@@ -0,0 +1,44 @@
+
+package MasterServer::Database::Pg::dbServerlist;
+
+use strict;
+use warnings;
+use Exporter 'import';
+
+our @EXPORT = qw| add_to_serverlist |;
+
+## beacon was verified or otherwise accepted and will noe now be added to the 
+## serverlist.
+sub add_to_serverlist {
+  my ($self, $ip, $port, $gamename) = @_;
+  
+  # update or add server to serverlist
+  my $u = $self->{dbh}->do("UPDATE serverlist 
+                            SET updated  = NOW()
+                            WHERE ip = ? 
+                            AND port = ?",
+                            undef, $ip, $port);
+
+  # notify
+  $self->log("updated", "$ip:$port timestamp updated") if ($u > 0);
+  
+  # if found, updated; done
+  return 0 if ($u > 0);
+  
+  # if not found, add it.
+     $u = $self->{dbh}->do("INSERT INTO serverlist (ip, port, gamename, country) 
+                            SELECT ?, ?, ?, ?",
+                            undef, $ip, $port, $gamename, $self->ip2country($ip));
+
+  # notify
+  $self->log("added", "$ip:$port added to serverlist") if ($u > 0);
+  
+  # return added
+  return 1 if ($u > 0);
+
+  # or else report error
+  $self->log("error", "an error occurred adding server $ip:$port ($gamename) to the serverlist");
+  return -1;
+}
+
+1;
diff --git a/lib/MasterServer/UDP/BeaconCatcher.pm b/lib/MasterServer/UDP/BeaconCatcher.pm
new file mode 100755
index 0000000..7fdc630
--- /dev/null
+++ b/lib/MasterServer/UDP/BeaconCatcher.pm
@@ -0,0 +1,67 @@
+
+package MasterServer::UDP::BeaconCatcher;
+
+use strict;
+use warnings;
+use AnyEvent::Handle::UDP;
+use Socket qw(sockaddr_in inet_ntoa);
+use Exporter 'import';
+
+our @EXPORT = qw| beacon_catcher on_beacon_receive|;
+
+##
+## Receive UDP beacons according the \heartbeat\7778\gamename\ut\ format 
+## where "ut" depicts the game and 7778 the query port of the game.
+sub beacon_catcher {
+  my $self = shift;
+  
+  # module startup log
+  $self->log("loader","Loading UDP Beacon Catcher.");
+  
+  # UDP server
+  my $udp_server; 
+     $udp_server = AnyEvent::Handle::UDP->new(
+  
+    # Bind to this host and use the port specified in the config file
+    bind => ['0.0.0.0', $self->{beacon_port}],
+  
+    # when datagrams are received
+    on_recv => sub {$self->on_beacon_receive(@_)},
+  );
+  
+  # display that the server is up and listening for beacons
+  $self->log("ok", "Listening for UT Beacons on port $self->{beacon_port}.");
+  
+  # allow object to exist beyond this scope. Objects have ambitions too.
+  return $udp_server;
+}
+
+## process (new) beacons
+sub on_beacon_receive {
+  # $self, beacon address, handle, packed client address
+  my ($self, $b, $udp, $pa) = @_; 
+
+  # unpack ip from packed client address
+  my ($port, $iaddr) = sockaddr_in($pa);
+  my $peer_addr      = inet_ntoa($iaddr);
+  
+  # if the beacon has a length longer than a certain amount, assume it is
+  # a fraud or crash attempt
+  if (length $b > 64) {
+    # log
+    $self->log("attack","length exceeded in beacon: $peer_addr:$port sent $b");
+    
+    # truncate and try to continue
+    $b = substr $b, 0, 64;
+  }
+  
+  # if a heartbeat format was detected...
+  $self->process_udp_beacon($udp, $pa, $b, $peer_addr, $port) 
+    if ($b =~ m/\\heartbeat\\/ && $b =~ m/\\gamename\\/);
+  
+  # or if this is a secure response, verify the response code and add mark it verified
+  $self->process_udp_validate($b, $peer_addr, $port, undef) 
+    if ($b =~ m/\\validate\\/);
+}
+
+1;
diff --git a/lib/MasterServer/UDP/BeaconProcessor.pm b/lib/MasterServer/UDP/BeaconProcessor.pm
new file mode 100755
index 0000000..a41905f
--- /dev/null
+++ b/lib/MasterServer/UDP/BeaconProcessor.pm
@@ -0,0 +1,120 @@
+
+package MasterServer::UDP::BeaconProcessor;
+
+use strict;
+use warnings;
+use Data::Dumper 'Dumper';
+use AnyEvent::Handle::UDP;
+use Exporter 'import';
+
+our @EXPORT = qw| process_udp_beacon process_udp_validate |;
+
+
+## process beacons that have a \heartbeat\ and \gamename\ format
+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;
+  $buf =~ s/\\([^\\]+)\\([^\\]+)/$r{$1}=$2/eg;
+  
+  # check whether the beacon has a gamename that is supported in our list
+  if (defined $r{gamename} && exists $self->{game}->{lc $r{gamename}}) {
+    # log the beacon
+    $self->log("beacon", "$peer_addr:$r{heartbeat} for $r{gamename}");
+    
+    # some games (like bcommander) have a default port and don't send a
+    # heartbeat port.
+    if ($r{heartbeat} == 0) {
+      # assuming a default port exists
+      if (exists $self->{game}->{lc $r{gamename}}->{port}) {
+        $r{heartbeat} = $self->{game}->{lc $r{gamename}}->{port};
+      }
+    }
+    
+    #
+    # verify valid server address (ip+port)
+    if ($self->valid_address($peer_addr,$r{heartbeat})) {
+      
+      # generate a new secure string
+      my $secure = $self->secure_string();
+      
+      # update beacon in serverlist if it already exists, otherwise update
+      # or add to pending with new secure string.
+      my $auth = $self->add_beacon($peer_addr, $port, $r{heartbeat}, $r{gamename}, $secure);
+      
+      # 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
+          $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:$r{heartbeat} ($r{heartbeat}) had bad information");
+    }
+  }
+  
+  # gamename not valid or not found in supportedgames.pl
+  else {
+    # log
+    $self->log("support", "received unknown beacon \"$r{gamename}\" from $peer_addr:$r{heartbeat}");
+  }
+}
+
+
+## process the received validate query and determine whether the server is allowed in our database
+sub process_udp_validate {
+  # $self, udp data, ip, port
+  my ($self, $buf, $peer_addr, $port, $heartbeat) = @_;
+  
+  # received heartbeat in $b:    \validate\string\queryid\99.9\ 
+  my %r;
+  $buf =~ s/\\([^\\]+)\\([^\\]+)/$r{$1}=$2/eg;
+  
+  # get our existing knowledge about this server from the database 
+  # if the heartbeat/queryport known? then use that instead as beacon ports --> may vary after server restarts!
+  my $pending = (defined $heartbeat) ? $self->get_pending_info($peer_addr, $heartbeat) : $self->get_pending_beacon($peer_addr, $port);
+  
+  # if indeed in the pending list, check
+  if (defined $pending) {
+    
+    #determine if it uses any enctype
+    my $enc = (defined $r{enctype}) ? $r{enctype} : 0;
+    
+    # database may not contain the correct gamename (ucc applet, incomplete beacon, change of gameserver)
+    $pending->[4] = (defined $r{gamename} && exists $self->{game}->{lc $r{gamename}}) ? $r{gamename} : $pending->[4];
+
+    # verify    challenge          gamename       secure         enctype validate_response
+    my $val = $self->validated_beacon($pending->[4], $pending->[5], $enc,   $r{validate});
+    
+    # log challenge results
+    $self->log("secure", "$peer_addr:$port validated with $val for $pending->[4]");
+
+    # if validated, add to db          
+    if ($val > 0) {
+      
+      # successfully added?             ip,            query port,    gamename
+      my $sa = $self->add_to_serverlist($pending->[1], $pending->[3], $pending->[4]);
+      
+      # remove the entry from pending if successfully added
+      $self->remove_pending($pending->[0]) if ( $sa >= 0);
+      
+      # and set as direct beacon
+      $self->set_direct_beacon($pending->[1], $pending->[3]);
+    }
+    else {
+      # else failed validation            
+      $self->log("error","beacon $peer_addr:$port failed validation for $pending->[4] (details: $pending->[5] sent, got $r{validate})");
+    }
+  }
+}
+
+1;