diff options
Diffstat (limited to 'lib/MasterServer/Core')
| -rwxr-xr-x | lib/MasterServer/Core/Core.pm | 147 | ||||
| -rwxr-xr-x | lib/MasterServer/Core/Logging.pm | 66 | ||||
| -rwxr-xr-x | lib/MasterServer/Core/Secure.pm | 210 | ||||
| -rwxr-xr-x | lib/MasterServer/Core/Util.pm | 35 | ||||
| -rwxr-xr-x | lib/MasterServer/Core/Version.pm | 41 |
5 files changed, 499 insertions, 0 deletions
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; |