1 (* Copyright (C) Doom 2D: Forever Developers
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.
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.
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/>.
16 {$INCLUDE ../shared/a_modes.inc}
22 e_log
, e_msg
, ENet
, Classes
, MAPDEF
{$IFDEF USE_MINIUPNPC}, miniupnpc
;{$ELSE};{$ENDIF}
25 NET_PROTOCOL_VER
= 181;
31 NET_CHAN_IMPORTANT
= 1;
34 NET_CHAN_PLAYERPOS
= 4;
36 NET_CHAN_MONSTERPOS
= 6;
37 NET_CHAN_LARGEDATA
= 7;
39 NET_CHAN_DOWNLOAD
= 9;
47 NET_PING_PORT
= $DF2D;
54 NET_DISC_NONE
: enet_uint32
= 0;
55 NET_DISC_PROTOCOL
: enet_uint32
= 1;
56 NET_DISC_VERSION
: enet_uint32
= 2;
57 NET_DISC_FULL
: enet_uint32
= 3;
58 NET_DISC_KICK
: enet_uint32
= 4;
59 NET_DISC_DOWN
: enet_uint32
= 5;
60 NET_DISC_PASSWORD
: enet_uint32
= 6;
61 NET_DISC_TEMPBAN
: enet_uint32
= 7;
62 NET_DISC_BAN
: enet_uint32
= 8;
63 NET_DISC_MAX
: enet_uint32
= 8;
69 NET_CONNECT_TIMEOUT
= 1000 * 10;
71 BANLIST_FILENAME
= 'banlist.txt';
72 NETDUMP_FILENAME
= 'netdump';
87 RequestedFullUpdate
: Boolean;
90 NetOut
: array [0..1] of TMsg
;
96 pTNetClient
= ^TNetClient
;
98 AByte
= array of Byte;
101 NetInitDone
: Boolean = False;
102 NetMode
: Byte = NET_NONE
;
103 NetDump
: Boolean = False;
105 NetServerName
: string = 'Unnamed Server';
106 NetPassword
: string = '';
107 NetPort
: Word = 25666;
109 NetAllowRCON
: Boolean = False;
110 NetRCONPassword
: string = '';
112 NetTimeToUpdate
: Cardinal = 0;
113 NetTimeToReliable
: Cardinal = 0;
114 NetTimeToMaster
: Cardinal = 0;
116 NetHost
: pENetHost
= nil;
117 NetPeer
: pENetPeer
= nil;
119 NetAddr
: ENetAddress
;
121 NetPongAddr
: ENetAddress
;
122 NetPongSock
: ENetSocket
= ENET_SOCKET_NULL
;
124 NetUseMaster
: Boolean = True;
125 NetSlistAddr
: ENetAddress
;
126 NetSlistIP
: string = 'mpms.doom2d.org';
127 NetSlistPort
: Word = 25665;
129 NetClientIP
: string = '127.0.0.1';
130 NetClientPort
: Word = 25666;
133 NetBuf
: array [0..1] of TMsg
;
135 NetClients
: array of TNetClient
;
136 NetClientCount
: Byte = 0;
137 NetMaxClients
: Byte = 255;
138 NetBannedHosts
: array of TBanRecord
;
140 NetState
: Integer = NET_STATE_NONE
;
142 NetMyID
: Integer = -1;
143 NetPlrUID1
: Integer = -1;
144 NetPlrUID2
: Integer = -1;
146 NetInterpLevel
: Integer = 1;
147 NetUpdateRate
: Cardinal = 0; // as soon as possible
148 NetRelupdRate
: Cardinal = 18; // around two times a second
149 NetMasterRate
: Cardinal = 60000;
151 NetForcePlayerUpdate
: Boolean = False;
152 NetPredictSelf
: Boolean = True;
153 NetForwardPorts
: Boolean = False;
155 NetGotEverything
: Boolean = False;
156 NetGotKeys
: Boolean = False;
158 {$IFDEF USE_MINIUPNPC}
159 NetPortForwarded
: Word = 0;
160 NetPongForwarded
: Boolean = False;
161 NetIGDControl
: AnsiString;
162 NetIGDService
: TURLStr
;
165 NetPortThread
: TThreadID
= NilThreadId
;
167 NetDumpFile
: TStream
;
169 function g_Net_Init(): Boolean;
170 procedure g_Net_Cleanup();
171 procedure g_Net_Free();
172 procedure g_Net_Flush();
174 function g_Net_Host(IPAddr
: LongWord; Port
: enet_uint16
; MaxClients
: Cardinal = 16): Boolean;
175 procedure g_Net_Host_Die();
176 procedure g_Net_Host_Send(ID
: Integer; Reliable
: Boolean; Chan
: Byte = NET_CHAN_GAME
);
177 function g_Net_Host_Update(): enet_size_t
;
179 function g_Net_Connect(IP
: string; Port
: enet_uint16
): Boolean;
180 procedure g_Net_Disconnect(Forced
: Boolean = False);
181 procedure g_Net_Client_Send(Reliable
: Boolean; Chan
: Byte = NET_CHAN_GAME
);
182 function g_Net_Client_Update(): enet_size_t
;
183 function g_Net_Client_UpdateWhileLoading(): enet_size_t
;
185 function g_Net_Client_ByName(Name
: string): pTNetClient
;
186 function g_Net_Client_ByPlayer(PID
: Word): pTNetClient
;
187 function g_Net_ClientName_ByID(ID
: Integer): string;
189 procedure g_Net_SendData(Data
: AByte
; peer
: pENetPeer
; Reliable
: Boolean; Chan
: Byte = NET_CHAN_DOWNLOAD
);
190 function g_Net_Wait_Event(msgId
: Word): TMemoryStream
;
192 function IpToStr(IP
: LongWord): string;
193 function StrToIp(IPstr
: string; var IP
: LongWord): Boolean;
195 function g_Net_IsHostBanned(IP
: LongWord; Perm
: Boolean = False): Boolean;
196 procedure g_Net_BanHost(IP
: LongWord; Perm
: Boolean = True); overload
;
197 procedure g_Net_BanHost(IP
: string; Perm
: Boolean = True); overload
;
198 function g_Net_UnbanHost(IP
: string): Boolean; overload
;
199 function g_Net_UnbanHost(IP
: LongWord): Boolean; overload
;
200 procedure g_Net_UnbanNonPermHosts();
201 procedure g_Net_SaveBanList();
203 procedure g_Net_DumpStart();
204 procedure g_Net_DumpSendBuffer();
205 procedure g_Net_DumpRecvBuffer(Buf
: penet_uint8
; Len
: LongWord);
206 procedure g_Net_DumpEnd();
208 function g_Net_ForwardPorts(ForwardPongPort
: Boolean = True): Boolean;
209 procedure g_Net_UnforwardPorts();
215 e_input
, g_nethandler
, g_netmsg
, g_netmaster
, g_player
, g_window
, g_console
,
216 g_main
, g_game
, g_language
, g_weapons
, utils
, ctypes
;
219 g_Net_DownloadTimeout
: Single;
222 { /// SERVICE FUNCTIONS /// }
225 function g_Net_FindSlot(): Integer;
234 for I
:= Low(NetClients
) to High(NetClients
) do
236 if NetClients
[I
].Used
then
245 if C
>= NetMaxClients
then
253 if (Length(NetClients
) >= NetMaxClients
) then
257 SetLength(NetClients
, Length(NetClients
) + 1);
258 N
:= High(NetClients
);
264 NetClients
[N
].Used
:= True;
265 NetClients
[N
].ID
:= N
;
266 NetClients
[N
].RequestedFullUpdate
:= False;
267 NetClients
[N
].RCONAuth
:= False;
268 NetClients
[N
].Voted
:= False;
269 NetClients
[N
].Player
:= 0;
275 function g_Net_Init(): Boolean;
283 NetBuf
[NET_UNRELIABLE
].Clear();
284 NetBuf
[NET_RELIABLE
].Clear();
285 SetLength(NetClients
, 0);
291 NetAddr
.port
:= 25666;
292 SetLength(NetBannedHosts
, 0);
293 if FileExists(DataDir
+ BANLIST_FILENAME
) then
295 Assign(F
, DataDir
+ BANLIST_FILENAME
);
300 if StrToIp(IPstr
, IP
) then
307 Result
:= (enet_initialize() = 0);
310 procedure g_Net_Flush();
314 F
, Chan
: enet_uint32
;
318 Chan
:= NET_CHAN_GAME
;
320 if NetMode
= NET_SERVER
then
321 for T
:= NET_UNRELIABLE
to NET_RELIABLE
do
323 if NetBuf
[T
].CurSize
> 0 then
325 P
:= enet_packet_create(NetBuf
[T
].Data
, NetBuf
[T
].CurSize
, F
);
326 if not Assigned(P
) then continue
;
327 enet_host_broadcast(NetHost
, Chan
, P
);
331 for I
:= Low(NetClients
) to High(NetClients
) do
333 if not NetClients
[I
].Used
then continue
;
334 if NetClients
[I
].NetOut
[T
].CurSize
<= 0 then continue
;
335 P
:= enet_packet_create(NetClients
[I
].NetOut
[T
].Data
, NetClients
[I
].NetOut
[T
].CurSize
, F
);
336 if not Assigned(P
) then continue
;
337 enet_peer_send(NetClients
[I
].Peer
, Chan
, P
);
338 NetClients
[I
].NetOut
[T
].Clear();
341 // next and last iteration is always RELIABLE
342 F
:= LongWord(ENET_PACKET_FLAG_RELIABLE
);
343 Chan
:= NET_CHAN_IMPORTANT
;
345 else if NetMode
= NET_CLIENT
then
346 for T
:= NET_UNRELIABLE
to NET_RELIABLE
do
348 if NetBuf
[T
].CurSize
> 0 then
350 P
:= enet_packet_create(NetBuf
[T
].Data
, NetBuf
[T
].CurSize
, F
);
351 if not Assigned(P
) then continue
;
352 enet_peer_send(NetPeer
, Chan
, P
);
355 // next and last iteration is always RELIABLE
356 F
:= LongWord(ENET_PACKET_FLAG_RELIABLE
);
357 Chan
:= NET_CHAN_IMPORTANT
;
361 procedure g_Net_Cleanup();
365 NetBuf
[NET_UNRELIABLE
].Clear();
366 NetBuf
[NET_RELIABLE
].Clear();
368 SetLength(NetClients
, 0);
378 NetState
:= NET_STATE_NONE
;
380 NetPongSock
:= ENET_SOCKET_NULL
;
382 NetTimeToMaster
:= 0;
383 NetTimeToUpdate
:= 0;
384 NetTimeToReliable
:= 0;
388 if NetPortThread
<> NilThreadId
then
389 WaitForThreadTerminate(NetPortThread
, 66666);
391 NetPortThread
:= NilThreadId
;
392 g_Net_UnforwardPorts();
398 procedure g_Net_Free();
403 NetInitDone
:= False;
407 { /// SERVER FUNCTIONS /// }
410 function ForwardThread(Param
: Pointer): PtrInt
;
413 if not g_Net_ForwardPorts() then Result
:= -1;
416 function g_Net_Host(IPAddr
: LongWord; Port
: enet_uint16
; MaxClients
: Cardinal = 16): Boolean;
418 if NetMode
<> NET_NONE
then
420 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_INGAME
]);
427 g_Console_Add(_lc
[I_NET_MSG
] + Format(_lc
[I_NET_MSG_HOST
], [Port
]));
428 if not NetInitDone
then
430 if (not g_Net_Init()) then
432 g_Console_Add(_lc
[I_NET_MSG_FERROR
] + _lc
[I_NET_ERR_ENET
]);
440 NetAddr
.host
:= IPAddr
;
441 NetAddr
.port
:= Port
;
443 if NetForwardPorts
then NetPortThread
:= BeginThread(ForwardThread
);
445 NetHost
:= enet_host_create(@NetAddr
, NET_MAXCLIENTS
, NET_CHANS
, 0, 0);
447 if (NetHost
= nil) then
449 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + Format(_lc
[I_NET_ERR_HOST
], [Port
]));
455 NetPongSock
:= enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM
);
456 if NetPongSock
<> ENET_SOCKET_NULL
then
458 NetPongAddr
.host
:= IPAddr
;
459 NetPongAddr
.port
:= NET_PING_PORT
;
460 if enet_socket_bind(NetPongSock
, @NetPongAddr
) < 0 then
462 enet_socket_destroy(NetPongSock
);
463 NetPongSock
:= ENET_SOCKET_NULL
;
466 enet_socket_set_option(NetPongSock
, ENET_SOCKOPT_NONBLOCK
, 1);
469 NetMode
:= NET_SERVER
;
471 NetBuf
[NET_UNRELIABLE
].Clear();
472 NetBuf
[NET_RELIABLE
].Clear();
478 procedure g_Net_Host_Die();
482 if NetMode
<> NET_SERVER
then Exit
;
484 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_HOST_DISCALL
]);
485 for I
:= 0 to High(NetClients
) do
486 if NetClients
[I
].Used
then
487 enet_peer_disconnect(NetClients
[I
].Peer
, NET_DISC_DOWN
);
489 while enet_host_service(NetHost
, @NetEvent
, 1000) > 0 do
490 if NetEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
then
491 enet_packet_destroy(NetEvent
.packet
);
493 for I
:= 0 to High(NetClients
) do
494 if NetClients
[I
].Used
then
496 FreeMemory(NetClients
[I
].Peer
^.data
);
497 NetClients
[I
].Peer
^.data
:= nil;
498 enet_peer_reset(NetClients
[I
].Peer
);
499 NetClients
[I
].Peer
:= nil;
500 NetClients
[I
].Used
:= False;
501 NetClients
[I
].NetOut
[NET_UNRELIABLE
].Free();
502 NetClients
[I
].NetOut
[NET_RELIABLE
].Free();
505 if (NetMPeer
<> nil) and (NetMHost
<> nil) then g_Net_Slist_Disconnect
;
506 if NetPongSock
<> ENET_SOCKET_NULL
then
507 enet_socket_destroy(NetPongSock
);
509 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_HOST_DIE
]);
510 enet_host_destroy(NetHost
);
515 e_WriteLog('NET: Server stopped', TMsgType
.Notify
);
519 procedure g_Net_Host_Send(ID
: Integer; Reliable
: Boolean; Chan
: Byte = NET_CHAN_GAME
);
530 if ID
> High(NetClients
) then Exit
;
531 if NetClients
[ID
].Peer
= nil then Exit
;
533 NetClients
[ID
].NetOut
[T
].Write(Integer(NetOut
.CurSize
));
534 NetClients
[ID
].NetOut
[T
].Write(NetOut
);
539 NetBuf
[T
].Write(Integer(NetOut
.CurSize
));
540 NetBuf
[T
].Write(NetOut
);
543 if NetDump
then g_Net_DumpSendBuffer();
547 procedure g_Net_Host_CheckPings();
553 Ping
: array [0..9] of Byte;
556 if NetPongSock
= ENET_SOCKET_NULL
then Exit
;
558 Buf
.data
:= Addr(Ping
[0]);
559 Buf
.dataLength
:= 2+8;
563 Len
:= enet_socket_receive(NetPongSock
, @ClAddr
, @Buf
, 1);
564 if Len
< 0 then Exit
;
566 if (Ping
[0] = Ord('D')) and (Ping
[1] = Ord('F')) then
568 ClTime
:= Int64(Addr(Ping
[2])^);
571 NetOut
.Write(Byte(Ord('D')));
572 NetOut
.Write(Byte(Ord('F')));
573 NetOut
.Write(NetPort
);
574 NetOut
.Write(ClTime
);
575 g_Net_Slist_WriteInfo();
577 if gPlayer1
<> nil then Inc(NPl
);
578 if gPlayer2
<> nil then Inc(NPl
);
580 NetOut
.Write(gNumBots
);
582 Buf
.data
:= NetOut
.Data
;
583 Buf
.dataLength
:= NetOut
.CurSize
;
584 enet_socket_send(NetPongSock
, @ClAddr
, @Buf
, 1);
590 function g_Net_Host_Update(): enet_size_t
;
603 g_Net_Host_CheckPings
;
605 while (enet_host_service(NetHost
, @NetEvent
, 0) > 0) do
607 case (NetEvent
.kind
) of
608 ENET_EVENT_TYPE_CONNECT
:
610 IP
:= IpToStr(NetEvent
.Peer
^.address
.host
);
611 Port
:= NetEvent
.Peer
^.address
.port
;
612 g_Console_Add(_lc
[I_NET_MSG
] +
613 Format(_lc
[I_NET_MSG_HOST_CONN
], [IP
, Port
]));
615 if (NetEvent
.data
<> NET_PROTOCOL_VER
) then
617 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_HOST_REJECT
] +
618 _lc
[I_NET_DISC_PROTOCOL
]);
619 NetEvent
.peer
^.data
:= GetMemory(SizeOf(Byte));
620 Byte(NetEvent
.peer
^.data
^) := 255;
621 enet_peer_disconnect(NetEvent
.peer
, NET_DISC_PROTOCOL
);
622 enet_host_flush(NetHost
);
626 ID
:= g_Net_FindSlot();
630 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_HOST_REJECT
] +
631 _lc
[I_NET_DISC_FULL
]);
632 NetEvent
.Peer
^.data
:= GetMemory(SizeOf(Byte));
633 Byte(NetEvent
.peer
^.data
^) := 255;
634 enet_peer_disconnect(NetEvent
.peer
, NET_DISC_FULL
);
635 enet_host_flush(NetHost
);
639 NetClients
[ID
].Peer
:= NetEvent
.peer
;
640 NetClients
[ID
].Peer
^.data
:= GetMemory(SizeOf(Byte));
641 Byte(NetClients
[ID
].Peer
^.data
^) := ID
;
642 NetClients
[ID
].State
:= NET_STATE_AUTH
;
643 NetClients
[ID
].RCONAuth
:= False;
644 NetClients
[ID
].NetOut
[NET_UNRELIABLE
].Alloc(NET_BUFSIZE
*2);
645 NetClients
[ID
].NetOut
[NET_RELIABLE
].Alloc(NET_BUFSIZE
*2);
647 enet_peer_timeout(NetEvent
.peer
, ENET_PEER_TIMEOUT_LIMIT
* 2, ENET_PEER_TIMEOUT_MINIMUM
* 2, ENET_PEER_TIMEOUT_MAXIMUM
* 2);
650 g_Console_Add(_lc
[I_NET_MSG
] + Format(_lc
[I_NET_MSG_HOST_ADD
], [ID
]));
653 ENET_EVENT_TYPE_RECEIVE
:
655 ID
:= Byte(NetEvent
.peer
^.data
^);
656 if ID
> High(NetClients
) then Exit
;
657 TC
:= @NetClients
[ID
];
659 if NetDump
then g_Net_DumpRecvBuffer(NetEvent
.packet
^.data
, NetEvent
.packet
^.dataLength
);
660 g_Net_Host_HandlePacket(TC
, NetEvent
.packet
, g_Net_HostMsgHandler
);
663 ENET_EVENT_TYPE_DISCONNECT
:
665 ID
:= Byte(NetEvent
.peer
^.data
^);
666 if ID
> High(NetClients
) then Exit
;
667 TC
:= @NetClients
[ID
];
668 if TC
= nil then Exit
;
670 if not (TC
^.Used
) then Exit
;
672 TP
:= g_Player_Get(TC
^.Player
);
677 TP
.Kill(K_SIMPLEKILL
, 0, HIT_DISCON
);
678 g_Console_Add(Format(_lc
[I_PLAYER_LEAVE
], [TP
.Name
]), True);
679 e_WriteLog('NET: Client ' + TP
.Name
+ ' [' + IntToStr(ID
) + '] disconnected.', TMsgType
.Notify
);
680 g_Player_Remove(TP
.UID
);
684 TC
^.State
:= NET_STATE_NONE
;
687 TC
^.RequestedFullUpdate
:= False;
688 TC
^.NetOut
[NET_UNRELIABLE
].Free();
689 TC
^.NetOut
[NET_RELIABLE
].Free();
691 FreeMemory(NetEvent
.peer
^.data
);
692 NetEvent
.peer
^.data
:= nil;
693 g_Console_Add(_lc
[I_NET_MSG
] + Format(_lc
[I_NET_MSG_HOST_DISC
], [ID
]));
696 if NetUseMaster
then g_Net_Slist_Update
;
703 { /// CLIENT FUNCTIONS /// }
706 procedure g_Net_Disconnect(Forced
: Boolean = False);
708 if NetMode
<> NET_CLIENT
then Exit
;
709 if (NetHost
= nil) or (NetPeer
= nil) then Exit
;
713 enet_peer_disconnect(NetPeer
, NET_DISC_NONE
);
715 while (enet_host_service(NetHost
, @NetEvent
, 1500) > 0) do
717 if (NetEvent
.kind
= ENET_EVENT_TYPE_DISCONNECT
) then
723 if (NetEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
) then
724 enet_packet_destroy(NetEvent
.packet
);
727 if NetPeer
<> nil then
729 enet_peer_reset(NetPeer
);
735 e_WriteLog('NET: Kicked from server: ' + IntToStr(NetEvent
.data
), TMsgType
.Notify
);
736 if (NetEvent
.data
<= NET_DISC_MAX
) then
737 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_KICK
] +
738 _lc
[TStrings_Locale(Cardinal(I_NET_DISC_NONE
) + NetEvent
.data
)], True);
741 if NetHost
<> nil then
743 enet_host_destroy(NetHost
);
746 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_CLIENT_DISC
]);
749 e_WriteLog('NET: Disconnected', TMsgType
.Notify
);
752 procedure g_Net_Client_Send(Reliable
: Boolean; Chan
: Byte = NET_CHAN_GAME
);
762 NetBuf
[T
].Write(Integer(NetOut
.CurSize
));
763 NetBuf
[T
].Write(NetOut
);
765 if NetDump
then g_Net_DumpSendBuffer();
767 g_Net_Flush(); // FIXME: for now, send immediately
770 function g_Net_Client_Update(): enet_size_t
;
773 while (enet_host_service(NetHost
, @NetEvent
, 0) > 0) do
775 case NetEvent
.kind
of
776 ENET_EVENT_TYPE_RECEIVE
:
778 if NetDump
then g_Net_DumpRecvBuffer(NetEvent
.packet
^.data
, NetEvent
.packet
^.dataLength
);
779 g_Net_Client_HandlePacket(NetEvent
.packet
, g_Net_ClientMsgHandler
);
782 ENET_EVENT_TYPE_DISCONNECT
:
784 g_Net_Disconnect(True);
792 function g_Net_Client_UpdateWhileLoading(): enet_size_t
;
795 while (enet_host_service(NetHost
, @NetEvent
, 0) > 0) do
797 case NetEvent
.kind
of
798 ENET_EVENT_TYPE_RECEIVE
:
800 if NetDump
then g_Net_DumpRecvBuffer(NetEvent
.packet
^.data
, NetEvent
.packet
^.dataLength
);
801 g_Net_Client_HandlePacket(NetEvent
.packet
, g_Net_ClientLightMsgHandler
);
804 ENET_EVENT_TYPE_DISCONNECT
:
806 g_Net_Disconnect(True);
815 function g_Net_Connect(IP
: string; Port
: enet_uint16
): Boolean;
818 TimeoutTime
, T
: Int64;
820 if NetMode
<> NET_NONE
then
822 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_ERR_INGAME
], True);
829 g_Console_Add(_lc
[I_NET_MSG
] + Format(_lc
[I_NET_MSG_CLIENT_CONN
],
831 if not NetInitDone
then
833 if (not g_Net_Init()) then
835 g_Console_Add(_lc
[I_NET_MSG_FERROR
] + _lc
[I_NET_ERR_ENET
], True);
843 NetHost
:= enet_host_create(nil, 1, NET_CHANS
, 0, 0);
845 if (NetHost
= nil) then
847 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CLIENT
], True);
853 enet_address_set_host(@NetAddr
, PChar(Addr(IP
[1])));
854 NetAddr
.port
:= Port
;
856 NetPeer
:= enet_host_connect(NetHost
, @NetAddr
, NET_CHANS
, NET_PROTOCOL_VER
);
858 if (NetPeer
= nil) then
860 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CLIENT
], True);
861 enet_host_destroy(NetHost
);
867 // предупредить что ждем слишком долго через N секунд
868 TimeoutTime
:= GetTimer() + NET_CONNECT_TIMEOUT
;
873 while (enet_host_service(NetHost
, @NetEvent
, 0) > 0) do
875 if (NetEvent
.kind
= ENET_EVENT_TYPE_CONNECT
) then
877 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_CLIENT_DONE
]);
878 NetMode
:= NET_CLIENT
;
880 enet_peer_timeout(NetPeer
, ENET_PEER_TIMEOUT_LIMIT
* 2, ENET_PEER_TIMEOUT_MINIMUM
* 2, ENET_PEER_TIMEOUT_MAXIMUM
* 2);
882 NetClientPort
:= Port
;
890 if T
> TimeoutTime
then
892 TimeoutTime
:= T
+ NET_CONNECT_TIMEOUT
* 100; // одного предупреждения хватит
893 g_Console_Add(_lc
[I_NET_MSG_TIMEOUT_WARN
], True);
894 g_Console_Add(Format(_lc
[I_NET_MSG_PORTS
], [Integer(Port
), Integer(NET_PING_PORT
)]), True);
897 ProcessLoading(true);
899 if e_KeyPressed(IK_SPACE
) or e_KeyPressed(IK_ESCAPE
) or e_KeyPressed(VK_ESCAPE
) or
900 e_KeyPressed(JOY0_JUMP
) or e_KeyPressed(JOY1_JUMP
) or e_KeyPressed(JOY2_JUMP
) or e_KeyPressed(JOY3_JUMP
) then
904 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_TIMEOUT
], True);
905 g_Console_Add(Format(_lc
[I_NET_MSG_PORTS
], [Integer(Port
), Integer(NET_PING_PORT
)]), True);
906 if NetPeer
<> nil then enet_peer_reset(NetPeer
);
907 if NetHost
<> nil then
909 enet_host_destroy(NetHost
);
916 function IpToStr(IP
: LongWord): string;
921 Result
:= IntToStr(PByte(Ptr
+ 0)^) + '.';
922 Result
:= Result
+ IntToStr(PByte(Ptr
+ 1)^) + '.';
923 Result
:= Result
+ IntToStr(PByte(Ptr
+ 2)^) + '.';
924 Result
:= Result
+ IntToStr(PByte(Ptr
+ 3)^);
927 function StrToIp(IPstr
: string; var IP
: LongWord): Boolean;
931 Result
:= enet_address_set_host(@EAddr
, PChar(@IPstr
[1])) = 0;
935 function g_Net_Client_ByName(Name
: string): pTNetClient
;
941 for a
:= Low(NetClients
) to High(NetClients
) do
942 if (NetClients
[a
].Used
) and (NetClients
[a
].State
= NET_STATE_GAME
) then
944 pl
:= g_Player_Get(NetClients
[a
].Player
);
945 if pl
= nil then continue
;
946 if Copy(LowerCase(pl
.Name
), 1, Length(Name
)) <> LowerCase(Name
) then continue
;
947 if NetClients
[a
].Peer
<> nil then
949 Result
:= @NetClients
[a
];
955 function g_Net_Client_ByPlayer(PID
: Word): pTNetClient
;
960 for a
:= Low(NetClients
) to High(NetClients
) do
961 if (NetClients
[a
].Used
) and (NetClients
[a
].State
= NET_STATE_GAME
) then
962 if NetClients
[a
].Player
= PID
then
964 Result
:= @NetClients
[a
];
969 function g_Net_ClientName_ByID(ID
: Integer): string;
975 if ID
= NET_EVERYONE
then
977 for a
:= Low(NetClients
) to High(NetClients
) do
978 if (NetClients
[a
].ID
= ID
) and (NetClients
[a
].Used
) and (NetClients
[a
].State
= NET_STATE_GAME
) then
980 pl
:= g_Player_Get(NetClients
[a
].Player
);
981 if pl
= nil then Exit
;
986 procedure g_Net_SendData(Data
: AByte
; peer
: pENetPeer
; Reliable
: Boolean; Chan
: Byte = NET_CHAN_DOWNLOAD
);
990 dataLength
: Cardinal;
992 dataLength
:= Length(Data
);
995 F
:= LongWord(ENET_PACKET_FLAG_RELIABLE
)
999 if (peer
<> nil) then
1001 P
:= enet_packet_create(@Data
[0], dataLength
, F
);
1002 if not Assigned(P
) then Exit
;
1003 enet_peer_send(peer
, Chan
, P
);
1007 P
:= enet_packet_create(@Data
[0], dataLength
, F
);
1008 if not Assigned(P
) then Exit
;
1009 enet_host_broadcast(NetHost
, Chan
, P
);
1012 enet_host_flush(NetHost
);
1015 function UserRequestExit
: Boolean;
1017 Result
:= e_KeyPressed(IK_SPACE
) or
1018 e_KeyPressed(IK_ESCAPE
) or
1019 e_KeyPressed(VK_ESCAPE
) or
1020 e_KeyPressed(JOY0_JUMP
) or
1021 e_KeyPressed(JOY1_JUMP
) or
1022 e_KeyPressed(JOY2_JUMP
) or
1023 e_KeyPressed(JOY3_JUMP
)
1026 function g_Net_Wait_Event(msgId
: Word): TMemoryStream
;
1031 stream
: TMemoryStream
;
1034 FillChar(ev
, SizeOf(ev
), 0);
1037 status
:= enet_host_service(NetHost
, @ev
, Trunc(g_Net_DownloadTimeout
* 1000));
1041 ENET_EVENT_TYPE_RECEIVE
:
1043 Ptr
:= ev
.packet
^.data
;
1044 rMsgId
:= Byte(Ptr
^);
1045 if rMsgId
= msgId
then
1047 stream
:= TMemoryStream
.Create
;
1048 stream
.SetSize(ev
.packet
^.dataLength
);
1049 stream
.WriteBuffer(Ptr
^, ev
.packet
^.dataLength
);
1050 stream
.Seek(0, soFromBeginning
);
1051 status
:= 1 (* received *)
1055 (* looks that game state always received, so ignore it *)
1056 e_LogWritefln('g_Net_Wait_Event(%s): skip message %s', [msgId
, rMsgId
]);
1057 status
:= 2 (* continue *)
1060 ENET_EVENT_TYPE_DISCONNECT
:
1062 if (ev
.data
<= NET_DISC_MAX
) then
1063 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CONN
] + ' ' + _lc
[TStrings_Locale(Cardinal(I_NET_DISC_NONE
) + ev
.data
)], True);
1064 status
:= -2 (* error: disconnected *)
1067 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CONN
] + ' unknown ENet event ' + IntToStr(Ord(ev
.kind
)), True);
1068 status
:= -3 (* error: unknown event *)
1070 enet_packet_destroy(ev
.packet
)
1074 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CONN
] + ' timeout reached', True);
1075 status
:= 0 (* error: timeout *)
1077 ProcessLoading(true);
1078 until (status
<> 2) or UserRequestExit();
1082 function g_Net_IsHostBanned(IP
: LongWord; Perm
: Boolean = False): Boolean;
1087 if NetBannedHosts
= nil then
1089 for I
:= 0 to High(NetBannedHosts
) do
1090 if (NetBannedHosts
[I
].IP
= IP
) and ((not Perm
) or (NetBannedHosts
[I
].Perm
)) then
1097 procedure g_Net_BanHost(IP
: LongWord; Perm
: Boolean = True); overload
;
1103 if g_Net_IsHostBanned(IP
, Perm
) then
1107 for I
:= Low(NetBannedHosts
) to High(NetBannedHosts
) do
1108 if NetBannedHosts
[I
].IP
= 0 then
1116 SetLength(NetBannedHosts
, Length(NetBannedHosts
) + 1);
1117 P
:= High(NetBannedHosts
);
1120 NetBannedHosts
[P
].IP
:= IP
;
1121 NetBannedHosts
[P
].Perm
:= Perm
;
1124 procedure g_Net_BanHost(IP
: string; Perm
: Boolean = True); overload
;
1129 b
:= StrToIp(IP
, a
);
1131 g_Net_BanHost(a
, Perm
);
1134 procedure g_Net_UnbanNonPermHosts();
1138 if NetBannedHosts
= nil then
1140 for I
:= Low(NetBannedHosts
) to High(NetBannedHosts
) do
1141 if (NetBannedHosts
[I
].IP
> 0) and not NetBannedHosts
[I
].Perm
then
1143 NetBannedHosts
[I
].IP
:= 0;
1144 NetBannedHosts
[I
].Perm
:= True;
1148 function g_Net_UnbanHost(IP
: string): Boolean; overload
;
1152 Result
:= StrToIp(IP
, a
);
1154 Result
:= g_Net_UnbanHost(a
);
1157 function g_Net_UnbanHost(IP
: LongWord): Boolean; overload
;
1164 if NetBannedHosts
= nil then
1166 for I
:= 0 to High(NetBannedHosts
) do
1167 if NetBannedHosts
[I
].IP
= IP
then
1169 NetBannedHosts
[I
].IP
:= 0;
1170 NetBannedHosts
[I
].Perm
:= True;
1172 // no break here to clear all bans of this host, perm and non-perm
1176 procedure g_Net_SaveBanList();
1181 Assign(F
, DataDir
+ BANLIST_FILENAME
);
1183 if NetBannedHosts
<> nil then
1184 for I
:= 0 to High(NetBannedHosts
) do
1185 if NetBannedHosts
[I
].Perm
and (NetBannedHosts
[I
].IP
> 0) then
1186 Writeln(F
, IpToStr(NetBannedHosts
[I
].IP
));
1190 procedure g_Net_DumpStart();
1192 if NetMode
= NET_SERVER
then
1193 NetDumpFile
:= createDiskFile(NETDUMP_FILENAME
+ '_server')
1195 NetDumpFile
:= createDiskFile(NETDUMP_FILENAME
+ '_client');
1198 procedure g_Net_DumpSendBuffer();
1200 writeInt(NetDumpFile
, gTime
);
1201 writeInt(NetDumpFile
, LongWord(NetOut
.CurSize
));
1202 writeInt(NetDumpFile
, Byte(1));
1203 NetDumpFile
.WriteBuffer(NetOut
.Data
^, NetOut
.CurSize
);
1206 procedure g_Net_DumpRecvBuffer(Buf
: penet_uint8
; Len
: LongWord);
1208 if (Buf
= nil) or (Len
= 0) then Exit
;
1209 writeInt(NetDumpFile
, gTime
);
1210 writeInt(NetDumpFile
, Len
);
1211 writeInt(NetDumpFile
, Byte(0));
1212 NetDumpFile
.WriteBuffer(Buf
^, Len
);
1215 procedure g_Net_DumpEnd();
1221 function g_Net_ForwardPorts(ForwardPongPort
: Boolean = True): Boolean;
1222 {$IFDEF USE_MINIUPNPC}
1227 LanAddr
: array [0..255] of Char;
1228 StrPort
: AnsiString;
1233 if NetPortForwarded
= NetPort
then
1239 NetPongForwarded
:= False;
1240 NetPortForwarded
:= 0;
1242 DevList
:= upnpDiscover(1000, nil, nil, 0, 0, 2, Addr(Err
));
1243 if DevList
= nil then
1245 conwritefln('port forwarding failed: upnpDiscover() failed: %d', [Err
]);
1249 I
:= UPNP_GetValidIGD(DevList
, @Urls
, @Data
, Addr(LanAddr
[0]), 256);
1253 conwriteln('port forwarding failed: could not find an IGD device on this LAN');
1254 FreeUPNPDevList(DevList
);
1255 FreeUPNPUrls(@Urls
);
1259 StrPort
:= IntToStr(NetPort
);
1260 I
:= UPNP_AddPortMapping(
1261 Urls
.controlURL
, Addr(data
.first
.servicetype
[1]),
1262 PChar(StrPort
), PChar(StrPort
), Addr(LanAddr
[0]), PChar('D2DF'),
1263 PChar('UDP'), nil, PChar('0')
1268 conwritefln('forwarding port %d failed: error %d', [NetPort
, I
]);
1269 FreeUPNPDevList(DevList
);
1270 FreeUPNPUrls(@Urls
);
1274 if ForwardPongPort
then
1276 StrPort
:= IntToStr(NET_PING_PORT
);
1277 I
:= UPNP_AddPortMapping(
1278 Urls
.controlURL
, Addr(data
.first
.servicetype
[1]),
1279 PChar(StrPort
), PChar(StrPort
), Addr(LanAddr
[0]), PChar('D2DF'),
1280 PChar('UDP'), nil, PChar('0')
1285 conwritefln('forwarding port %d failed: error %d', [NetPort
+ 1, I
]);
1286 NetPongForwarded
:= False;
1290 conwritefln('forwarded port %d successfully', [NetPort
+ 1]);
1291 NetPongForwarded
:= True;
1295 conwritefln('forwarded port %d successfully', [NetPort
]);
1296 NetIGDControl
:= AnsiString(Urls
.controlURL
);
1297 NetIGDService
:= data
.first
.servicetype
;
1298 NetPortForwarded
:= NetPort
;
1300 FreeUPNPDevList(DevList
);
1301 FreeUPNPUrls(@Urls
);
1310 procedure g_Net_UnforwardPorts();
1311 {$IFDEF USE_MINIUPNPC}
1314 StrPort
: AnsiString;
1316 if NetPortForwarded
= 0 then Exit
;
1318 conwriteln('unforwarding ports...');
1320 StrPort
:= IntToStr(NetPortForwarded
);
1321 I
:= UPNP_DeletePortMapping(
1322 PChar(NetIGDControl
), Addr(NetIGDService
[1]),
1323 PChar(StrPort
), PChar('UDP'), nil
1325 conwritefln(' port %d: %d', [NetPortForwarded
, I
]);
1327 if NetPongForwarded
then
1329 NetPongForwarded
:= False;
1330 StrPort
:= IntToStr(NetPortForwarded
+ 1);
1331 I
:= UPNP_DeletePortMapping(
1332 PChar(NetIGDControl
), Addr(NetIGDService
[1]),
1333 PChar(StrPort
), PChar('UDP'), nil
1335 conwritefln(' port %d: %d', [NetPortForwarded
+ 1, I
]);
1338 NetPortForwarded
:= 0;
1346 conRegVar('cl_downloadtimeout', @g_Net_DownloadTimeout
, 0.0, 1000000.0, '', 'timeout in seconds, 0 to disable it');
1347 g_Net_DownloadTimeout
:= 60;
1348 NetIn
.Alloc(NET_BUFSIZE
);
1349 NetOut
.Alloc(NET_BUFSIZE
);
1350 NetBuf
[NET_UNRELIABLE
].Alloc(NET_BUFSIZE
*2);
1351 NetBuf
[NET_RELIABLE
].Alloc(NET_BUFSIZE
*2);
1355 NetBuf
[NET_UNRELIABLE
].Free();
1356 NetBuf
[NET_RELIABLE
].Free();