DEADSOFTWARE

Revert "fixed weapon switching over the network; bumped protocol version"
[d2df-sdl.git] / src / game / g_net.pas
index 1b7a5035da6e67c3db9279cedf4e95d3b2cb6901..c15df2bae9406b2cc043fce515bdc11b113b21da 100644 (file)
@@ -1,4 +1,4 @@
-(* Copyright (C)  DooM 2D:Forever Developers
+(* Copyright (C)  Doom 2D: Forever Developers
  *
  * This program is free software: you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
  * You should have received a copy of the GNU General Public License
  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  *)
-{$MODE DELPHI}
+{$INCLUDE ../shared/a_modes.inc}
 unit g_net;
 
 interface
 
 uses
-  e_log, e_fixedbuffer, ENet, Classes;
+  e_log, e_msg, ENet, Classes, MAPDEF{$IFDEF USE_MINIUPNPC}, miniupnpc;{$ELSE};{$ENDIF}
 
 const
-  NET_PROTOCOL_VER = 168;
+  NET_PROTOCOL_VER = 174;
 
   NET_MAXCLIENTS = 24;
   NET_CHANS = 11;
@@ -43,7 +43,8 @@ const
   NET_SERVER = 1;
   NET_CLIENT = 2;
 
-  NET_BUFSIZE = 65536;
+  NET_BUFSIZE = $FFFF;
+  NET_PING_PORT = $DF2D;
 
   NET_EVERYONE = -1;
 
@@ -63,6 +64,13 @@ const
   NET_STATE_GAME = 2;
 
   BANLIST_FILENAME = 'banlist.txt';
+  NETDUMP_FILENAME = 'netdump';
+
+  {$IFDEF FREEBSD}
+    NilThreadId = nil;
+  {$ELSE}
+    NilThreadId = 0;
+  {$ENDIF}
 
 type
   TNetClient = record
@@ -86,6 +94,7 @@ type
 var
   NetInitDone:     Boolean = False;
   NetMode:         Byte = NET_NONE;
+  NetDump:         Boolean = False;
 
   NetServerName:   string = 'Unnamed Server';
   NetPassword:     string = '';
@@ -114,7 +123,7 @@ var
   NetClientIP:   string = '127.0.0.1';
   NetClientPort: Word   = 25666;
 
-  NetIn, NetOut: TBuffer;
+  NetIn, NetOut: TMsg;
 
   NetClients:     array of TNetClient;
   NetClientCount: Byte = 0;
@@ -134,9 +143,21 @@ var
 
   NetForcePlayerUpdate: Boolean = False;
   NetPredictSelf:       Boolean = True;
-  NetGotKeys:           Boolean = False;
+  NetForwardPorts:      Boolean = False;
 
   NetGotEverything: Boolean = False;
+  NetGotKeys:       Boolean = False;
+
+{$IFDEF USE_MINIUPNPC}
+  NetPortForwarded: Word = 0;
+  NetPongForwarded: Boolean = False;
+  NetIGDControl: AnsiString;
+  NetIGDService: TURLStr;
+{$ENDIF}
+
+  NetPortThread: TThreadID = NilThreadId;
+
+  NetDumpFile: TStream;
 
 function  g_Net_Init(): Boolean;
 procedure g_Net_Cleanup();
@@ -158,7 +179,7 @@ function  g_Net_Client_ByName(Name: string): pTNetClient;
 function  g_Net_Client_ByPlayer(PID: Word): pTNetClient;
 function  g_Net_ClientName_ByID(ID: Integer): string;
 
-procedure g_Net_SendData(Data:AByte; peer: pENetPeer; Reliable: Boolean; Chan: Byte = NET_CHAN_DOWNLOAD);
+procedure g_Net_SendData(Data: AByte; peer: pENetPeer; Reliable: Boolean; Chan: Byte = NET_CHAN_DOWNLOAD);
 function  g_Net_Wait_Event(msgId: Word): TMemoryStream;
 
 function  IpToStr(IP: LongWord): string;
@@ -172,12 +193,20 @@ function  g_Net_UnbanHost(IP: LongWord): Boolean; overload;
 procedure g_Net_UnbanNonPermHosts();
 procedure g_Net_SaveBanList();
 
+procedure g_Net_DumpStart();
+procedure g_Net_DumpSendBuffer();
+procedure g_Net_DumpRecvBuffer(Buf: penet_uint8; Len: LongWord);
+procedure g_Net_DumpEnd();
+
+function g_Net_ForwardPorts(ForwardPongPort: Boolean = True): Boolean;
+procedure g_Net_UnforwardPorts();
+
 implementation
 
 uses
   SysUtils,
   e_input, g_nethandler, g_netmsg, g_netmaster, g_player, g_window, g_console,
-  g_main, g_game, g_language, g_weapons;
+  g_main, g_game, g_language, g_weapons, utils;
 
 
 { /// SERVICE FUNCTIONS /// }
@@ -239,8 +268,8 @@ var
   IPstr: string;
   IP: LongWord;
 begin
-  e_Buffer_Clear(@NetIn);
-  e_Buffer_Clear(@NetOut);
+  NetIn.Clear();
+  NetOut.Clear();
   SetLength(NetClients, 0);
   NetPeer := nil;
   NetHost := nil;
@@ -273,8 +302,8 @@ end;
 
 procedure g_Net_Cleanup();
 begin
-  e_Buffer_Clear(@NetIn);
-  e_Buffer_Clear(@NetOut);
+  NetIn.Clear();
+  NetOut.Clear();
 
   SetLength(NetClients, 0);
   NetClientCount := 0;
@@ -295,6 +324,15 @@ begin
   NetTimeToReliable := 0;
 
   NetMode := NET_NONE;
+
+  if NetPortThread <> NilThreadId then
+    WaitForThreadTerminate(NetPortThread, 66666);
+
+  NetPortThread := NilThreadId;
+  g_Net_UnforwardPorts();
+
+  if NetDump then
+    g_Net_DumpEnd();
 end;
 
 procedure g_Net_Free();
@@ -309,6 +347,12 @@ end;
 { /// SERVER FUNCTIONS /// }
 
 
+function ForwardThread(Param: Pointer): PtrInt;
+begin
+  Result := 0;
+  if not g_Net_ForwardPorts() then Result := -1;
+end;
+
 function g_Net_Host(IPAddr: LongWord; Port: enet_uint16; MaxClients: Cardinal = 16): Boolean;
 begin
   if NetMode <> NET_NONE then
@@ -336,6 +380,8 @@ begin
   NetAddr.host := IPAddr;
   NetAddr.port := Port;
 
+  if NetForwardPorts then NetPortThread := BeginThread(ForwardThread);
+
   NetHost := enet_host_create(@NetAddr, NET_MAXCLIENTS, NET_CHANS, 0, 0);
 
   if (NetHost = nil) then
@@ -350,7 +396,7 @@ begin
   if NetPongSock <> ENET_SOCKET_NULL then
   begin
     NetPongAddr.host := IPAddr;
-    NetPongAddr.port := Port + 1;
+    NetPongAddr.port := NET_PING_PORT;
     if enet_socket_bind(NetPongSock, @NetPongAddr) < 0 then
     begin
       enet_socket_destroy(NetPongSock);
@@ -361,7 +407,10 @@ begin
   end;
 
   NetMode := NET_SERVER;
-  e_Buffer_Clear(@NetOut);
+  NetOut.Clear();
+
+  if NetDump then
+    g_Net_DumpStart();
 end;
 
 procedure g_Net_Host_Die();
@@ -399,7 +448,7 @@ begin
   NetMode := NET_NONE;
 
   g_Net_Cleanup;
-  e_WriteLog('NET: Server stopped', MSG_NOTIFY);
+  e_WriteLog('NET: Server stopped', TMsgType.Notify);
 end;
 
 
@@ -418,21 +467,22 @@ begin
     if ID > High(NetClients) then Exit;
     if NetClients[ID].Peer = nil then Exit;
 
-    P := enet_packet_create(Addr(NetOut.Data), NetOut.Len, F);
+    P := enet_packet_create(NetOut.Data, NetOut.CurSize, F);
     if not Assigned(P) then Exit;
 
     enet_peer_send(NetClients[ID].Peer, Chan, P);
   end
   else
   begin
-    P := enet_packet_create(Addr(NetOut.Data), NetOut.Len, F);
+    P := enet_packet_create(NetOut.Data, NetOut.CurSize, F);
     if not Assigned(P) then Exit;
 
     enet_host_broadcast(NetHost, Chan, P);
   end;
 
+  if NetDump then g_Net_DumpSendBuffer();
   g_Net_Flush();
-  e_Buffer_Clear(@NetOut);
+  NetOut.Clear();
 end;
 
 procedure g_Net_Host_CheckPings();
@@ -458,22 +508,23 @@ begin
   begin
     ClTime := Int64(Addr(Ping[2])^);
 
-    e_Buffer_Clear(@NetOut);
-    e_Buffer_Write(@NetOut, Byte(Ord('D')));
-    e_Buffer_Write(@NetOut, Byte(Ord('F')));
-    e_Buffer_Write(@NetOut, ClTime);
+    NetOut.Clear();
+    NetOut.Write(Byte(Ord('D')));
+    NetOut.Write(Byte(Ord('F')));
+    NetOut.Write(NetPort);
+    NetOut.Write(ClTime);
     g_Net_Slist_WriteInfo();
     NPl := 0;
     if gPlayer1 <> nil then Inc(NPl);
     if gPlayer2 <> nil then Inc(NPl);
-    e_Buffer_Write(@NetOut, NPl);
-    e_Buffer_Write(@NetOut, gNumBots);
+    NetOut.Write(NPl);
+    NetOut.Write(gNumBots);
 
-    Buf.data := Addr(NetOut.Data[0]);
-    Buf.dataLength := NetOut.WritePos;
+    Buf.data := NetOut.Data;
+    Buf.dataLength := NetOut.CurSize;
     enet_socket_send(NetPongSock, @ClAddr, @Buf, 1);
 
-    e_Buffer_Clear(@NetOut);
+    NetOut.Clear();
   end;
 end;
 
@@ -489,10 +540,8 @@ begin
   Result := 0;
 
   if NetUseMaster then
-  begin
     g_Net_Slist_Check;
-    g_Net_Host_CheckPings;
-  end;
+  g_Net_Host_CheckPings;
 
   while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
   begin
@@ -546,6 +595,7 @@ begin
         if ID > High(NetClients) then Exit;
         TC := @NetClients[ID];
 
+        if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
         g_Net_HostMsgHandler(TC, NetEvent.packet);
       end;
 
@@ -565,7 +615,7 @@ begin
           TP.Lives := 0;
           TP.Kill(K_SIMPLEKILL, 0, HIT_DISCON);
           g_Console_Add(Format(_lc[I_PLAYER_LEAVE], [TP.Name]), True);
-          e_WriteLog('NET: Client ' + TP.Name + ' [' + IntToStr(ID) + '] disconnected.', MSG_NOTIFY);
+          e_WriteLog('NET: Client ' + TP.Name + ' [' + IntToStr(ID) + '] disconnected.', TMsgType.Notify);
           g_Player_Remove(TP.UID);
         end;
 
@@ -619,7 +669,7 @@ begin
   end
   else
   begin
-    e_WriteLog('NET: Kicked from server: ' + IntToStr(NetEvent.data), MSG_NOTIFY);
+    e_WriteLog('NET: Kicked from server: ' + IntToStr(NetEvent.data), TMsgType.Notify);
     if (NetEvent.data <= NET_DISC_MAX) then
       g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_KICK] +
         _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + NetEvent.data)], True);
@@ -633,7 +683,7 @@ begin
   g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_CLIENT_DISC]);
 
   g_Net_Cleanup;
-  e_WriteLog('NET: Disconnected', MSG_NOTIFY);
+  e_WriteLog('NET: Disconnected', TMsgType.Notify);
 end;
 
 procedure g_Net_Client_Send(Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
@@ -646,12 +696,13 @@ begin
   else
     F := 0;
 
-  P := enet_packet_create(Addr(NetOut.Data), NetOut.Len, F);
+  P := enet_packet_create(NetOut.Data, NetOut.CurSize, F);
   if not Assigned(P) then Exit;
 
   enet_peer_send(NetPeer, Chan, P);
+  if NetDump then g_Net_DumpSendBuffer();
   g_Net_Flush();
-  e_Buffer_Clear(@NetOut);
+  NetOut.Clear();
 end;
 
 function g_Net_Client_Update(): enet_size_t;
@@ -661,7 +712,10 @@ begin
   begin
     case NetEvent.kind of
       ENET_EVENT_TYPE_RECEIVE:
+      begin
+        if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
         g_Net_ClientMsgHandler(NetEvent.packet);
+      end;
 
       ENET_EVENT_TYPE_DISCONNECT:
       begin
@@ -680,7 +734,10 @@ begin
   begin
     case NetEvent.kind of
       ENET_EVENT_TYPE_RECEIVE:
+      begin
+        if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
         g_Net_ClientLightMsgHandler(NetEvent.packet);
+      end;
 
       ENET_EVENT_TYPE_DISCONNECT:
       begin
@@ -753,19 +810,19 @@ begin
       begin
         g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_CLIENT_DONE]);
         NetMode := NET_CLIENT;
-        e_Buffer_Clear(@NetOut);
+        NetOut.Clear();
         enet_peer_timeout(NetPeer, ENET_PEER_TIMEOUT_LIMIT * 2, ENET_PEER_TIMEOUT_MINIMUM * 2, ENET_PEER_TIMEOUT_MAXIMUM * 2);
         NetClientIP := IP;
         NetClientPort := Port;
+        if NetDump then
+          g_Net_DumpStart();
         Exit;
       end;
     end;
 
-    ProcessLoading();
+    ProcessLoading(true);
 
-    e_PollInput();
-
-    if e_KeyPressed(IK_ESCAPE) or e_KeyPressed(IK_SPACE) then
+    if e_KeyPressed(IK_ESCAPE) or e_KeyPressed(IK_SPACE) or e_KeyPressed(VK_ESCAPE) then
       OuterLoop := False;
   end;
 
@@ -784,15 +841,11 @@ function IpToStr(IP: LongWord): string;
 var
   Ptr: Pointer;
 begin
-  Result := '';
   Ptr := Addr(IP);
-
-  e_Raw_Seek(0);
-  Result := Result + IntToStr(e_Raw_Read_Byte(Ptr)) + '.';
-  Result := Result + IntToStr(e_Raw_Read_Byte(Ptr)) + '.';
-  Result := Result + IntToStr(e_Raw_Read_Byte(Ptr)) + '.';
-  Result := Result + IntToStr(e_Raw_Read_Byte(Ptr));
-  e_Raw_Seek(0);
+  Result :=          IntToStr(PByte(Ptr + 0)^) + '.';
+  Result := Result + IntToStr(PByte(Ptr + 1)^) + '.';
+  Result := Result + IntToStr(PByte(Ptr + 2)^) + '.';
+  Result := Result + IntToStr(PByte(Ptr + 3)^);
 end;
 
 function StrToIp(IPstr: string; var IP: LongWord): Boolean;
@@ -854,7 +907,7 @@ begin
     end;
 end;
 
-procedure g_Net_SendData(Data:AByte; peer: pENetPeer; Reliable: Boolean; Chan: Byte = NET_CHAN_DOWNLOAD);
+procedure g_Net_SendData(Data: AByte; peer: pENetPeer; Reliable: Boolean; Chan: Byte = NET_CHAN_DOWNLOAD);
 var
   P: pENetPacket;
   F: enet_uint32;
@@ -930,11 +983,9 @@ begin
         end;
     end;
 
-    ProcessLoading();
-
-    e_PollInput();
+    ProcessLoading(true);
 
-    if e_KeyPressed(IK_ESCAPE) or e_KeyPressed(IK_SPACE) then
+    if e_KeyPressed(IK_ESCAPE) or e_KeyPressed(IK_SPACE) or e_KeyPressed(VK_ESCAPE) then
       break;
   end;
   Result := msgStream;
@@ -1048,4 +1099,169 @@ begin
   CloseFile(F);
 end;
 
+procedure g_Net_DumpStart();
+begin
+  if NetMode = NET_SERVER then
+    NetDumpFile := createDiskFile(NETDUMP_FILENAME + '_server')
+  else
+    NetDumpFile := createDiskFile(NETDUMP_FILENAME + '_client');
+end;
+
+procedure g_Net_DumpSendBuffer();
+begin
+  writeInt(NetDumpFile, gTime);
+  writeInt(NetDumpFile, LongWord(NetOut.CurSize));
+  writeInt(NetDumpFile, Byte(1));
+  NetDumpFile.WriteBuffer(NetOut.Data^, NetOut.CurSize);
+end;
+
+procedure g_Net_DumpRecvBuffer(Buf: penet_uint8; Len: LongWord);
+begin
+  if (Buf = nil) or (Len = 0) then Exit;
+  writeInt(NetDumpFile, gTime);
+  writeInt(NetDumpFile, Len);
+  writeInt(NetDumpFile, Byte(0));
+  NetDumpFile.WriteBuffer(Buf^, Len);
+end;
+
+procedure g_Net_DumpEnd();
+begin
+  NetDumpFile.Free();
+  NetDumpFile := nil;
+end;
+
+function g_Net_ForwardPorts(ForwardPongPort: Boolean = True): Boolean;
+{$IFDEF USE_MINIUPNPC}
+var
+  DevList: PUPNPDev;
+  Urls: TUPNPUrls;
+  Data: TIGDDatas;
+  LanAddr: array [0..255] of Char;
+  StrPort: AnsiString;
+  Err, I: Integer;
+begin
+  Result := False;
+
+  if NetPortForwarded = NetPort then
+  begin
+    Result := True;
+    exit;
+  end;
+
+  NetPongForwarded := False;
+  NetPortForwarded := 0;
+
+  DevList := upnpDiscover(1000, nil, nil, 0, 0, 2, Addr(Err));
+  if DevList = nil then
+  begin
+    conwritefln('port forwarding failed: upnpDiscover() failed: %d', [Err]);
+    exit;
+  end;
+
+  I := UPNP_GetValidIGD(DevList, @Urls, @Data, Addr(LanAddr[0]), 256);
+
+  if I = 0 then
+  begin
+    conwriteln('port forwarding failed: could not find an IGD device on this LAN');
+    FreeUPNPDevList(DevList);
+    FreeUPNPUrls(@Urls);
+    exit;
+  end;
+
+  StrPort := IntToStr(NetPort);
+  I := UPNP_AddPortMapping(
+    Urls.controlURL, Addr(data.first.servicetype[1]),
+    PChar(StrPort), PChar(StrPort), Addr(LanAddr[0]), PChar('D2DF'),
+    PChar('UDP'), nil, PChar('0')
+  );
+
+  if I <> 0 then
+  begin
+    conwritefln('forwarding port %d failed: error %d', [NetPort, I]);
+    FreeUPNPDevList(DevList);
+    FreeUPNPUrls(@Urls);
+    exit;
+  end;
+
+  if ForwardPongPort then
+  begin
+    StrPort := IntToStr(NET_PING_PORT);
+    I := UPNP_AddPortMapping(
+      Urls.controlURL, Addr(data.first.servicetype[1]),
+      PChar(StrPort), PChar(StrPort), Addr(LanAddr[0]), PChar('D2DF'),
+      PChar('UDP'), nil, PChar('0')
+    );
+
+    if I <> 0 then
+    begin
+      conwritefln('forwarding port %d failed: error %d', [NetPort + 1, I]);
+      NetPongForwarded := False;
+    end
+    else
+    begin
+      conwritefln('forwarded port %d successfully', [NetPort + 1]);
+      NetPongForwarded := True;
+    end;
+  end;
+
+  conwritefln('forwarded port %d successfully', [NetPort]);
+  NetIGDControl := AnsiString(Urls.controlURL);
+  NetIGDService := data.first.servicetype;
+  NetPortForwarded := NetPort;
+
+  FreeUPNPDevList(DevList);
+  FreeUPNPUrls(@Urls);
+  Result := True;
+end;
+{$ELSE}
+begin
+  Result := False;
+end;
+{$ENDIF}
+
+procedure g_Net_UnforwardPorts();
+{$IFDEF USE_MINIUPNPC}
+var
+  I: Integer;
+  StrPort: AnsiString;
+begin
+  if NetPortForwarded = 0 then Exit;
+
+  conwriteln('unforwarding ports...');
+
+  StrPort := IntToStr(NetPortForwarded);
+  I := UPNP_DeletePortMapping(
+    PChar(NetIGDControl), Addr(NetIGDService[1]),
+    PChar(StrPort), PChar('UDP'), nil
+  );
+  conwritefln('  port %d: %d', [NetPortForwarded, I]);
+
+  if NetPongForwarded then
+  begin
+    NetPongForwarded := False;
+    StrPort := IntToStr(NetPortForwarded + 1);
+    I := UPNP_DeletePortMapping(
+      PChar(NetIGDControl), Addr(NetIGDService[1]),
+      PChar(StrPort), PChar('UDP'), nil
+    );
+    conwritefln('  port %d: %d', [NetPortForwarded + 1, I]);
+  end;
+
+  NetPortForwarded := 0;
+end;
+{$ELSE}
+begin
+end;
+{$ENDIF}
+
+initialization
+
+  NetIn.Alloc(NET_BUFSIZE);
+  NetOut.Alloc(NET_BUFSIZE);
+
+finalization
+
+  NetIn.Free();
+  NetOut.Free();
+
 end.