1 (*

     2  * Hedgewars, a worms-like game

     3  * Copyright (c) 2004, 2005 Andrey Korotaev <unC0Rr@gmail.com>

     4  *

     5  * Distributed under the terms of the BSD-modified licence:

     6  *

     7  * Permission is hereby granted, free of charge, to any person obtaining a copy

     8  * of this software and associated documentation files (the "Software"), to deal

     9  * with the Software without restriction, including without limitation the

    10  * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or

    11  * sell copies of the Software, and to permit persons to whom the Software is

    12  * furnished to do so, subject to the following conditions:

    13  *

    14  * 1. Redistributions of source code must retain the above copyright notice,

    15  *    this list of conditions and the following disclaimer.

    16  * 2. Redistributions in binary form must reproduce the above copyright notice,

    17  *    this list of conditions and the following disclaimer in the documentation

    18  *    and/or other materials provided with the distribution.

    19  * 3. The name of the author may not be used to endorse or promote products

    20  *    derived from this software without specific prior written permission.

    21  *

    22  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED

    23  * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF

    24  * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO

    25  * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

    26  * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,

    27  * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;

    28  * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,

    29  * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR

    30  * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF

    31  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

    32  *)

    33 

    34 unit uNet;

    35 interface

    36 uses WinSock, Messages;

    37 const

    38       IN_NET_PORT  = 46632;

    39       WM_ASYNC_NETEVENT = WM_USER + 7;

    40 

    41 type TCommandHandler = procedure (s: shortstring);

    42 

    43 procedure SplitStream2Commands(var ss: string; Handler: TCommandHandler);

    44 procedure SendSock(Socket: TSocket; s: shortstring);

    45 procedure InitServer;

    46 procedure NetSockEvent(sock, lParam: Longword);

    47 

    48 var hNetListenSockTCP: TSocket = INVALID_SOCKET;

    49 

    50 implementation

    51 uses uServerMisc, uPlayers;

    52 

    53 procedure SplitStream2Commands(var ss: string; Handler: TCommandHandler);

    54 var s: shortstring;

    55 begin

    56 while (Length(ss) > 1)and(Length(ss) > byte(ss[1])) do

    57       begin

    58       s:= copy(ss, 2, byte(ss[1]));

    59       Delete(ss, 1, Succ(byte(ss[1])));

    60       Handler(s)

    61       end;

    62 end;

    63 

    64 procedure SendSock(Socket: TSocket; s: shortstring);

    65 begin

    66 //writeln(socket, '> ', s);

    67 send(Socket, s[0], Succ(byte(s[0])), 0)

    68 end;

    69 

    70 procedure InitServer;

    71 var myaddrTCP: TSockAddrIn;

    72     t: integer;

    73     stWSADataTCPIP : WSADATA;

    74 begin

    75 TryDo(WSAStartup($0101, stWSADataTCPIP) = 0, 'Error on WSAStartup');

    76 hNetListenSockTCP:= socket(AF_INET, SOCK_STREAM, 0);

    77 myaddrTCP.sin_family      := AF_INET;

    78 myaddrTCP.sin_addr.s_addr := $0;

    79 myaddrTCP.sin_port        := htons(IN_NET_PORT);

    80 t:= sizeof(TSockAddrIn);

    81 TryDo(   bind(hNetListenSockTCP, myaddrTCP, t) = 0, 'Error on bind'  );

    82 TryDo( listen(hNetListenSockTCP, 1)            = 0, 'Error on listen');

    83 WSAAsyncSelect(hNetListenSockTCP, hwndMain, WM_ASYNC_NETEVENT, FD_ACCEPT or FD_READ or FD_CLOSE)

    84 end;

    85 

    86 procedure ParseNetCommand(Player: PPlayer; s: shortstring);

    87 begin

    88 case s[1] of

    89      '?': SendSock(player.socket, '!');

    90      'n': begin

    91           player.Name:= copy(s, 2, length(s) - 1);

    92           Writeln(player.socket, ' now is ', player.Name)

    93           end;

    94      'C': SendConfig(player);

    95      'G': SendAll('G');

    96      'T': begin

    97           s[0]:= #5;

    98           s[1]:= 'T';

    99           PLongWord(@s[2])^:= GetTeamCount;

   100           SendSock(player.socket, s)

   101           end;

   102      'K': SelectFirstCFGTeam;

   103      'k': SelectNextCFGTeam;

   104      'h': ConfCurrTeam(s);

   105      else SendAllButOne(Player, s) end

   106 end;

   107 

   108 procedure NetSockEvent(sock, lParam: Longword);

   109 var i: integer;

   110     buf: array[0..255] of byte;

   111     s: shortstring absolute buf;

   112     WSAEvent: word;

   113     player: PPlayer;

   114     sa: TSockAddr;

   115 begin

   116 WSAEvent:= WSAGETSELECTEVENT(lParam);

   117 case WSAEvent of

   118       FD_ACCEPT: begin

   119                  i:= sizeof(sa);

   120                  sock:= accept(hNetListenSockTCP, @sa, @i);

   121                  Writeln('Connected player ', sock, ' from ', inet_ntoa(sa.sin_addr));

   122                  AddPlayer(sock);

   123                  SendSock(sock, 'i')

   124                  end;

   125        FD_CLOSE: begin

   126                  player:= FindPlayerbySock(sock);

   127                  TryDo(player <> nil, 'FD_CLOSE from unknown player??');

   128                  Write('Player quit: ');

   129                  if player.Name[0]=#0 then Writeln('socket ', player.socket)

   130                                       else Writeln(player.Name);

   131                  DeletePlayer(player);

   132                  closesocket(sock);

   133                  end;

   134         FD_READ: begin

   135                  player:= FindPlayerbySock(sock);

   136                  TryDo(player <> nil, 'FD_READ from unknown player??');

   137                  repeat

   138                  i:= recv(sock, buf[1], 255, 0);

   139                  if i > 0 then

   140                     begin

   141                     buf[0]:= i;

   142                     player.inbuf:= player.inbuf + s;

   143                     while (Length(player.inbuf) > 1)and(Length(player.inbuf) > byte(player.inbuf[1])) do

   144                           begin

   145                           ParseNetCommand(player, copy(player.inbuf, 2, byte(player.inbuf[1])));

   146                           Delete(player.inbuf, 1, Succ(byte(player.inbuf[1])))

   147                           end;

   148                     end;

   149                  until i < 1;

   150                  end

   151      end

   152 end;

   153 

   154 

   155 end.