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