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