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