wesnoth/utils/wesnothd.pl
2007-08-14 16:12:55 +00:00

315 lines
8.9 KiB
Perl

use strict;
use wml;
use IO::Socket;
use IO::Select;
use Fcntl;
use Carp qw(confess);
use Getopt::Std;
#my $usage = "Usage: $0 [-p port]";
my %opts = ();
getopts('p:',\%opts);
my $port = '15000';
$port = $opts{'p'} if $opts{'p'};
my %pending_handshake = ();
my %outgoing_schemas = ();
my %incoming_schemas = ();
my %incoming_bufs = ();
my %connection_nums = ();
my %user_name_socket = ();
my %socket_user_name = ();
my %lobby_players = ();
my %socks_map = ();
my @games = ();
my $current_game_id = 1;
my $current_connection_num = 1;
my $read_set = new IO::Select();
my $login_response = &wml::single_child_doc('mustlogin');
my $join_lobby_response = &wml::single_child_doc('join_lobby');
my $gamelist = {'name' => 'gamelist', 'children' => [], 'attr' => {}};
my $initial_response = {'name' => '', 'children' => [$gamelist], 'attr' => {}};
my $old_initial_response = &wml::deep_copy($initial_response);
my @disallowed_names = ('server', 'ai', 'player', 'network', 'human', 'admin', 'computer');
my $server_sock = new IO::Socket::INET (
LocalHost => '',
LocalPort => $port,
Proto => 'tcp',
Listen => 1,
Reuse => 1
) or die "could not create server sock: $!";
$read_set->add($server_sock);
sub send_data {
my $doc = shift @_;
return unless @_;
print "SENDING: {{{" . &wml::write_text($doc) . "}}}\n";
foreach my $socket (@_) {
my $sock = $socks_map{$socket};
my $packet = &wml::write_binary($outgoing_schemas{$sock}, $doc) . chr 0;
my $header = pack('N',length $packet);
$packet = $header . $packet;
my $res = syswrite($sock, $packet, length $packet);
&socket_disconnected($sock) unless $res == length $packet;
}
}
sub send_error($$) {
my ($sock, $msg) = @_;
print STDERR "sending error: '$msg'\n";
my $doc = {'name' => '', 'children' => [{'name' => 'error', 'attr' => {'message' => $msg}}], 'attr' => {}};
&send_data($doc,$sock);
}
sub send_to_lobby {
my ($doc, $exclude, @users) = @_;
foreach my $socket (@users) {
&send_data($doc, $socks_map{$socket}) unless $socks_map{$socket} eq $exclude;
}
}
sub socket_connected($) {
my ($sock) = @_;
print STDERR "connected: $sock\n";
$read_set->add($sock);
$outgoing_schemas{$sock} = [];
$incoming_schemas{$sock} = [];
$pending_handshake{$sock} = 1;
$socks_map{$sock} = $sock;
my $flags = '';
fcntl($sock, F_GETFL, $flags) or die "Couldn't get flags: $!";
$flags |= O_NONBLOCK;
fcntl($sock, F_SETFL, $flags) or die "Couldn't set flags: $!";
}
sub socket_disconnected($) {
my ($sock) = @_;
$sock = $socks_map{$sock};
print STDERR "disconnected: $sock\n";
delete $socks_map{$sock};
delete $outgoing_schemas{$sock};
delete $incoming_schemas{$sock};
delete $incoming_bufs{$sock};
delete $pending_handshake{$sock};
delete $connection_nums{$sock};
delete $lobby_players{$sock};
if(my $username = $socket_user_name{$sock}) {
delete $user_name_socket{$username};
delete $socket_user_name{$sock};
print STDERR "searching for '$username'...\n";
my $users = $initial_response->{'children'};
for(my $n = 0; $n != @$users; ++$n) {
my $user = $users->[$n];
my $attr = $user->{'attr'};
if($user->{'name'} eq 'user' and $attr->{'name'} eq $username) {
my $len = @$users;
print STDERR "OLD USERS: " . (join ',', @$users) . "\n";
print STDERR "removing item $n...\n";
my @new_users = ();
for(my $m = 0; $m != @$users; ++$m) {
push @new_users, $users->[$m] unless $m == $n;
}
@$users = @new_users;
print STDERR "NEW USERS: " . (join ',', @$users) . "\n";
last;
}
}
&sync_lobby();
}
$read_set->remove($sock);
close $sock;
}
sub sync_lobby {
my $diff = &wml::get_diff($initial_response, $old_initial_response, 'gamelist_diff');
while(my $sock = each %lobby_players) {
&send_data($diff, $sock);
}
$old_initial_response = &wml::deep_copy($initial_response);
}
sub received_packet($$) {
my ($sock, $packet) = @_;
printf STDERR "received %d from $sock\n", length $packet;
chop $packet;
my $doc = &wml::read_binary($incoming_schemas{$sock}, $packet);
my $text = &wml::write_text($doc);
print STDERR "RECEIVED: $text";
if(not $socket_user_name{$sock}) {
if(my $login = &wml::has_child($doc, 'login')) {
my $attr = $login->{'attr'};
my $username = $attr->{'username'};
print STDERR "user attempting to log in as \"$username\"...\n";
unless($username =~ /^[A-Za-z0-9_]{1,18}$/) {
&send_error($sock, 'This username is not valid.');
return;
}
foreach my $disallowed (@disallowed_names) {
if($disallowed eq $username) {
&send_error($sock, 'This username is disallowed.');
return;
}
}
if($user_name_socket{$username}) {
&send_error($sock, 'This username is already taken.');
return;
}
print STDERR "log in okay; telling to join lobby\n";
&send_data($join_lobby_response, $sock);
my $users = $initial_response->{'children'};
push @$users, {'name' => 'user', 'children' => [], 'attr' => {'name' => $username, 'available' => 'yes'}};
&send_data($initial_response, $sock);
&sync_lobby();
$lobby_players{$sock} = 1;
$user_name_socket{$username} = $sock;
$socket_user_name{$sock} = $username;
return;
} else {
&send_error($sock, 'You must login first.');
return;
}
} elsif($lobby_players{$sock}) {
if(my $create_game = &wml::has_child($doc, 'create_game')) {
$create_game->{'name'} = 'game';
push @games, &create_game($create_game, $sock);
delete $lobby_players{$sock};
} elsif(my $message = &wml::has_child($doc, 'message')) {
my $attr = $message->{'attr'};
$attr->{'sender'} = $socket_user_name{$sock};
&send_to_lobby($doc, $sock, keys %lobby_players);
} elsif(my $whisper = &wml::has_child($doc, 'whisper')) {
my $attr = $whisper->{'attr'};
$attr->{'sender'} = $socket_user_name{$sock};
my $receiver = $attr->{'receiver'};
&send_data($doc, $user_name_socket{$receiver});
#} elsif(my $query = &wml::has_child($doc, 'query')) {
# my $type = $query->{'attr'}->{'type'};
}
return;
} else {
my $game;
foreach my $g (@games) {
my $players = $g->{'players'};
if($players->{$sock}) {
$game = $g;
last;
}
}
print STDERR "Illegal socket: '$sock'\n" and return unless $game;
if($game->{'owner'} eq $sock and
my $side = &wml::has_child($doc, 'side')) {
if(not &wml::has_child($game->{'level'},'side')) {
#level is not initialized yet, initialize it
my $level = $game->{'level'};
my $level_attr = $level->{'attr'};
my $doc_attr = $doc->{'attr'};
if($side->{'shroud'} ne 'yes') {
$level_attr->{'map_data'} = $doc_attr->{'map_data'};
$level_attr->{'map'} = $doc_attr->{'map'};
}
if(my $era = &wml::has_child($doc, 'era')) {
$level_attr->{'mp_era'} = $era->{'attr'}->{'id'};
}
my @mp_flags = qw(mp_use_map_settings mp_village_gold mp_fog mp_shroud experience_modifier mp_countdown mp_countdown_init_time mp_countdown_turn_bonus mp_countdown_reservoir_time mp_countdown_action_bonus hash);
foreach my $flag (@mp_flags) {
$level_attr->{$flag} = $doc_attr->{$flag};
}
my $games = $gamelist->{'children'};
push @$games, $level;
$game->{'description'} = $level;
$game->{'level'} = $doc;
&sync_lobby();
} else {
}
}
}
}
sub handshake($) {
my ($sock) = @_;
my $buf = '';
my $res = sysread($sock, $buf, 4);
if($res != 4) {
&socket_disconnected($sock);
} else {
my $buf = pack('N', $current_connection_num);
$connection_nums{$sock} = $current_connection_num++;
my $res = syswrite($sock, $buf, 4);
if($res != 4) {
&socket_disconnected($sock);
} else {
delete $pending_handshake{$sock};
&send_data($login_response, $sock);
}
}
}
sub create_game
{
my ($level, $owner) = @_;
my $attr = $level->{'attr'};
$attr->{'id'} = $current_game_id;
{'owner' => $owner, 'members' => [$owner], 'players' => {$owner => 1}, 'level' => $level, 'id' => $current_game_id++};
}
while(1) {
my ($rh_set) = IO::Select->select($read_set, undef, undef, 1000);
foreach my $sock (@$rh_set) {
if($sock == $server_sock) {
my $new_sock = $sock->accept();
&socket_connected($new_sock);
} elsif($pending_handshake{$sock}) {
&handshake($sock);
} else {
my $buffer = '';
if(my $buf = $incoming_bufs{$sock}) {
my $len = $buf->{'length'};
my $new_buf = '';
my $res = sysread($sock, $new_buf, $len - length($buf->{'buf'}));
if(not $res) {
&socket_disconnected($sock);
} else {
$buf->{'buf'} .= $new_buf;
if(length($buf->{'buf'}) == $len) {
$buffer = $buf->{'buf'};
delete $incoming_bufs{$sock};
}
}
} else {
my $header = '';
my $res = sysread($sock, $header, 4);
if($res != 4) {
&socket_disconnected($sock);
} else {
my $len = unpack('N',$header);
print STDERR "receiving $len chars...\n";
my $res = sysread($sock, $buffer, $len);
if($res != $len) {
$incoming_bufs{$sock} = {'length' => $len, 'buf' => $buffer};
$buffer = '';
}
}
}
&received_packet($sock, $buffer) if $buffer;
}
}
}