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