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 = 174;
  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 type
  70   TNetClient = record
  71     ID:      Byte;
  72     Used:    Boolean;
  73     State:   Byte;
  74     Peer:    pENetPeer;
  75     Player:  Word;
  76     RequestedFullUpdate: Boolean;
  77     RCONAuth: Boolean;
  78     Voted:    Boolean;
  79   end;
  80   TBanRecord = record
  81     IP: LongWord;
  82     Perm: Boolean;
  83   end;
  84   pTNetClient = ^TNetClient;
  85
  86   AByte = array of Byte;
  87
  88 var
  89   NetInitDone:     Boolean = False;
  90   NetMode:         Byte = NET_NONE;
  91   NetDump:         Boolean = False;
  92
  93   NetServerName:   string = 'Unnamed Server';
  94   NetPassword:     string = '';
  95   NetPort:         Word = 25666;
  96
  97   NetAllowRCON:    Boolean = False;
  98   NetRCONPassword: string = '';
  99
 100   NetTimeToUpdate:   Cardinal = 0;
 101   NetTimeToReliable: Cardinal = 0;
 102   NetTimeToMaster:   Cardinal = 0;
 103
 104   NetHost:       pENetHost = nil;
 105   NetPeer:       pENetPeer = nil;
 106   NetEvent:      ENetEvent;
 107   NetAddr:       ENetAddress;
 108
 109   NetPongAddr:   ENetAddress;
 110   NetPongSock:   ENetSocket = ENET_SOCKET_NULL;
 111
 112   NetUseMaster: Boolean = True;
 113   NetSlistAddr: ENetAddress;
 114   NetSlistIP:   string = 'mpms.doom2d.org';
 115   NetSlistPort: Word = 25665;
 116
 117   NetClientIP:   string = '127.0.0.1';
 118   NetClientPort: Word   = 25666;
 119
 120   NetIn, NetOut: TMsg;
 121
 122   NetClients:     array of TNetClient;
 123   NetClientCount: Byte = 0;
 124   NetMaxClients:  Byte = 255;
 125   NetBannedHosts: array of TBanRecord;
 126
 127   NetState:      Integer = NET_STATE_NONE;
 128
 129   NetMyID:       Integer = -1;
 130   NetPlrUID1:    Integer = -1;
 131   NetPlrUID2:    Integer = -1;
 132
 133   NetInterpLevel: Integer = 1;
 134   NetUpdateRate:  Cardinal = 0;  // as soon as possible
 135   NetRelupdRate:  Cardinal = 18; // around two times a second
 136   NetMasterRate:  Cardinal = 60000;
 137
 138   NetForcePlayerUpdate: Boolean = False;
 139   NetPredictSelf:       Boolean = True;
 140   NetForwardPorts:      Boolean = False;
 141
 142   NetGotEverything: Boolean = False;
 143   NetGotKeys:       Boolean = False;
 144
 145 {$IFDEF USE_MINIUPNPC}
 146   NetPortForwarded: Word = 0;
 147   NetPongForwarded: Boolean = False;
 148   NetIGDControl: AnsiString;
 149   NetIGDService: TURLStr;
 150 {$ENDIF}
 151
 152   NetPortThread: TThreadID = 0;
 153
 154   NetDumpFile: TStream;
 155
 156 function  g_Net_Init(): Boolean;
 157 procedure g_Net_Cleanup();
 158 procedure g_Net_Free();
 159 procedure g_Net_Flush();
 160
 161 function  g_Net_Host(IPAddr: LongWord; Port: enet_uint16; MaxClients: Cardinal = 16): Boolean;
 162 procedure g_Net_Host_Die();
 163 procedure g_Net_Host_Send(ID: Integer; Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
 164 function  g_Net_Host_Update(): enet_size_t;
 165
 166 function  g_Net_Connect(IP: string; Port: enet_uint16): Boolean;
 167 procedure g_Net_Disconnect(Forced: Boolean = False);
 168 procedure g_Net_Client_Send(Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
 169 function  g_Net_Client_Update(): enet_size_t;
 170 function  g_Net_Client_UpdateWhileLoading(): enet_size_t;
 171
 172 function  g_Net_Client_ByName(Name: string): pTNetClient;
 173 function  g_Net_Client_ByPlayer(PID: Word): pTNetClient;
 174 function  g_Net_ClientName_ByID(ID: Integer): string;
 175
 176 procedure g_Net_SendData(Data:AByte; peer: pENetPeer; Reliable: Boolean; Chan: Byte = NET_CHAN_DOWNLOAD);
 177 function  g_Net_Wait_Event(msgId: Word): TMemoryStream;
 178
 179 function  IpToStr(IP: LongWord): string;
 180 function  StrToIp(IPstr: string; var IP: LongWord): Boolean;
 181
 182 function  g_Net_IsHostBanned(IP: LongWord; Perm: Boolean = False): Boolean;
 183 procedure g_Net_BanHost(IP: LongWord; Perm: Boolean = True); overload;
 184 procedure g_Net_BanHost(IP: string; Perm: Boolean = True); overload;
 185 function  g_Net_UnbanHost(IP: string): Boolean; overload;
 186 function  g_Net_UnbanHost(IP: LongWord): Boolean; overload;
 187 procedure g_Net_UnbanNonPermHosts();
 188 procedure g_Net_SaveBanList();
 189
 190 procedure g_Net_DumpStart();
 191 procedure g_Net_DumpSendBuffer();
 192 procedure g_Net_DumpRecvBuffer(Buf: penet_uint8; Len: LongWord);
 193 procedure g_Net_DumpEnd();
 194
 195 function g_Net_ForwardPorts(ForwardPongPort: Boolean = True): Boolean;
 196 procedure g_Net_UnforwardPorts();
 197
 198 implementation
 199
 200 uses
 201   SysUtils,
 202   e_input, g_nethandler, g_netmsg, g_netmaster, g_player, g_window, g_console,
 203   g_main, g_game, g_language, g_weapons, utils;
 204
 205
 206 { /// SERVICE FUNCTIONS /// }
 207
 208
 209 function g_Net_FindSlot(): Integer;
 210 var
 211   I: Integer;
 212   F: Boolean;
 213   N, C: Integer;
 214 begin
 215   N := -1;
 216   F := False;
 217   C := 0;
 218   for I := Low(NetClients) to High(NetClients) do
 219   begin
 220     if NetClients[I].Used then
 221       Inc(C)
 222     else
 223       if not F then
 224       begin
 225         F := True;
 226         N := I;
 227       end;
 228   end;
 229   if C >= NetMaxClients then
 230   begin
 231     Result := -1;
 232     Exit;
 233   end;
 234
 235   if not F then
 236   begin
 237     if (Length(NetClients) >= NetMaxClients) then
 238       N := -1
 239     else
 240     begin
 241       SetLength(NetClients, Length(NetClients) + 1);
 242       N := High(NetClients);
 243     end;
 244   end;
 245
 246   if N >= 0 then
 247   begin
 248     NetClients[N].Used := True;
 249     NetClients[N].ID := N;
 250     NetClients[N].RequestedFullUpdate := False;
 251     NetClients[N].RCONAuth := False;
 252     NetClients[N].Voted := False;
 253     NetClients[N].Player := 0;
 254   end;
 255
 256   Result := N;
 257 end;
 258
 259 function g_Net_Init(): Boolean;
 260 var
 261   F: TextFile;
 262   IPstr: string;
 263   IP: LongWord;
 264 begin
 265   NetIn.Clear();
 266   NetOut.Clear();
 267   SetLength(NetClients, 0);
 268   NetPeer := nil;
 269   NetHost := nil;
 270   NetMyID := -1;
 271   NetPlrUID1 := -1;
 272   NetPlrUID2 := -1;
 273   NetAddr.port := 25666;
 274   SetLength(NetBannedHosts, 0);
 275   if FileExists(DataDir + BANLIST_FILENAME) then
 276   begin
 277     Assign(F, DataDir + BANLIST_FILENAME);
 278     Reset(F);
 279     while not EOF(F) do
 280     begin
 281       Readln(F, IPstr);
 282       if StrToIp(IPstr, IP) then
 283         g_Net_BanHost(IP);
 284     end;
 285     CloseFile(F);
 286     g_Net_SaveBanList();
 287   end;
 288
 289   Result := (enet_initialize() = 0);
 290 end;
 291
 292 procedure g_Net_Flush();
 293 begin
 294   enet_host_flush(NetHost);
 295 end;
 296
 297 procedure g_Net_Cleanup();
 298 begin
 299   NetIn.Clear();
 300   NetOut.Clear();
 301
 302   SetLength(NetClients, 0);
 303   NetClientCount := 0;
 304
 305   NetPeer := nil;
 306   NetHost := nil;
 307   NetMPeer := nil;
 308   NetMHost := nil;
 309   NetMyID := -1;
 310   NetPlrUID1 := -1;
 311   NetPlrUID2 := -1;
 312   NetState := NET_STATE_NONE;
 313
 314   NetPongSock := ENET_SOCKET_NULL;
 315
 316   NetTimeToMaster := 0;
 317   NetTimeToUpdate := 0;
 318   NetTimeToReliable := 0;
 319
 320   NetMode := NET_NONE;
 321
 322   if NetPortThread <> 0 then
 323     WaitForThreadTerminate(NetPortThread, 66666);
 324
 325   NetPortThread := 0;
 326   g_Net_UnforwardPorts();
 327
 328   if NetDump then
 329     g_Net_DumpEnd();
 330 end;
 331
 332 procedure g_Net_Free();
 333 begin
 334   g_Net_Cleanup();
 335
 336   enet_deinitialize();
 337   NetInitDone := False;
 338 end;
 339
 340
 341 { /// SERVER FUNCTIONS /// }
 342
 343
 344 function ForwardThread(Param: Pointer): PtrInt;
 345 begin
 346   Result := 0;
 347   if not g_Net_ForwardPorts() then Result := -1;
 348 end;
 349
 350 function g_Net_Host(IPAddr: LongWord; Port: enet_uint16; MaxClients: Cardinal = 16): Boolean;
 351 begin
 352   if NetMode <> NET_NONE then
 353   begin
 354     g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_INGAME]);
 355     Result := False;
 356     Exit;
 357   end;
 358
 359   Result := True;
 360
 361   g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST], [Port]));
 362   if not NetInitDone then
 363   begin
 364     if (not g_Net_Init()) then
 365     begin
 366       g_Console_Add(_lc[I_NET_MSG_FERROR] + _lc[I_NET_ERR_ENET]);
 367       Result := False;
 368       Exit;
 369     end
 370     else
 371       NetInitDone := True;
 372   end;
 373
 374   NetAddr.host := IPAddr;
 375   NetAddr.port := Port;
 376
 377   if NetForwardPorts then NetPortThread := BeginThread(ForwardThread);
 378
 379   NetHost := enet_host_create(@NetAddr, NET_MAXCLIENTS, NET_CHANS, 0, 0);
 380
 381   if (NetHost = nil) then
 382   begin
 383     g_Console_Add(_lc[I_NET_MSG_ERROR] + Format(_lc[I_NET_ERR_HOST], [Port]));
 384     Result := False;
 385     g_Net_Cleanup;
 386     Exit;
 387   end;
 388
 389   NetPongSock := enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM);
 390   if NetPongSock <> ENET_SOCKET_NULL then
 391   begin
 392     NetPongAddr.host := IPAddr;
 393     NetPongAddr.port := NET_PING_PORT;
 394     if enet_socket_bind(NetPongSock, @NetPongAddr) < 0 then
 395     begin
 396       enet_socket_destroy(NetPongSock);
 397       NetPongSock := ENET_SOCKET_NULL;
 398     end
 399     else
 400       enet_socket_set_option(NetPongSock, ENET_SOCKOPT_NONBLOCK, 1);
 401   end;
 402
 403   NetMode := NET_SERVER;
 404   NetOut.Clear();
 405
 406   if NetDump then
 407     g_Net_DumpStart();
 408 end;
 409
 410 procedure g_Net_Host_Die();
 411 var
 412   I: Integer;
 413 begin
 414   if NetMode <> NET_SERVER then Exit;
 415
 416   g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_DISCALL]);
 417   for I := 0 to High(NetClients) do
 418     if NetClients[I].Used then
 419       enet_peer_disconnect(NetClients[I].Peer, NET_DISC_DOWN);
 420
 421   while enet_host_service(NetHost, @NetEvent, 1000) > 0 do
 422     if NetEvent.kind = ENET_EVENT_TYPE_RECEIVE then
 423       enet_packet_destroy(NetEvent.packet);
 424
 425   for I := 0 to High(NetClients) do
 426     if NetClients[I].Used then
 427     begin
 428       FreeMemory(NetClients[I].Peer^.data);
 429       NetClients[I].Peer^.data := nil;
 430       enet_peer_reset(NetClients[I].Peer);
 431       NetClients[I].Peer := nil;
 432       NetClients[I].Used := False;
 433     end;
 434
 435   if (NetMPeer <> nil) and (NetMHost <> nil) then g_Net_Slist_Disconnect;
 436   if NetPongSock <> ENET_SOCKET_NULL then
 437     enet_socket_destroy(NetPongSock);
 438
 439   g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_DIE]);
 440   enet_host_destroy(NetHost);
 441
 442   NetMode := NET_NONE;
 443
 444   g_Net_Cleanup;
 445   e_WriteLog('NET: Server stopped', TMsgType.Notify);
 446 end;
 447
 448
 449 procedure g_Net_Host_Send(ID: Integer; Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
 450 var
 451   P: pENetPacket;
 452   F: enet_uint32;
 453 begin
 454   if (Reliable) then
 455     F := LongWord(ENET_PACKET_FLAG_RELIABLE)
 456   else
 457     F := 0;
 458
 459   if (ID >= 0) then
 460   begin
 461     if ID > High(NetClients) then Exit;
 462     if NetClients[ID].Peer = nil then Exit;
 463
 464     P := enet_packet_create(NetOut.Data, NetOut.CurSize, F);
 465     if not Assigned(P) then Exit;
 466
 467     enet_peer_send(NetClients[ID].Peer, Chan, P);
 468   end
 469   else
 470   begin
 471     P := enet_packet_create(NetOut.Data, NetOut.CurSize, F);
 472     if not Assigned(P) then Exit;
 473
 474     enet_host_broadcast(NetHost, Chan, P);
 475   end;
 476
 477   if NetDump then g_Net_DumpSendBuffer();
 478   g_Net_Flush();
 479   NetOut.Clear();
 480 end;
 481
 482 procedure g_Net_Host_CheckPings();
 483 var
 484   ClAddr: ENetAddress;
 485   Buf: ENetBuffer;
 486   Len: Integer;
 487   ClTime: Int64;
 488   Ping: array [0..9] of Byte;
 489   NPl: Byte;
 490 begin
 491   if NetPongSock = ENET_SOCKET_NULL then Exit;
 492
 493   Buf.data := Addr(Ping[0]);
 494   Buf.dataLength := 2+8;
 495
 496   Ping[0] := 0;
 497
 498   Len := enet_socket_receive(NetPongSock, @ClAddr, @Buf, 1);
 499   if Len < 0 then Exit;
 500
 501   if (Ping[0] = Ord('D')) and (Ping[1] = Ord('F')) then
 502   begin
 503     ClTime := Int64(Addr(Ping[2])^);
 504
 505     NetOut.Clear();
 506     NetOut.Write(Byte(Ord('D')));
 507     NetOut.Write(Byte(Ord('F')));
 508     NetOut.Write(NetPort);
 509     NetOut.Write(ClTime);
 510     g_Net_Slist_WriteInfo();
 511     NPl := 0;
 512     if gPlayer1 <> nil then Inc(NPl);
 513     if gPlayer2 <> nil then Inc(NPl);
 514     NetOut.Write(NPl);
 515     NetOut.Write(gNumBots);
 516
 517     Buf.data := NetOut.Data;
 518     Buf.dataLength := NetOut.CurSize;
 519     enet_socket_send(NetPongSock, @ClAddr, @Buf, 1);
 520
 521     NetOut.Clear();
 522   end;
 523 end;
 524
 525 function g_Net_Host_Update(): enet_size_t;
 526 var
 527   IP: string;
 528   Port: Word;
 529   ID: Integer;
 530   TC: pTNetClient;
 531   TP: TPlayer;
 532 begin
 533   IP := '';
 534   Result := 0;
 535
 536   if NetUseMaster then
 537     g_Net_Slist_Check;
 538   g_Net_Host_CheckPings;
 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) or e_KeyPressed(VK_ESCAPE) 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) or e_KeyPressed(VK_ESCAPE) 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(NET_PING_PORT);
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.