aboutsummaryrefslogtreecommitdiff
path: root/gameserver/gameserver.pl
blob: 924ce06e79a1b22f24b8d7aee5f5a089bccba740 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
#!/usr/bin/perl

################################################################################
# Simulate a gameserver
#   - send beacon
#   - respond to secure
#   - respond to status
#
################################################################################

use strict;
use warnings;
use AnyEvent;
use AnyEvent::Handle::UDP;
use Socket qw( sockaddr_in inet_aton);
use Data::Dumper 'Dumper';
$|++;

our %S;
require "../common/supportedgames.pl";
require "../common/auth.pl";
require "../common/status.pl";

# set game (note that properties can be set in "common/status.pl")
my $gamename = &getGameName;
my $port     = 7778;

# set masterserver
my $masteraddress = "rhea.333networks.com";
my $masterport    = 27900;
my $ma = sockaddr_in($masterport, inet_aton($masteraddress) );

# parse label
my $label = ( $S{game}->{lc $gamename}->{label} || $gamename );

# start simulation
print "Simulating [$label] gameserver on port $port.\n";

# loop
my $cv = AnyEvent->condvar;

# start UDP server on $port
my $udp_server; $udp_server = AnyEvent::Handle::UDP->new(
    bind => ['0.0.0.0', $port],
    on_recv => sub 
    { 
        # beacon address, handle, packed client address
        my ($b, $c, $pa) = @_;
        
        # parse and remove trailing newline, leading undef
        chomp $b;
        my @data = split /\\/, $b;
        
        return if (scalar @data <= 1);
        shift @data;
        
        # if status
        if ($data[0] =~ m/^(basic|info|rules|players|status|echo)$/ig)
        {   
            # generate the status response
            my $response = &getResponse($data[0], $data[1] || "");
            
            # status is longer than 1024 bytes. older games do not support
            # long queries. start splitting at \player\ parts.
            
            # split the response in chunks of 768 bytes and send (for large lists)
            while (length $response > 768) 
            {
                my $pos = index $response, "\\player_", 768;
                my $chunk = substr $response, 0, $pos, '';
                $udp_server->push_send($chunk, $pa);
            }
            # last <512 chunk
            $udp_server->push_send($response, $pa);
        }
        
        # respond to possible secure
        if ($b =~ m/(secure)/ig)
        {
            my %h;
            my @a = split /\\/, ($b||"");
            shift @a;
            %h = (@a, (scalar @a % 2 == 1) ? "dummy" : () );
            
            # calculate validate
            my $validate = get_validate_string(
                $S{game}->{$gamename}->{key}, 
                ($h{secure}|| "wookie"), 
                int( $h{enctype} || 0)
            );
            
            $udp_server->push_send("\\validate\\".$validate, $pa)
         }
    }
);

# send out heartbeats
my $timer = AnyEvent->timer (
    after     =>  1,
    interval  => 10,
    cb        => sub {
        $udp_server->push_send("\\heartbeat\\$port\\gamename\\$gamename", $ma);
    },
);

$cv->recv;

1;