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