src/game/g_net.pas

   1 (* Copyright (C)  Doom 2D: Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 {$INCLUDE ../shared/a_modes.inc}
  17 unit g_net;
  18
  19 interface
  20
  21 uses
  22   e_log, e_msg, ENet, Classes, MAPDEF{$IFDEF USE_MINIUPNPC}, miniupnpc;{$ELSE};{$ENDIF}
  23
  24 const
  25   NET_PROTOCOL_VER = 180;
  26
  27   NET_MAXCLIENTS = 24;
  28   NET_CHANS = 11;
  29
  30   NET_CHAN_SERVICE = 0;
  31   NET_CHAN_IMPORTANT = 1;
  32   NET_CHAN_GAME = 2;
  33   NET_CHAN_PLAYER = 3;
  34   NET_CHAN_PLAYERPOS = 4;
  35   NET_CHAN_MONSTER = 5;
  36   NET_CHAN_MONSTERPOS = 6;
  37   NET_CHAN_LARGEDATA = 7;
  38   NET_CHAN_CHAT = 8;
  39   NET_CHAN_DOWNLOAD = 9;
  40   NET_CHAN_SHOTS = 10;
  41
  42   NET_NONE = 0;
  43   NET_SERVER = 1;
  44   NET_CLIENT = 2;
  45
  46   NET_BUFSIZE = $FFFF;
  47   NET_PING_PORT = $DF2D;
  48
  49   NET_EVERYONE = -1;
  50
  51   NET_DISC_NONE: enet_uint32 = 0;
  52   NET_DISC_PROTOCOL: enet_uint32 = 1;
  53   NET_DISC_VERSION: enet_uint32 = 2;
  54   NET_DISC_FULL: enet_uint32 = 3;
  55   NET_DISC_KICK: enet_uint32 = 4;
  56   NET_DISC_DOWN: enet_uint32 = 5;
  57   NET_DISC_PASSWORD: enet_uint32 = 6;
  58   NET_DISC_TEMPBAN: enet_uint32 = 7;
  59   NET_DISC_BAN: enet_uint32 = 8;
  60   NET_DISC_MAX: enet_uint32 = 8;
  61
  62   NET_STATE_NONE = 0;
  63   NET_STATE_AUTH = 1;
  64   NET_STATE_GAME = 2;
  65
  66   BANLIST_FILENAME = 'banlist.txt';
  67   NETDUMP_FILENAME = 'netdump';
  68
  69   {$IFDEF FREEBSD}
  70     NilThreadId = nil;
  71   {$ELSE}
  72     NilThreadId = 0;
  73   {$ENDIF}
  74
  75 type
  76   TNetClient = record
  77     ID:      Byte;
  78     Used:    Boolean;
  79     State:   Byte;
  80     Peer:    pENetPeer;
  81     Player:  Word;
  82     RequestedFullUpdate: Boolean;
  83     RCONAuth: Boolean;
  84     Voted:    Boolean;
  85   end;
  86   TBanRecord = record
  87     IP: LongWord;
  88     Perm: Boolean;
  89   end;
  90   pTNetClient = ^TNetClient;
  91
  92   AByte = array of Byte;
  93
  94 var
  95   NetInitDone:     Boolean = False;
  96   NetMode:         Byte = NET_NONE;
  97   NetDump:         Boolean = False;
  98
  99   NetServerName:   string = 'Unnamed Server';
 100   NetPassword:     string = '';
 101   NetPort:         Word = 25666;
 102
 103   NetAllowRCON:    Boolean = False;
 104   NetRCONPassword: string = '';
 105
 106   NetTimeToUpdate:   Cardinal = 0;
 107   NetTimeToReliable: Cardinal = 0;
 108   NetTimeToMaster:   Cardinal = 0;
 109
 110   NetHost:       pENetHost = nil;
 111   NetPeer:       pENetPeer = nil;
 112   NetEvent:      ENetEvent;
 113   NetAddr:       ENetAddress;
 114
 115   NetPongAddr:   ENetAddress;
 116   NetPongSock:   ENetSocket = ENET_SOCKET_NULL;
 117
 118   NetUseMaster: Boolean = True;
 119   NetSlistAddr: ENetAddress;
 120   NetSlistIP:   string = 'mpms.doom2d.org';
 121   NetSlistPort: Word = 25665;
 122
 123   NetClientIP:   string = '127.0.0.1';
 124   NetClientPort: Word   = 25666;
 125
 126   NetIn, NetOut: TMsg;
 127
 128   NetClients:     array of TNetClient;
 129   NetClientCount: Byte = 0;
 130   NetMaxClients:  Byte = 255;
 131   NetBannedHosts: array of TBanRecord;
 132
 133   NetState:      Integer = NET_STATE_NONE;
 134
 135   NetMyID:       Integer = -1;
 136   NetPlrUID1:    Integer = -1;
 137   NetPlrUID2:    Integer = -1;
 138
 139   NetInterpLevel: Integer = 1;
 140   NetUpdateRate:  Cardinal = 0;  // as soon as possible
 141   NetRelupdRate:  Cardinal = 18; // around two times a second
 142   NetMasterRate:  Cardinal = 60000;
 143
 144   NetForcePlayerUpdate: Boolean = False;
 145   NetPredictSelf:       Boolean = True;
 146   NetForwardPorts:      Boolean = False;
 147
 148   NetGotEverything: Boolean = False;
 149   NetGotKeys:       Boolean = False;
 150
 151 {$IFDEF USE_MINIUPNPC}
 152   NetPortForwarded: Word = 0;
 153   NetPongForwarded: Boolean = False;
 154   NetIGDControl: AnsiString;
 155   NetIGDService: TURLStr;
 156 {$ENDIF}
 157
 158   NetPortThread: TThreadID = NilThreadId;
 159
 160   NetDumpFile: TStream;
 161
 162 function  g_Net_Init(): Boolean;
 163 procedure g_Net_Cleanup();
 164 procedure g_Net_Free();
 165 procedure g_Net_Flush();
 166
 167 function  g_Net_Host(IPAddr: LongWord; Port: enet_uint16; MaxClients: Cardinal = 16): Boolean;
 168 procedure g_Net_Host_Die();
 169 procedure g_Net_Host_Send(ID: Integer; Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
 170 function  g_Net_Host_Update(): enet_size_t;
 171
 172 function  g_Net_Connect(IP: string; Port: enet_uint16): Boolean;
 173 procedure g_Net_Disconnect(Forced: Boolean = False);
 174 procedure g_Net_Client_Send(Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
 175 function  g_Net_Client_Update(): enet_size_t;
 176 function  g_Net_Client_UpdateWhileLoading(): enet_size_t;
 177
 178 function  g_Net_Client_ByName(Name: string): pTNetClient;
 179 function  g_Net_Client_ByPlayer(PID: Word): pTNetClient;
 180 function  g_Net_ClientName_ByID(ID: Integer): string;
 181
 182 procedure g_Net_SendData(Data: AByte; peer: pENetPeer; Reliable: Boolean; Chan: Byte = NET_CHAN_DOWNLOAD);
 183 function  g_Net_Wait_Event(msgId: Word): TMemoryStream;
 184
 185 function  IpToStr(IP: LongWord): string;
 186 function  StrToIp(IPstr: string; var IP: LongWord): Boolean;
 187
 188 function  g_Net_IsHostBanned(IP: LongWord; Perm: Boolean = False): Boolean;
 189 procedure g_Net_BanHost(IP: LongWord; Perm: Boolean = True); overload;
 190 procedure g_Net_BanHost(IP: string; Perm: Boolean = True); overload;
 191 function  g_Net_UnbanHost(IP: string): Boolean; overload;
 192 function  g_Net_UnbanHost(IP: LongWord): Boolean; overload;
 193 procedure g_Net_UnbanNonPermHosts();
 194 procedure g_Net_SaveBanList();
 195
 196 procedure g_Net_DumpStart();
 197 procedure g_Net_DumpSendBuffer();
 198 procedure g_Net_DumpRecvBuffer(Buf: penet_uint8; Len: LongWord);
 199 procedure g_Net_DumpEnd();
 200
 201 function g_Net_ForwardPorts(ForwardPongPort: Boolean = True): Boolean;
 202 procedure g_Net_UnforwardPorts();
 203
 204 implementation
 205
 206 uses
 207   SysUtils,
 208   e_input, g_nethandler, g_netmsg, g_netmaster, g_player, g_window, g_console,
 209   g_main, g_game, g_language, g_weapons, utils, ctypes;
 210
 211 var
 212   g_Net_DownloadTimeout: Single;
 213
 214
 215 { /// SERVICE FUNCTIONS /// }
 216
 217
 218 function g_Net_FindSlot(): Integer;
 219 var
 220   I: Integer;
 221   F: Boolean;
 222   N, C: Integer;
 223 begin
 224   N := -1;
 225   F := False;
 226   C := 0;
 227   for I := Low(NetClients) to High(NetClients) do
 228   begin
 229     if NetClients[I].Used then
 230       Inc(C)
 231     else
 232       if not F then
 233       begin
 234         F := True;
 235         N := I;
 236       end;
 237   end;
 238   if C >= NetMaxClients then
 239   begin
 240     Result := -1;
 241     Exit;
 242   end;
 243
 244   if not F then
 245   begin
 246     if (Length(NetClients) >= NetMaxClients) then
 247       N := -1
 248     else
 249     begin
 250       SetLength(NetClients, Length(NetClients) + 1);
 251       N := High(NetClients);
 252     end;
 253   end;
 254
 255   if N >= 0 then
 256   begin
 257     NetClients[N].Used := True;
 258     NetClients[N].ID := N;
 259     NetClients[N].RequestedFullUpdate := False;
 260     NetClients[N].RCONAuth := False;
 261     NetClients[N].Voted := False;
 262     NetClients[N].Player := 0;
 263   end;
 264
 265   Result := N;
 266 end;
 267
 268 function g_Net_Init(): Boolean;
 269 var
 270   F: TextFile;
 271   IPstr: string;
 272   IP: LongWord;
 273 begin
 274   NetIn.Clear();
 275   NetOut.Clear();
 276   SetLength(NetClients, 0);
 277   NetPeer := nil;
 278   NetHost := nil;
 279   NetMyID := -1;
 280   NetPlrUID1 := -1;
 281   NetPlrUID2 := -1;
 282   NetAddr.port := 25666;
 283   SetLength(NetBannedHosts, 0);
 284   if FileExists(DataDir + BANLIST_FILENAME) then
 285   begin
 286     Assign(F, DataDir + BANLIST_FILENAME);
 287     Reset(F);
 288     while not EOF(F) do
 289     begin
 290       Readln(F, IPstr);
 291       if StrToIp(IPstr, IP) then
 292         g_Net_BanHost(IP);
 293     end;
 294     CloseFile(F);
 295     g_Net_SaveBanList();
 296   end;
 297
 298   Result := (enet_initialize() = 0);
 299 end;
 300
 301 procedure g_Net_Flush();
 302 begin
 303   enet_host_flush(NetHost);
 304 end;
 305
 306 procedure g_Net_Cleanup();
 307 begin
 308   NetIn.Clear();
 309   NetOut.Clear();
 310
 311   SetLength(NetClients, 0);
 312   NetClientCount := 0;
 313
 314   NetPeer := nil;
 315   NetHost := nil;
 316   NetMPeer := nil;
 317   NetMHost := nil;
 318   NetMyID := -1;
 319   NetPlrUID1 := -1;
 320   NetPlrUID2 := -1;
 321   NetState := NET_STATE_NONE;
 322
 323   NetPongSock := ENET_SOCKET_NULL;
 324
 325   NetTimeToMaster := 0;
 326   NetTimeToUpdate := 0;
 327   NetTimeToReliable := 0;
 328
 329   NetMode := NET_NONE;
 330
 331   if NetPortThread <> NilThreadId then
 332     WaitForThreadTerminate(NetPortThread, 66666);
 333
 334   NetPortThread := NilThreadId;
 335   g_Net_UnforwardPorts();
 336
 337   if NetDump then
 338     g_Net_DumpEnd();
 339 end;
 340
 341 procedure g_Net_Free();
 342 begin
 343   g_Net_Cleanup();
 344
 345   enet_deinitialize();
 346   NetInitDone := False;
 347 end;
 348
 349
 350 { /// SERVER FUNCTIONS /// }
 351
 352
 353 function ForwardThread(Param: Pointer): PtrInt;
 354 begin
 355   Result := 0;
 356   if not g_Net_ForwardPorts() then Result := -1;
 357 end;
 358
 359 function g_Net_Host(IPAddr: LongWord; Port: enet_uint16; MaxClients: Cardinal = 16): Boolean;
 360 begin
 361   if NetMode <> NET_NONE then
 362   begin
 363     g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_INGAME]);
 364     Result := False;
 365     Exit;
 366   end;
 367
 368   Result := True;
 369
 370   g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST], [Port]));
 371   if not NetInitDone then
 372   begin
 373     if (not g_Net_Init()) then
 374     begin
 375       g_Console_Add(_lc[I_NET_MSG_FERROR] + _lc[I_NET_ERR_ENET]);
 376       Result := False;
 377       Exit;
 378     end
 379     else
 380       NetInitDone := True;
 381   end;
 382
 383   NetAddr.host := IPAddr;
 384   NetAddr.port := Port;
 385
 386   if NetForwardPorts then NetPortThread := BeginThread(ForwardThread);
 387
 388   NetHost := enet_host_create(@NetAddr, NET_MAXCLIENTS, NET_CHANS, 0, 0);
 389
 390   if (NetHost = nil) then
 391   begin
 392     g_Console_Add(_lc[I_NET_MSG_ERROR] + Format(_lc[I_NET_ERR_HOST], [Port]));
 393     Result := False;
 394     g_Net_Cleanup;
 395     Exit;
 396   end;
 397
 398   NetPongSock := enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM);
 399   if NetPongSock <> ENET_SOCKET_NULL then
 400   begin
 401     NetPongAddr.host := IPAddr;
 402     NetPongAddr.port := NET_PING_PORT;
 403     if enet_socket_bind(NetPongSock, @NetPongAddr) < 0 then
 404     begin
 405       enet_socket_destroy(NetPongSock);
 406       NetPongSock := ENET_SOCKET_NULL;
 407     end
 408     else
 409       enet_socket_set_option(NetPongSock, ENET_SOCKOPT_NONBLOCK, 1);
 410   end;
 411
 412   NetMode := NET_SERVER;
 413   NetOut.Clear();
 414
 415   if NetDump then
 416     g_Net_DumpStart();
 417 end;
 418
 419 procedure g_Net_Host_Die();
 420 var
 421   I: Integer;
 422 begin
 423   if NetMode <> NET_SERVER then Exit;
 424
 425   g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_DISCALL]);
 426   for I := 0 to High(NetClients) do
 427     if NetClients[I].Used then
 428       enet_peer_disconnect(NetClients[I].Peer, NET_DISC_DOWN);
 429
 430   while enet_host_service(NetHost, @NetEvent, 1000) > 0 do
 431     if NetEvent.kind = ENET_EVENT_TYPE_RECEIVE then
 432       enet_packet_destroy(NetEvent.packet);
 433
 434   for I := 0 to High(NetClients) do
 435     if NetClients[I].Used then
 436     begin
 437       FreeMemory(NetClients[I].Peer^.data);
 438       NetClients[I].Peer^.data := nil;
 439       enet_peer_reset(NetClients[I].Peer);
 440       NetClients[I].Peer := nil;
 441       NetClients[I].Used := False;
 442     end;
 443
 444   if (NetMPeer <> nil) and (NetMHost <> nil) then g_Net_Slist_Disconnect;
 445   if NetPongSock <> ENET_SOCKET_NULL then
 446     enet_socket_destroy(NetPongSock);
 447
 448   g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_DIE]);
 449   enet_host_destroy(NetHost);
 450
 451   NetMode := NET_NONE;
 452
 453   g_Net_Cleanup;
 454   e_WriteLog('NET: Server stopped', TMsgType.Notify);
 455 end;
 456
 457
 458 procedure g_Net_Host_Send(ID: Integer; Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
 459 var
 460   P: pENetPacket;
 461   F: enet_uint32;
 462 begin
 463   if (Reliable) then
 464     F := LongWord(ENET_PACKET_FLAG_RELIABLE)
 465   else
 466     F := 0;
 467
 468   if (ID >= 0) then
 469   begin
 470     if ID > High(NetClients) then Exit;
 471     if NetClients[ID].Peer = nil then Exit;
 472
 473     P := enet_packet_create(NetOut.Data, NetOut.CurSize, F);
 474     if not Assigned(P) then Exit;
 475
 476     enet_peer_send(NetClients[ID].Peer, Chan, P);
 477   end
 478   else
 479   begin
 480     P := enet_packet_create(NetOut.Data, NetOut.CurSize, F);
 481     if not Assigned(P) then Exit;
 482
 483     enet_host_broadcast(NetHost, Chan, P);
 484   end;
 485
 486   if NetDump then g_Net_DumpSendBuffer();
 487   g_Net_Flush();
 488   NetOut.Clear();
 489 end;
 490
 491 procedure g_Net_Host_CheckPings();
 492 var
 493   ClAddr: ENetAddress;
 494   Buf: ENetBuffer;
 495   Len: Integer;
 496   ClTime: Int64;
 497   Ping: array [0..9] of Byte;
 498   NPl: Byte;
 499 begin
 500   if NetPongSock = ENET_SOCKET_NULL then Exit;
 501
 502   Buf.data := Addr(Ping[0]);
 503   Buf.dataLength := 2+8;
 504
 505   Ping[0] := 0;
 506
 507   Len := enet_socket_receive(NetPongSock, @ClAddr, @Buf, 1);
 508   if Len < 0 then Exit;
 509
 510   if (Ping[0] = Ord('D')) and (Ping[1] = Ord('F')) then
 511   begin
 512     ClTime := Int64(Addr(Ping[2])^);
 513
 514     NetOut.Clear();
 515     NetOut.Write(Byte(Ord('D')));
 516     NetOut.Write(Byte(Ord('F')));
 517     NetOut.Write(NetPort);
 518     NetOut.Write(ClTime);
 519     g_Net_Slist_WriteInfo();
 520     NPl := 0;
 521     if gPlayer1 <> nil then Inc(NPl);
 522     if gPlayer2 <> nil then Inc(NPl);
 523     NetOut.Write(NPl);
 524     NetOut.Write(gNumBots);
 525
 526     Buf.data := NetOut.Data;
 527     Buf.dataLength := NetOut.CurSize;
 528     enet_socket_send(NetPongSock, @ClAddr, @Buf, 1);
 529
 530     NetOut.Clear();
 531   end;
 532 end;
 533
 534 function g_Net_Host_Update(): enet_size_t;
 535 var
 536   IP: string;
 537   Port: Word;
 538   ID: Integer;
 539   TC: pTNetClient;
 540   TP: TPlayer;
 541 begin
 542   IP := '';
 543   Result := 0;
 544
 545   if NetUseMaster then
 546     g_Net_Slist_Check;
 547   g_Net_Host_CheckPings;
 548
 549   while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
 550   begin
 551     case (NetEvent.kind) of
 552       ENET_EVENT_TYPE_CONNECT:
 553       begin
 554         IP := IpToStr(NetEvent.Peer^.address.host);
 555         Port := NetEvent.Peer^.address.port;
 556         g_Console_Add(_lc[I_NET_MSG] +
 557           Format(_lc[I_NET_MSG_HOST_CONN], [IP, Port]));
 558
 559         if (NetEvent.data <> NET_PROTOCOL_VER) then
 560         begin
 561           g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_REJECT] +
 562             _lc[I_NET_DISC_PROTOCOL]);
 563           NetEvent.peer^.data := GetMemory(SizeOf(Byte));
 564           Byte(NetEvent.peer^.data^) := 255;
 565           enet_peer_disconnect(NetEvent.peer, NET_DISC_PROTOCOL);
 566           enet_host_flush(NetHost);
 567           Exit;
 568         end;
 569
 570         ID := g_Net_FindSlot();
 571
 572         if ID < 0 then
 573         begin
 574           g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_REJECT] +
 575             _lc[I_NET_DISC_FULL]);
 576           NetEvent.Peer^.data := GetMemory(SizeOf(Byte));
 577           Byte(NetEvent.peer^.data^) := 255;
 578           enet_peer_disconnect(NetEvent.peer, NET_DISC_FULL);
 579           enet_host_flush(NetHost);
 580           Exit;
 581         end;
 582
 583         NetClients[ID].Peer := NetEvent.peer;
 584         NetClients[ID].Peer^.data := GetMemory(SizeOf(Byte));
 585         Byte(NetClients[ID].Peer^.data^) := ID;
 586         NetClients[ID].State := NET_STATE_AUTH;
 587         NetClients[ID].RCONAuth := False;
 588
 589         enet_peer_timeout(NetEvent.peer, ENET_PEER_TIMEOUT_LIMIT * 2, ENET_PEER_TIMEOUT_MINIMUM * 2, ENET_PEER_TIMEOUT_MAXIMUM * 2);
 590
 591         Inc(NetClientCount);
 592         g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST_ADD], [ID]));
 593       end;
 594
 595       ENET_EVENT_TYPE_RECEIVE:
 596       begin
 597         ID := Byte(NetEvent.peer^.data^);
 598         if ID > High(NetClients) then Exit;
 599         TC := @NetClients[ID];
 600
 601         if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
 602         g_Net_HostMsgHandler(TC, NetEvent.packet);
 603       end;
 604
 605       ENET_EVENT_TYPE_DISCONNECT:
 606       begin
 607         ID := Byte(NetEvent.peer^.data^);
 608         if ID > High(NetClients) then Exit;
 609         TC := @NetClients[ID];
 610         if TC = nil then Exit;
 611
 612         if not (TC^.Used) then Exit;
 613
 614         TP := g_Player_Get(TC^.Player);
 615
 616         if TP <> nil then
 617         begin
 618           TP.Lives := 0;
 619           TP.Kill(K_SIMPLEKILL, 0, HIT_DISCON);
 620           g_Console_Add(Format(_lc[I_PLAYER_LEAVE], [TP.Name]), True);
 621           e_WriteLog('NET: Client ' + TP.Name + ' [' + IntToStr(ID) + '] disconnected.', TMsgType.Notify);
 622           g_Player_Remove(TP.UID);
 623         end;
 624
 625         TC^.Used := False;
 626         TC^.State := NET_STATE_NONE;
 627         TC^.Peer := nil;
 628         TC^.Player := 0;
 629         TC^.RequestedFullUpdate := False;
 630
 631         FreeMemory(NetEvent.peer^.data);
 632         NetEvent.peer^.data := nil;
 633         g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST_DISC], [ID]));
 634         Dec(NetClientCount);
 635
 636         if NetUseMaster then g_Net_Slist_Update;
 637       end;
 638     end;
 639   end;
 640 end;
 641
 642
 643 { /// CLIENT FUNCTIONS /// }
 644
 645
 646 procedure g_Net_Disconnect(Forced: Boolean = False);
 647 begin
 648   if NetMode <> NET_CLIENT then Exit;
 649   if (NetHost = nil) or (NetPeer = nil) then Exit;
 650
 651   if not Forced then
 652   begin
 653     enet_peer_disconnect(NetPeer, NET_DISC_NONE);
 654
 655     while (enet_host_service(NetHost, @NetEvent, 1500) > 0) do
 656     begin
 657       if (NetEvent.kind = ENET_EVENT_TYPE_DISCONNECT) then
 658       begin
 659         NetPeer := nil;
 660         break;
 661       end;
 662
 663       if (NetEvent.kind = ENET_EVENT_TYPE_RECEIVE) then
 664         enet_packet_destroy(NetEvent.packet);
 665     end;
 666
 667     if NetPeer <> nil then
 668     begin
 669       enet_peer_reset(NetPeer);
 670       NetPeer := nil;
 671     end;
 672   end
 673   else
 674   begin
 675     e_WriteLog('NET: Kicked from server: ' + IntToStr(NetEvent.data), TMsgType.Notify);
 676     if (NetEvent.data <= NET_DISC_MAX) then
 677       g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_KICK] +
 678         _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + NetEvent.data)], True);
 679   end;
 680
 681   if NetHost <> nil then
 682   begin
 683     enet_host_destroy(NetHost);
 684     NetHost := nil;
 685   end;
 686   g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_CLIENT_DISC]);
 687
 688   g_Net_Cleanup;
 689   e_WriteLog('NET: Disconnected', TMsgType.Notify);
 690 end;
 691
 692 procedure g_Net_Client_Send(Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
 693 var
 694   P: pENetPacket;
 695   F: enet_uint32;
 696 begin
 697   if (Reliable) then
 698     F := LongWord(ENET_PACKET_FLAG_RELIABLE)
 699   else
 700     F := 0;
 701
 702   P := enet_packet_create(NetOut.Data, NetOut.CurSize, F);
 703   if not Assigned(P) then Exit;
 704
 705   enet_peer_send(NetPeer, Chan, P);
 706   if NetDump then g_Net_DumpSendBuffer();
 707   g_Net_Flush();
 708   NetOut.Clear();
 709 end;
 710
 711 function g_Net_Client_Update(): enet_size_t;
 712 begin
 713   Result := 0;
 714   while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
 715   begin
 716     case NetEvent.kind of
 717       ENET_EVENT_TYPE_RECEIVE:
 718       begin
 719         if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
 720         g_Net_ClientMsgHandler(NetEvent.packet);
 721       end;
 722
 723       ENET_EVENT_TYPE_DISCONNECT:
 724       begin
 725         g_Net_Disconnect(True);
 726         Result := 1;
 727         Exit;
 728       end;
 729     end;
 730   end
 731 end;
 732
 733 function g_Net_Client_UpdateWhileLoading(): enet_size_t;
 734 begin
 735   Result := 0;
 736   while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
 737   begin
 738     case NetEvent.kind of
 739       ENET_EVENT_TYPE_RECEIVE:
 740       begin
 741         if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
 742         g_Net_ClientLightMsgHandler(NetEvent.packet);
 743       end;
 744
 745       ENET_EVENT_TYPE_DISCONNECT:
 746       begin
 747         g_Net_Disconnect(True);
 748         Result := 1;
 749         Exit;
 750       end;
 751     end;
 752   end;
 753   g_Net_Flush();
 754 end;
 755
 756 function g_Net_Connect(IP: string; Port: enet_uint16): Boolean;
 757 var
 758   OuterLoop: Boolean;
 759 begin
 760   if NetMode <> NET_NONE then
 761   begin
 762     g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_ERR_INGAME], True);
 763     Result := False;
 764     Exit;
 765   end;
 766
 767   Result := True;
 768
 769   g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_CLIENT_CONN],
 770     [IP, Port]));
 771   if not NetInitDone then
 772   begin
 773     if (not g_Net_Init()) then
 774     begin
 775       g_Console_Add(_lc[I_NET_MSG_FERROR] + _lc[I_NET_ERR_ENET], True);
 776       Result := False;
 777       Exit;
 778     end
 779     else
 780       NetInitDone := True;
 781   end;
 782
 783   NetHost := enet_host_create(nil, 1, NET_CHANS, 0, 0);
 784
 785   if (NetHost = nil) then
 786   begin
 787     g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT], True);
 788     g_Net_Cleanup;
 789     Result := False;
 790     Exit;
 791   end;
 792
 793   enet_address_set_host(@NetAddr, PChar(Addr(IP[1])));
 794   NetAddr.port := Port;
 795
 796   NetPeer := enet_host_connect(NetHost, @NetAddr, NET_CHANS, NET_PROTOCOL_VER);
 797
 798   if (NetPeer = nil) then
 799   begin
 800     g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT], True);
 801     enet_host_destroy(NetHost);
 802     g_Net_Cleanup;
 803     Result := False;
 804     Exit;
 805   end;
 806
 807   OuterLoop := True;
 808   while OuterLoop do
 809   begin
 810     while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
 811     begin
 812       if (NetEvent.kind = ENET_EVENT_TYPE_CONNECT) then
 813       begin
 814         g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_CLIENT_DONE]);
 815         NetMode := NET_CLIENT;
 816         NetOut.Clear();
 817         enet_peer_timeout(NetPeer, ENET_PEER_TIMEOUT_LIMIT * 2, ENET_PEER_TIMEOUT_MINIMUM * 2, ENET_PEER_TIMEOUT_MAXIMUM * 2);
 818         NetClientIP := IP;
 819         NetClientPort := Port;
 820         if NetDump then
 821           g_Net_DumpStart();
 822         Exit;
 823       end;
 824     end;
 825
 826     ProcessLoading(true);
 827
 828     if e_KeyPressed(IK_SPACE) or e_KeyPressed(IK_ESCAPE) or e_KeyPressed(VK_ESCAPE) or
 829        e_KeyPressed(JOY0_JUMP) or e_KeyPressed(JOY1_JUMP) or e_KeyPressed(JOY2_JUMP) or e_KeyPressed(JOY3_JUMP) then
 830       OuterLoop := False;
 831   end;
 832
 833   g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_TIMEOUT], True);
 834   if NetPeer <> nil then enet_peer_reset(NetPeer);
 835   if NetHost <> nil then
 836   begin
 837     enet_host_destroy(NetHost);
 838     NetHost := nil;
 839   end;
 840   g_Net_Cleanup();
 841   Result := False;
 842 end;
 843
 844 function IpToStr(IP: LongWord): string;
 845 var
 846   Ptr: Pointer;
 847 begin
 848   Ptr := Addr(IP);
 849   Result :=          IntToStr(PByte(Ptr + 0)^) + '.';
 850   Result := Result + IntToStr(PByte(Ptr + 1)^) + '.';
 851   Result := Result + IntToStr(PByte(Ptr + 2)^) + '.';
 852   Result := Result + IntToStr(PByte(Ptr + 3)^);
 853 end;
 854
 855 function StrToIp(IPstr: string; var IP: LongWord): Boolean;
 856 var
 857   EAddr: ENetAddress;
 858 begin
 859   Result := enet_address_set_host(@EAddr, PChar(@IPstr[1])) = 0;
 860   IP := EAddr.host;
 861 end;
 862
 863 function g_Net_Client_ByName(Name: string): pTNetClient;
 864 var
 865   a: Integer;
 866   pl: TPlayer;
 867 begin
 868   Result := nil;
 869   for a := Low(NetClients) to High(NetClients) do
 870     if (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
 871     begin
 872       pl := g_Player_Get(NetClients[a].Player);
 873       if pl = nil then continue;
 874       if Copy(LowerCase(pl.Name), 1, Length(Name)) <> LowerCase(Name) then continue;
 875       if NetClients[a].Peer <> nil then
 876       begin
 877         Result := @NetClients[a];
 878         Exit;
 879       end;
 880     end;
 881 end;
 882
 883 function g_Net_Client_ByPlayer(PID: Word): pTNetClient;
 884 var
 885   a: Integer;
 886 begin
 887   Result := nil;
 888   for a := Low(NetClients) to High(NetClients) do
 889     if (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
 890       if NetClients[a].Player = PID then
 891       begin
 892         Result := @NetClients[a];
 893         Exit;
 894       end;
 895 end;
 896
 897 function g_Net_ClientName_ByID(ID: Integer): string;
 898 var
 899   a: Integer;
 900   pl: TPlayer;
 901 begin
 902   Result := '';
 903   if ID = NET_EVERYONE then
 904     Exit;
 905   for a := Low(NetClients) to High(NetClients) do
 906     if (NetClients[a].ID = ID) and (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
 907     begin
 908       pl := g_Player_Get(NetClients[a].Player);
 909       if pl = nil then Exit;
 910       Result := pl.Name;
 911     end;
 912 end;
 913
 914 procedure g_Net_SendData(Data: AByte; peer: pENetPeer; Reliable: Boolean; Chan: Byte = NET_CHAN_DOWNLOAD);
 915 var
 916   P: pENetPacket;
 917   F: enet_uint32;
 918   dataLength: Cardinal;
 919 begin
 920   dataLength := Length(Data);
 921
 922   if (Reliable) then
 923     F := LongWord(ENET_PACKET_FLAG_RELIABLE)
 924   else
 925     F := 0;
 926
 927   if (peer <> nil) then
 928   begin
 929     P := enet_packet_create(@Data[0], dataLength, F);
 930     if not Assigned(P) then Exit;
 931     enet_peer_send(peer, Chan, P);
 932   end
 933   else
 934   begin
 935     P := enet_packet_create(@Data[0], dataLength, F);
 936     if not Assigned(P) then Exit;
 937     enet_host_broadcast(NetHost, Chan, P);
 938   end;
 939
 940   enet_host_flush(NetHost);
 941 end;
 942
 943 function UserRequestExit: Boolean;
 944 begin
 945   Result := e_KeyPressed(IK_SPACE) or
 946             e_KeyPressed(IK_ESCAPE) or
 947             e_KeyPressed(VK_ESCAPE) or
 948             e_KeyPressed(JOY0_JUMP) or
 949             e_KeyPressed(JOY1_JUMP) or
 950             e_KeyPressed(JOY2_JUMP) or
 951             e_KeyPressed(JOY3_JUMP)
 952 end;
 953
 954 function g_Net_Wait_Event(msgId: Word): TMemoryStream;
 955   var
 956     ev: ENetEvent;
 957     rMsgId: Byte;
 958     Ptr: Pointer;
 959     stream: TMemoryStream;
 960     status: cint;
 961 begin
 962   FillChar(ev, SizeOf(ev), 0);
 963   stream := nil;
 964   repeat
 965     status := enet_host_service(NetHost, @ev, Trunc(g_Net_DownloadTimeout * 1000));
 966     if status > 0 then
 967     begin
 968       case ev.kind of
 969         ENET_EVENT_TYPE_RECEIVE:
 970           begin
 971             Ptr := ev.packet^.data;
 972             rMsgId := Byte(Ptr^);
 973             if rMsgId = msgId then
 974             begin
 975               stream := TMemoryStream.Create;
 976               stream.SetSize(ev.packet^.dataLength);
 977               stream.WriteBuffer(Ptr^, ev.packet^.dataLength);
 978               stream.Seek(0, soFromBeginning);
 979               status := 1 (* received *)
 980             end
 981             else
 982             begin
 983               (* looks that game state always received, so ignore it *)
 984               e_LogWritefln('g_Net_Wait_Event(%s): skip message %s', [msgId, rMsgId]);
 985               status := 2 (* continue *)
 986             end
 987           end;
 988       ENET_EVENT_TYPE_DISCONNECT:
 989         begin
 990           if (ev.data <= NET_DISC_MAX) then
 991             g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' ' + _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + ev.data)], True);
 992           status := -2 (* error: disconnected *)
 993         end;
 994       else
 995         g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' unknown ENet event ' + IntToStr(Ord(ev.kind)), True);
 996         status := -3 (* error: unknown event *)
 997       end;
 998       enet_packet_destroy(ev.packet)
 999     end
1000     else
1001     begin
1002       g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' timeout reached', True);
1003       status := 0 (* error: timeout *)
1004     end;
1005     ProcessLoading(true);
1006   until (status <> 2) or UserRequestExit();
1007   Result := stream
1008 end;
1009
1010 function g_Net_IsHostBanned(IP: LongWord; Perm: Boolean = False): Boolean;
1011 var
1012   I: Integer;
1013 begin
1014   Result := False;
1015   if NetBannedHosts = nil then
1016     Exit;
1017   for I := 0 to High(NetBannedHosts) do
1018     if (NetBannedHosts[I].IP = IP) and ((not Perm) or (NetBannedHosts[I].Perm)) then
1019     begin
1020       Result := True;
1021       break;
1022     end;
1023 end;
1024
1025 procedure g_Net_BanHost(IP: LongWord; Perm: Boolean = True); overload;
1026 var
1027   I, P: Integer;
1028 begin
1029   if IP = 0 then
1030     Exit;
1031   if g_Net_IsHostBanned(IP, Perm) then
1032     Exit;
1033
1034   P := -1;
1035   for I := Low(NetBannedHosts) to High(NetBannedHosts) do
1036     if NetBannedHosts[I].IP = 0 then
1037     begin
1038       P := I;
1039       break;
1040     end;
1041
1042   if P < 0 then
1043   begin
1044     SetLength(NetBannedHosts, Length(NetBannedHosts) + 1);
1045     P := High(NetBannedHosts);
1046   end;
1047
1048   NetBannedHosts[P].IP := IP;
1049   NetBannedHosts[P].Perm := Perm;
1050 end;
1051
1052 procedure g_Net_BanHost(IP: string; Perm: Boolean = True); overload;
1053 var
1054   a: LongWord;
1055   b: Boolean;
1056 begin
1057   b := StrToIp(IP, a);
1058   if b then
1059     g_Net_BanHost(a, Perm);
1060 end;
1061
1062 procedure g_Net_UnbanNonPermHosts();
1063 var
1064   I: Integer;
1065 begin
1066   if NetBannedHosts = nil then
1067     Exit;
1068   for I := Low(NetBannedHosts) to High(NetBannedHosts) do
1069     if (NetBannedHosts[I].IP > 0) and not NetBannedHosts[I].Perm then
1070     begin
1071       NetBannedHosts[I].IP := 0;
1072       NetBannedHosts[I].Perm := True;
1073     end;
1074 end;
1075
1076 function g_Net_UnbanHost(IP: string): Boolean; overload;
1077 var
1078   a: LongWord;
1079 begin
1080   Result := StrToIp(IP, a);
1081   if Result then
1082     Result := g_Net_UnbanHost(a);
1083 end;
1084
1085 function g_Net_UnbanHost(IP: LongWord): Boolean; overload;
1086 var
1087   I: Integer;
1088 begin
1089   Result := False;
1090   if IP = 0 then
1091     Exit;
1092   if NetBannedHosts = nil then
1093     Exit;
1094   for I := 0 to High(NetBannedHosts) do
1095     if NetBannedHosts[I].IP = IP then
1096     begin
1097       NetBannedHosts[I].IP := 0;
1098       NetBannedHosts[I].Perm := True;
1099       Result := True;
1100       // no break here to clear all bans of this host, perm and non-perm
1101     end;
1102 end;
1103
1104 procedure g_Net_SaveBanList();
1105 var
1106   F: TextFile;
1107   I: Integer;
1108 begin
1109   Assign(F, DataDir + BANLIST_FILENAME);
1110   Rewrite(F);
1111   if NetBannedHosts <> nil then
1112     for I := 0 to High(NetBannedHosts) do
1113       if NetBannedHosts[I].Perm and (NetBannedHosts[I].IP > 0) then
1114         Writeln(F, IpToStr(NetBannedHosts[I].IP));
1115   CloseFile(F);
1116 end;
1117
1118 procedure g_Net_DumpStart();
1119 begin
1120   if NetMode = NET_SERVER then
1121     NetDumpFile := createDiskFile(NETDUMP_FILENAME + '_server')
1122   else
1123     NetDumpFile := createDiskFile(NETDUMP_FILENAME + '_client');
1124 end;
1125
1126 procedure g_Net_DumpSendBuffer();
1127 begin
1128   writeInt(NetDumpFile, gTime);
1129   writeInt(NetDumpFile, LongWord(NetOut.CurSize));
1130   writeInt(NetDumpFile, Byte(1));
1131   NetDumpFile.WriteBuffer(NetOut.Data^, NetOut.CurSize);
1132 end;
1133
1134 procedure g_Net_DumpRecvBuffer(Buf: penet_uint8; Len: LongWord);
1135 begin
1136   if (Buf = nil) or (Len = 0) then Exit;
1137   writeInt(NetDumpFile, gTime);
1138   writeInt(NetDumpFile, Len);
1139   writeInt(NetDumpFile, Byte(0));
1140   NetDumpFile.WriteBuffer(Buf^, Len);
1141 end;
1142
1143 procedure g_Net_DumpEnd();
1144 begin
1145   NetDumpFile.Free();
1146   NetDumpFile := nil;
1147 end;
1148
1149 function g_Net_ForwardPorts(ForwardPongPort: Boolean = True): Boolean;
1150 {$IFDEF USE_MINIUPNPC}
1151 var
1152   DevList: PUPNPDev;
1153   Urls: TUPNPUrls;
1154   Data: TIGDDatas;
1155   LanAddr: array [0..255] of Char;
1156   StrPort: AnsiString;
1157   Err, I: Integer;
1158 begin
1159   Result := False;
1160
1161   if NetPortForwarded = NetPort then
1162   begin
1163     Result := True;
1164     exit;
1165   end;
1166
1167   NetPongForwarded := False;
1168   NetPortForwarded := 0;
1169
1170   DevList := upnpDiscover(1000, nil, nil, 0, 0, 2, Addr(Err));
1171   if DevList = nil then
1172   begin
1173     conwritefln('port forwarding failed: upnpDiscover() failed: %d', [Err]);
1174     exit;
1175   end;
1176
1177   I := UPNP_GetValidIGD(DevList, @Urls, @Data, Addr(LanAddr[0]), 256);
1178
1179   if I = 0 then
1180   begin
1181     conwriteln('port forwarding failed: could not find an IGD device on this LAN');
1182     FreeUPNPDevList(DevList);
1183     FreeUPNPUrls(@Urls);
1184     exit;
1185   end;
1186
1187   StrPort := IntToStr(NetPort);
1188   I := UPNP_AddPortMapping(
1189     Urls.controlURL, Addr(data.first.servicetype[1]),
1190     PChar(StrPort), PChar(StrPort), Addr(LanAddr[0]), PChar('D2DF'),
1191     PChar('UDP'), nil, PChar('0')
1192   );
1193
1194   if I <> 0 then
1195   begin
1196     conwritefln('forwarding port %d failed: error %d', [NetPort, I]);
1197     FreeUPNPDevList(DevList);
1198     FreeUPNPUrls(@Urls);
1199     exit;
1200   end;
1201
1202   if ForwardPongPort then
1203   begin
1204     StrPort := IntToStr(NET_PING_PORT);
1205     I := UPNP_AddPortMapping(
1206       Urls.controlURL, Addr(data.first.servicetype[1]),
1207       PChar(StrPort), PChar(StrPort), Addr(LanAddr[0]), PChar('D2DF'),
1208       PChar('UDP'), nil, PChar('0')
1209     );
1210
1211     if I <> 0 then
1212     begin
1213       conwritefln('forwarding port %d failed: error %d', [NetPort + 1, I]);
1214       NetPongForwarded := False;
1215     end
1216     else
1217     begin
1218       conwritefln('forwarded port %d successfully', [NetPort + 1]);
1219       NetPongForwarded := True;
1220     end;
1221   end;
1222
1223   conwritefln('forwarded port %d successfully', [NetPort]);
1224   NetIGDControl := AnsiString(Urls.controlURL);
1225   NetIGDService := data.first.servicetype;
1226   NetPortForwarded := NetPort;
1227
1228   FreeUPNPDevList(DevList);
1229   FreeUPNPUrls(@Urls);
1230   Result := True;
1231 end;
1232 {$ELSE}
1233 begin
1234   Result := False;
1235 end;
1236 {$ENDIF}
1237
1238 procedure g_Net_UnforwardPorts();
1239 {$IFDEF USE_MINIUPNPC}
1240 var
1241   I: Integer;
1242   StrPort: AnsiString;
1243 begin
1244   if NetPortForwarded = 0 then Exit;
1245
1246   conwriteln('unforwarding ports...');
1247
1248   StrPort := IntToStr(NetPortForwarded);
1249   I := UPNP_DeletePortMapping(
1250     PChar(NetIGDControl), Addr(NetIGDService[1]),
1251     PChar(StrPort), PChar('UDP'), nil
1252   );
1253   conwritefln('  port %d: %d', [NetPortForwarded, I]);
1254
1255   if NetPongForwarded then
1256   begin
1257     NetPongForwarded := False;
1258     StrPort := IntToStr(NetPortForwarded + 1);
1259     I := UPNP_DeletePortMapping(
1260       PChar(NetIGDControl), Addr(NetIGDService[1]),
1261       PChar(StrPort), PChar('UDP'), nil
1262     );
1263     conwritefln('  port %d: %d', [NetPortForwarded + 1, I]);
1264   end;
1265
1266   NetPortForwarded := 0;
1267 end;
1268 {$ELSE}
1269 begin
1270 end;
1271 {$ENDIF}
1272
1273 initialization
1274   conRegVar('cl_downloadtimeout', @g_Net_DownloadTimeout, 0.0, 1000000.0, '', 'timeout in seconds, 0 to disable it');
1275   g_Net_DownloadTimeout := 60;
1276   NetIn.Alloc(NET_BUFSIZE);
1277   NetOut.Alloc(NET_BUFSIZE);
1278 finalization
1279   NetIn.Free();
1280   NetOut.Free();
1281 end.