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