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
= 178;
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;
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;
66 BANLIST_FILENAME
= 'banlist.txt';
67 NETDUMP_FILENAME
= 'netdump';
82 RequestedFullUpdate
: Boolean;
90 pTNetClient
= ^TNetClient
;
92 AByte
= array of Byte;
95 NetInitDone
: Boolean = False;
96 NetMode
: Byte = NET_NONE
;
97 NetDump
: Boolean = False;
99 NetServerName
: string = 'Unnamed Server';
100 NetPassword
: string = '';
101 NetPort
: Word = 25666;
103 NetAllowRCON
: Boolean = False;
104 NetRCONPassword
: string = '';
106 NetTimeToUpdate
: Cardinal = 0;
107 NetTimeToReliable
: Cardinal = 0;
108 NetTimeToMaster
: Cardinal = 0;
110 NetHost
: pENetHost
= nil;
111 NetPeer
: pENetPeer
= nil;
113 NetAddr
: ENetAddress
;
115 NetPongAddr
: ENetAddress
;
116 NetPongSock
: ENetSocket
= ENET_SOCKET_NULL
;
118 NetUseMaster
: Boolean = True;
119 NetSlistAddr
: ENetAddress
;
120 NetSlistIP
: string = 'mpms.doom2d.org';
121 NetSlistPort
: Word = 25665;
123 NetClientIP
: string = '127.0.0.1';
124 NetClientPort
: Word = 25666;
128 NetClients
: array of TNetClient
;
129 NetClientCount
: Byte = 0;
130 NetMaxClients
: Byte = 255;
131 NetBannedHosts
: array of TBanRecord
;
133 NetState
: Integer = NET_STATE_NONE
;
135 NetMyID
: Integer = -1;
136 NetPlrUID1
: Integer = -1;
137 NetPlrUID2
: Integer = -1;
139 NetInterpLevel
: Integer = 1;
140 NetUpdateRate
: Cardinal = 0; // as soon as possible
141 NetRelupdRate
: Cardinal = 18; // around two times a second
142 NetMasterRate
: Cardinal = 60000;
144 NetForcePlayerUpdate
: Boolean = False;
145 NetPredictSelf
: Boolean = True;
146 NetForwardPorts
: Boolean = False;
148 NetGotEverything
: Boolean = False;
149 NetGotKeys
: Boolean = False;
151 {$IFDEF USE_MINIUPNPC}
152 NetPortForwarded
: Word = 0;
153 NetPongForwarded
: Boolean = False;
154 NetIGDControl
: AnsiString;
155 NetIGDService
: TURLStr
;
158 NetPortThread
: TThreadID
= NilThreadId
;
160 NetDumpFile
: TStream
;
162 function g_Net_Init(): Boolean;
163 procedure g_Net_Cleanup();
164 procedure g_Net_Free();
165 procedure g_Net_Flush();
167 function g_Net_Host(IPAddr
: LongWord; Port
: enet_uint16
; MaxClients
: Cardinal = 16): Boolean;
168 procedure g_Net_Host_Die();
169 procedure g_Net_Host_Send(ID
: Integer; Reliable
: Boolean; Chan
: Byte = NET_CHAN_GAME
);
170 function g_Net_Host_Update(): enet_size_t
;
172 function g_Net_Connect(IP
: string; Port
: enet_uint16
): Boolean;
173 procedure g_Net_Disconnect(Forced
: Boolean = False);
174 procedure g_Net_Client_Send(Reliable
: Boolean; Chan
: Byte = NET_CHAN_GAME
);
175 function g_Net_Client_Update(): enet_size_t
;
176 function g_Net_Client_UpdateWhileLoading(): enet_size_t
;
178 function g_Net_Client_ByName(Name
: string): pTNetClient
;
179 function g_Net_Client_ByPlayer(PID
: Word): pTNetClient
;
180 function g_Net_ClientName_ByID(ID
: Integer): string;
182 procedure g_Net_SendData(Data
: AByte
; peer
: pENetPeer
; Reliable
: Boolean; Chan
: Byte = NET_CHAN_DOWNLOAD
);
183 function g_Net_Wait_Event(msgId
: Word): TMemoryStream
;
185 function IpToStr(IP
: LongWord): string;
186 function StrToIp(IPstr
: string; var IP
: LongWord): Boolean;
188 function g_Net_IsHostBanned(IP
: LongWord; Perm
: Boolean = False): Boolean;
189 procedure g_Net_BanHost(IP
: LongWord; Perm
: Boolean = True); overload
;
190 procedure g_Net_BanHost(IP
: string; Perm
: Boolean = True); overload
;
191 function g_Net_UnbanHost(IP
: string): Boolean; overload
;
192 function g_Net_UnbanHost(IP
: LongWord): Boolean; overload
;
193 procedure g_Net_UnbanNonPermHosts();
194 procedure g_Net_SaveBanList();
196 procedure g_Net_DumpStart();
197 procedure g_Net_DumpSendBuffer();
198 procedure g_Net_DumpRecvBuffer(Buf
: penet_uint8
; Len
: LongWord);
199 procedure g_Net_DumpEnd();
201 function g_Net_ForwardPorts(ForwardPongPort
: Boolean = True): Boolean;
202 procedure g_Net_UnforwardPorts();
208 e_input
, g_nethandler
, g_netmsg
, g_netmaster
, g_player
, g_window
, g_console
,
209 g_main
, g_game
, g_language
, g_weapons
, utils
;
212 { /// SERVICE FUNCTIONS /// }
215 function g_Net_FindSlot(): Integer;
224 for I
:= Low(NetClients
) to High(NetClients
) do
226 if NetClients
[I
].Used
then
235 if C
>= NetMaxClients
then
243 if (Length(NetClients
) >= NetMaxClients
) then
247 SetLength(NetClients
, Length(NetClients
) + 1);
248 N
:= High(NetClients
);
254 NetClients
[N
].Used
:= True;
255 NetClients
[N
].ID
:= N
;
256 NetClients
[N
].RequestedFullUpdate
:= False;
257 NetClients
[N
].RCONAuth
:= False;
258 NetClients
[N
].Voted
:= False;
259 NetClients
[N
].Player
:= 0;
265 function g_Net_Init(): Boolean;
273 SetLength(NetClients
, 0);
279 NetAddr
.port
:= 25666;
280 SetLength(NetBannedHosts
, 0);
281 if FileExists(DataDir
+ BANLIST_FILENAME
) then
283 Assign(F
, DataDir
+ BANLIST_FILENAME
);
288 if StrToIp(IPstr
, IP
) then
295 Result
:= (enet_initialize() = 0);
298 procedure g_Net_Flush();
300 enet_host_flush(NetHost
);
303 procedure g_Net_Cleanup();
308 SetLength(NetClients
, 0);
318 NetState
:= NET_STATE_NONE
;
320 NetPongSock
:= ENET_SOCKET_NULL
;
322 NetTimeToMaster
:= 0;
323 NetTimeToUpdate
:= 0;
324 NetTimeToReliable
:= 0;
328 if NetPortThread
<> NilThreadId
then
329 WaitForThreadTerminate(NetPortThread
, 66666);
331 NetPortThread
:= NilThreadId
;
332 g_Net_UnforwardPorts();
338 procedure g_Net_Free();
343 NetInitDone
:= False;
347 { /// SERVER FUNCTIONS /// }
350 function ForwardThread(Param
: Pointer): PtrInt
;
353 if not g_Net_ForwardPorts() then Result
:= -1;
356 function g_Net_Host(IPAddr
: LongWord; Port
: enet_uint16
; MaxClients
: Cardinal = 16): Boolean;
358 if NetMode
<> NET_NONE
then
360 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_INGAME
]);
367 g_Console_Add(_lc
[I_NET_MSG
] + Format(_lc
[I_NET_MSG_HOST
], [Port
]));
368 if not NetInitDone
then
370 if (not g_Net_Init()) then
372 g_Console_Add(_lc
[I_NET_MSG_FERROR
] + _lc
[I_NET_ERR_ENET
]);
380 NetAddr
.host
:= IPAddr
;
381 NetAddr
.port
:= Port
;
383 if NetForwardPorts
then NetPortThread
:= BeginThread(ForwardThread
);
385 NetHost
:= enet_host_create(@NetAddr
, NET_MAXCLIENTS
, NET_CHANS
, 0, 0);
387 if (NetHost
= nil) then
389 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + Format(_lc
[I_NET_ERR_HOST
], [Port
]));
395 NetPongSock
:= enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM
);
396 if NetPongSock
<> ENET_SOCKET_NULL
then
398 NetPongAddr
.host
:= IPAddr
;
399 NetPongAddr
.port
:= NET_PING_PORT
;
400 if enet_socket_bind(NetPongSock
, @NetPongAddr
) < 0 then
402 enet_socket_destroy(NetPongSock
);
403 NetPongSock
:= ENET_SOCKET_NULL
;
406 enet_socket_set_option(NetPongSock
, ENET_SOCKOPT_NONBLOCK
, 1);
409 NetMode
:= NET_SERVER
;
416 procedure g_Net_Host_Die();
420 if NetMode
<> NET_SERVER
then Exit
;
422 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_HOST_DISCALL
]);
423 for I
:= 0 to High(NetClients
) do
424 if NetClients
[I
].Used
then
425 enet_peer_disconnect(NetClients
[I
].Peer
, NET_DISC_DOWN
);
427 while enet_host_service(NetHost
, @NetEvent
, 1000) > 0 do
428 if NetEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
then
429 enet_packet_destroy(NetEvent
.packet
);
431 for I
:= 0 to High(NetClients
) do
432 if NetClients
[I
].Used
then
434 FreeMemory(NetClients
[I
].Peer
^.data
);
435 NetClients
[I
].Peer
^.data
:= nil;
436 enet_peer_reset(NetClients
[I
].Peer
);
437 NetClients
[I
].Peer
:= nil;
438 NetClients
[I
].Used
:= False;
441 if (NetMPeer
<> nil) and (NetMHost
<> nil) then g_Net_Slist_Disconnect
;
442 if NetPongSock
<> ENET_SOCKET_NULL
then
443 enet_socket_destroy(NetPongSock
);
445 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_HOST_DIE
]);
446 enet_host_destroy(NetHost
);
451 e_WriteLog('NET: Server stopped', TMsgType
.Notify
);
455 procedure g_Net_Host_Send(ID
: Integer; Reliable
: Boolean; Chan
: Byte = NET_CHAN_GAME
);
461 F
:= LongWord(ENET_PACKET_FLAG_RELIABLE
)
467 if ID
> High(NetClients
) then Exit
;
468 if NetClients
[ID
].Peer
= nil then Exit
;
470 P
:= enet_packet_create(NetOut
.Data
, NetOut
.CurSize
, F
);
471 if not Assigned(P
) then Exit
;
473 enet_peer_send(NetClients
[ID
].Peer
, Chan
, P
);
477 P
:= enet_packet_create(NetOut
.Data
, NetOut
.CurSize
, F
);
478 if not Assigned(P
) then Exit
;
480 enet_host_broadcast(NetHost
, Chan
, P
);
483 if NetDump
then g_Net_DumpSendBuffer();
488 procedure g_Net_Host_CheckPings();
494 Ping
: array [0..9] of Byte;
497 if NetPongSock
= ENET_SOCKET_NULL
then Exit
;
499 Buf
.data
:= Addr(Ping
[0]);
500 Buf
.dataLength
:= 2+8;
504 Len
:= enet_socket_receive(NetPongSock
, @ClAddr
, @Buf
, 1);
505 if Len
< 0 then Exit
;
507 if (Ping
[0] = Ord('D')) and (Ping
[1] = Ord('F')) then
509 ClTime
:= Int64(Addr(Ping
[2])^);
512 NetOut
.Write(Byte(Ord('D')));
513 NetOut
.Write(Byte(Ord('F')));
514 NetOut
.Write(NetPort
);
515 NetOut
.Write(ClTime
);
516 g_Net_Slist_WriteInfo();
518 if gPlayer1
<> nil then Inc(NPl
);
519 if gPlayer2
<> nil then Inc(NPl
);
521 NetOut
.Write(gNumBots
);
523 Buf
.data
:= NetOut
.Data
;
524 Buf
.dataLength
:= NetOut
.CurSize
;
525 enet_socket_send(NetPongSock
, @ClAddr
, @Buf
, 1);
531 function g_Net_Host_Update(): enet_size_t
;
544 g_Net_Host_CheckPings
;
546 while (enet_host_service(NetHost
, @NetEvent
, 0) > 0) do
548 case (NetEvent
.kind
) of
549 ENET_EVENT_TYPE_CONNECT
:
551 IP
:= IpToStr(NetEvent
.Peer
^.address
.host
);
552 Port
:= NetEvent
.Peer
^.address
.port
;
553 g_Console_Add(_lc
[I_NET_MSG
] +
554 Format(_lc
[I_NET_MSG_HOST_CONN
], [IP
, Port
]));
556 if (NetEvent
.data
<> NET_PROTOCOL_VER
) then
558 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_HOST_REJECT
] +
559 _lc
[I_NET_DISC_PROTOCOL
]);
560 NetEvent
.peer
^.data
:= GetMemory(SizeOf(Byte));
561 Byte(NetEvent
.peer
^.data
^) := 255;
562 enet_peer_disconnect(NetEvent
.peer
, NET_DISC_PROTOCOL
);
563 enet_host_flush(NetHost
);
567 ID
:= g_Net_FindSlot();
571 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_HOST_REJECT
] +
572 _lc
[I_NET_DISC_FULL
]);
573 NetEvent
.Peer
^.data
:= GetMemory(SizeOf(Byte));
574 Byte(NetEvent
.peer
^.data
^) := 255;
575 enet_peer_disconnect(NetEvent
.peer
, NET_DISC_FULL
);
576 enet_host_flush(NetHost
);
580 NetClients
[ID
].Peer
:= NetEvent
.peer
;
581 NetClients
[ID
].Peer
^.data
:= GetMemory(SizeOf(Byte));
582 Byte(NetClients
[ID
].Peer
^.data
^) := ID
;
583 NetClients
[ID
].State
:= NET_STATE_AUTH
;
584 NetClients
[ID
].RCONAuth
:= False;
586 enet_peer_timeout(NetEvent
.peer
, ENET_PEER_TIMEOUT_LIMIT
* 2, ENET_PEER_TIMEOUT_MINIMUM
* 2, ENET_PEER_TIMEOUT_MAXIMUM
* 2);
589 g_Console_Add(_lc
[I_NET_MSG
] + Format(_lc
[I_NET_MSG_HOST_ADD
], [ID
]));
592 ENET_EVENT_TYPE_RECEIVE
:
594 ID
:= Byte(NetEvent
.peer
^.data
^);
595 if ID
> High(NetClients
) then Exit
;
596 TC
:= @NetClients
[ID
];
598 if NetDump
then g_Net_DumpRecvBuffer(NetEvent
.packet
^.data
, NetEvent
.packet
^.dataLength
);
599 g_Net_HostMsgHandler(TC
, NetEvent
.packet
);
602 ENET_EVENT_TYPE_DISCONNECT
:
604 ID
:= Byte(NetEvent
.peer
^.data
^);
605 if ID
> High(NetClients
) then Exit
;
606 TC
:= @NetClients
[ID
];
607 if TC
= nil then Exit
;
609 if not (TC
^.Used
) then Exit
;
611 TP
:= g_Player_Get(TC
^.Player
);
616 TP
.Kill(K_SIMPLEKILL
, 0, HIT_DISCON
);
617 g_Console_Add(Format(_lc
[I_PLAYER_LEAVE
], [TP
.Name
]), True);
618 e_WriteLog('NET: Client ' + TP
.Name
+ ' [' + IntToStr(ID
) + '] disconnected.', TMsgType
.Notify
);
619 g_Player_Remove(TP
.UID
);
623 TC
^.State
:= NET_STATE_NONE
;
626 TC
^.RequestedFullUpdate
:= False;
628 FreeMemory(NetEvent
.peer
^.data
);
629 NetEvent
.peer
^.data
:= nil;
630 g_Console_Add(_lc
[I_NET_MSG
] + Format(_lc
[I_NET_MSG_HOST_DISC
], [ID
]));
633 if NetUseMaster
then g_Net_Slist_Update
;
640 { /// CLIENT FUNCTIONS /// }
643 procedure g_Net_Disconnect(Forced
: Boolean = False);
645 if NetMode
<> NET_CLIENT
then Exit
;
646 if (NetHost
= nil) or (NetPeer
= nil) then Exit
;
650 enet_peer_disconnect(NetPeer
, NET_DISC_NONE
);
652 while (enet_host_service(NetHost
, @NetEvent
, 1500) > 0) do
654 if (NetEvent
.kind
= ENET_EVENT_TYPE_DISCONNECT
) then
660 if (NetEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
) then
661 enet_packet_destroy(NetEvent
.packet
);
664 if NetPeer
<> nil then
666 enet_peer_reset(NetPeer
);
672 e_WriteLog('NET: Kicked from server: ' + IntToStr(NetEvent
.data
), TMsgType
.Notify
);
673 if (NetEvent
.data
<= NET_DISC_MAX
) then
674 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_KICK
] +
675 _lc
[TStrings_Locale(Cardinal(I_NET_DISC_NONE
) + NetEvent
.data
)], True);
678 if NetHost
<> nil then
680 enet_host_destroy(NetHost
);
683 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_CLIENT_DISC
]);
686 e_WriteLog('NET: Disconnected', TMsgType
.Notify
);
689 procedure g_Net_Client_Send(Reliable
: Boolean; Chan
: Byte = NET_CHAN_GAME
);
695 F
:= LongWord(ENET_PACKET_FLAG_RELIABLE
)
699 P
:= enet_packet_create(NetOut
.Data
, NetOut
.CurSize
, F
);
700 if not Assigned(P
) then Exit
;
702 enet_peer_send(NetPeer
, Chan
, P
);
703 if NetDump
then g_Net_DumpSendBuffer();
708 function g_Net_Client_Update(): enet_size_t
;
711 while (enet_host_service(NetHost
, @NetEvent
, 0) > 0) do
713 case NetEvent
.kind
of
714 ENET_EVENT_TYPE_RECEIVE
:
716 if NetDump
then g_Net_DumpRecvBuffer(NetEvent
.packet
^.data
, NetEvent
.packet
^.dataLength
);
717 g_Net_ClientMsgHandler(NetEvent
.packet
);
720 ENET_EVENT_TYPE_DISCONNECT
:
722 g_Net_Disconnect(True);
730 function g_Net_Client_UpdateWhileLoading(): enet_size_t
;
733 while (enet_host_service(NetHost
, @NetEvent
, 0) > 0) do
735 case NetEvent
.kind
of
736 ENET_EVENT_TYPE_RECEIVE
:
738 if NetDump
then g_Net_DumpRecvBuffer(NetEvent
.packet
^.data
, NetEvent
.packet
^.dataLength
);
739 g_Net_ClientLightMsgHandler(NetEvent
.packet
);
742 ENET_EVENT_TYPE_DISCONNECT
:
744 g_Net_Disconnect(True);
753 function g_Net_Connect(IP
: string; Port
: enet_uint16
): Boolean;
757 if NetMode
<> NET_NONE
then
759 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_ERR_INGAME
], True);
766 g_Console_Add(_lc
[I_NET_MSG
] + Format(_lc
[I_NET_MSG_CLIENT_CONN
],
768 if not NetInitDone
then
770 if (not g_Net_Init()) then
772 g_Console_Add(_lc
[I_NET_MSG_FERROR
] + _lc
[I_NET_ERR_ENET
], True);
780 NetHost
:= enet_host_create(nil, 1, NET_CHANS
, 0, 0);
782 if (NetHost
= nil) then
784 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CLIENT
], True);
790 enet_address_set_host(@NetAddr
, PChar(Addr(IP
[1])));
791 NetAddr
.port
:= Port
;
793 NetPeer
:= enet_host_connect(NetHost
, @NetAddr
, NET_CHANS
, NET_PROTOCOL_VER
);
795 if (NetPeer
= nil) then
797 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CLIENT
], True);
798 enet_host_destroy(NetHost
);
807 while (enet_host_service(NetHost
, @NetEvent
, 0) > 0) do
809 if (NetEvent
.kind
= ENET_EVENT_TYPE_CONNECT
) then
811 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_CLIENT_DONE
]);
812 NetMode
:= NET_CLIENT
;
814 enet_peer_timeout(NetPeer
, ENET_PEER_TIMEOUT_LIMIT
* 2, ENET_PEER_TIMEOUT_MINIMUM
* 2, ENET_PEER_TIMEOUT_MAXIMUM
* 2);
816 NetClientPort
:= Port
;
823 ProcessLoading(true);
825 if e_KeyPressed(IK_ESCAPE
) or e_KeyPressed(IK_SPACE
) or e_KeyPressed(VK_ESCAPE
) then
829 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_TIMEOUT
], True);
830 if NetPeer
<> nil then enet_peer_reset(NetPeer
);
831 if NetHost
<> nil then
833 enet_host_destroy(NetHost
);
840 function IpToStr(IP
: LongWord): string;
845 Result
:= IntToStr(PByte(Ptr
+ 0)^) + '.';
846 Result
:= Result
+ IntToStr(PByte(Ptr
+ 1)^) + '.';
847 Result
:= Result
+ IntToStr(PByte(Ptr
+ 2)^) + '.';
848 Result
:= Result
+ IntToStr(PByte(Ptr
+ 3)^);
851 function StrToIp(IPstr
: string; var IP
: LongWord): Boolean;
855 Result
:= enet_address_set_host(@EAddr
, PChar(@IPstr
[1])) = 0;
859 function g_Net_Client_ByName(Name
: string): pTNetClient
;
865 for a
:= Low(NetClients
) to High(NetClients
) do
866 if (NetClients
[a
].Used
) and (NetClients
[a
].State
= NET_STATE_GAME
) then
868 pl
:= g_Player_Get(NetClients
[a
].Player
);
869 if pl
= nil then continue
;
870 if Copy(LowerCase(pl
.Name
), 1, Length(Name
)) <> LowerCase(Name
) then continue
;
871 if NetClients
[a
].Peer
<> nil then
873 Result
:= @NetClients
[a
];
879 function g_Net_Client_ByPlayer(PID
: Word): pTNetClient
;
884 for a
:= Low(NetClients
) to High(NetClients
) do
885 if (NetClients
[a
].Used
) and (NetClients
[a
].State
= NET_STATE_GAME
) then
886 if NetClients
[a
].Player
= PID
then
888 Result
:= @NetClients
[a
];
893 function g_Net_ClientName_ByID(ID
: Integer): string;
899 if ID
= NET_EVERYONE
then
901 for a
:= Low(NetClients
) to High(NetClients
) do
902 if (NetClients
[a
].ID
= ID
) and (NetClients
[a
].Used
) and (NetClients
[a
].State
= NET_STATE_GAME
) then
904 pl
:= g_Player_Get(NetClients
[a
].Player
);
905 if pl
= nil then Exit
;
910 procedure g_Net_SendData(Data
: AByte
; peer
: pENetPeer
; Reliable
: Boolean; Chan
: Byte = NET_CHAN_DOWNLOAD
);
914 dataLength
: Cardinal;
916 dataLength
:= Length(Data
);
919 F
:= LongWord(ENET_PACKET_FLAG_RELIABLE
)
923 if (peer
<> nil) then
925 P
:= enet_packet_create(@Data
[0], dataLength
, F
);
926 if not Assigned(P
) then Exit
;
927 enet_peer_send(peer
, Chan
, P
);
931 P
:= enet_packet_create(@Data
[0], dataLength
, F
);
932 if not Assigned(P
) then Exit
;
933 enet_host_broadcast(NetHost
, Chan
, P
);
936 enet_host_flush(NetHost
);
939 function g_Net_Wait_Event(msgId
: Word): TMemoryStream
;
941 downloadEvent
: ENetEvent
;
945 msgStream
: TMemoryStream
;
947 FillChar(downloadEvent
, SizeOf(downloadEvent
), 0);
952 while (enet_host_service(NetHost
, @downloadEvent
, 0) > 0) do
954 if (downloadEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
) then
956 Ptr
:= downloadEvent
.packet
^.data
;
960 if (MID
= msgId
) then
962 msgStream
:= TMemoryStream
.Create
;
963 msgStream
.SetSize(downloadEvent
.packet
^.dataLength
);
964 msgStream
.WriteBuffer(Ptr
^, downloadEvent
.packet
^.dataLength
);
965 msgStream
.Seek(0, soFromBeginning
);
968 enet_packet_destroy(downloadEvent
.packet
);
972 enet_packet_destroy(downloadEvent
.packet
);
976 if (downloadEvent
.kind
= ENET_EVENT_TYPE_DISCONNECT
) then
978 if (downloadEvent
.data
<= NET_DISC_MAX
) then
979 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CONN
] + ' ' +
980 _lc
[TStrings_Locale(Cardinal(I_NET_DISC_NONE
) + downloadEvent
.data
)], True);
986 ProcessLoading(true);
988 if e_KeyPressed(IK_ESCAPE
) or e_KeyPressed(IK_SPACE
) or e_KeyPressed(VK_ESCAPE
) then
994 function g_Net_IsHostBanned(IP
: LongWord; Perm
: Boolean = False): Boolean;
999 if NetBannedHosts
= nil then
1001 for I
:= 0 to High(NetBannedHosts
) do
1002 if (NetBannedHosts
[I
].IP
= IP
) and ((not Perm
) or (NetBannedHosts
[I
].Perm
)) then
1009 procedure g_Net_BanHost(IP
: LongWord; Perm
: Boolean = True); overload
;
1015 if g_Net_IsHostBanned(IP
, Perm
) then
1019 for I
:= Low(NetBannedHosts
) to High(NetBannedHosts
) do
1020 if NetBannedHosts
[I
].IP
= 0 then
1028 SetLength(NetBannedHosts
, Length(NetBannedHosts
) + 1);
1029 P
:= High(NetBannedHosts
);
1032 NetBannedHosts
[P
].IP
:= IP
;
1033 NetBannedHosts
[P
].Perm
:= Perm
;
1036 procedure g_Net_BanHost(IP
: string; Perm
: Boolean = True); overload
;
1041 b
:= StrToIp(IP
, a
);
1043 g_Net_BanHost(a
, Perm
);
1046 procedure g_Net_UnbanNonPermHosts();
1050 if NetBannedHosts
= nil then
1052 for I
:= Low(NetBannedHosts
) to High(NetBannedHosts
) do
1053 if (NetBannedHosts
[I
].IP
> 0) and not NetBannedHosts
[I
].Perm
then
1055 NetBannedHosts
[I
].IP
:= 0;
1056 NetBannedHosts
[I
].Perm
:= True;
1060 function g_Net_UnbanHost(IP
: string): Boolean; overload
;
1064 Result
:= StrToIp(IP
, a
);
1066 Result
:= g_Net_UnbanHost(a
);
1069 function g_Net_UnbanHost(IP
: LongWord): Boolean; overload
;
1076 if NetBannedHosts
= nil then
1078 for I
:= 0 to High(NetBannedHosts
) do
1079 if NetBannedHosts
[I
].IP
= IP
then
1081 NetBannedHosts
[I
].IP
:= 0;
1082 NetBannedHosts
[I
].Perm
:= True;
1084 // no break here to clear all bans of this host, perm and non-perm
1088 procedure g_Net_SaveBanList();
1093 Assign(F
, DataDir
+ BANLIST_FILENAME
);
1095 if NetBannedHosts
<> nil then
1096 for I
:= 0 to High(NetBannedHosts
) do
1097 if NetBannedHosts
[I
].Perm
and (NetBannedHosts
[I
].IP
> 0) then
1098 Writeln(F
, IpToStr(NetBannedHosts
[I
].IP
));
1102 procedure g_Net_DumpStart();
1104 if NetMode
= NET_SERVER
then
1105 NetDumpFile
:= createDiskFile(NETDUMP_FILENAME
+ '_server')
1107 NetDumpFile
:= createDiskFile(NETDUMP_FILENAME
+ '_client');
1110 procedure g_Net_DumpSendBuffer();
1112 writeInt(NetDumpFile
, gTime
);
1113 writeInt(NetDumpFile
, LongWord(NetOut
.CurSize
));
1114 writeInt(NetDumpFile
, Byte(1));
1115 NetDumpFile
.WriteBuffer(NetOut
.Data
^, NetOut
.CurSize
);
1118 procedure g_Net_DumpRecvBuffer(Buf
: penet_uint8
; Len
: LongWord);
1120 if (Buf
= nil) or (Len
= 0) then Exit
;
1121 writeInt(NetDumpFile
, gTime
);
1122 writeInt(NetDumpFile
, Len
);
1123 writeInt(NetDumpFile
, Byte(0));
1124 NetDumpFile
.WriteBuffer(Buf
^, Len
);
1127 procedure g_Net_DumpEnd();
1133 function g_Net_ForwardPorts(ForwardPongPort
: Boolean = True): Boolean;
1134 {$IFDEF USE_MINIUPNPC}
1139 LanAddr
: array [0..255] of Char;
1140 StrPort
: AnsiString;
1145 if NetPortForwarded
= NetPort
then
1151 NetPongForwarded
:= False;
1152 NetPortForwarded
:= 0;
1154 DevList
:= upnpDiscover(1000, nil, nil, 0, 0, 2, Addr(Err
));
1155 if DevList
= nil then
1157 conwritefln('port forwarding failed: upnpDiscover() failed: %d', [Err
]);
1161 I
:= UPNP_GetValidIGD(DevList
, @Urls
, @Data
, Addr(LanAddr
[0]), 256);
1165 conwriteln('port forwarding failed: could not find an IGD device on this LAN');
1166 FreeUPNPDevList(DevList
);
1167 FreeUPNPUrls(@Urls
);
1171 StrPort
:= IntToStr(NetPort
);
1172 I
:= UPNP_AddPortMapping(
1173 Urls
.controlURL
, Addr(data
.first
.servicetype
[1]),
1174 PChar(StrPort
), PChar(StrPort
), Addr(LanAddr
[0]), PChar('D2DF'),
1175 PChar('UDP'), nil, PChar('0')
1180 conwritefln('forwarding port %d failed: error %d', [NetPort
, I
]);
1181 FreeUPNPDevList(DevList
);
1182 FreeUPNPUrls(@Urls
);
1186 if ForwardPongPort
then
1188 StrPort
:= IntToStr(NET_PING_PORT
);
1189 I
:= UPNP_AddPortMapping(
1190 Urls
.controlURL
, Addr(data
.first
.servicetype
[1]),
1191 PChar(StrPort
), PChar(StrPort
), Addr(LanAddr
[0]), PChar('D2DF'),
1192 PChar('UDP'), nil, PChar('0')
1197 conwritefln('forwarding port %d failed: error %d', [NetPort
+ 1, I
]);
1198 NetPongForwarded
:= False;
1202 conwritefln('forwarded port %d successfully', [NetPort
+ 1]);
1203 NetPongForwarded
:= True;
1207 conwritefln('forwarded port %d successfully', [NetPort
]);
1208 NetIGDControl
:= AnsiString(Urls
.controlURL
);
1209 NetIGDService
:= data
.first
.servicetype
;
1210 NetPortForwarded
:= NetPort
;
1212 FreeUPNPDevList(DevList
);
1213 FreeUPNPUrls(@Urls
);
1222 procedure g_Net_UnforwardPorts();
1223 {$IFDEF USE_MINIUPNPC}
1226 StrPort
: AnsiString;
1228 if NetPortForwarded
= 0 then Exit
;
1230 conwriteln('unforwarding ports...');
1232 StrPort
:= IntToStr(NetPortForwarded
);
1233 I
:= UPNP_DeletePortMapping(
1234 PChar(NetIGDControl
), Addr(NetIGDService
[1]),
1235 PChar(StrPort
), PChar('UDP'), nil
1237 conwritefln(' port %d: %d', [NetPortForwarded
, I
]);
1239 if NetPongForwarded
then
1241 NetPongForwarded
:= False;
1242 StrPort
:= IntToStr(NetPortForwarded
+ 1);
1243 I
:= UPNP_DeletePortMapping(
1244 PChar(NetIGDControl
), Addr(NetIGDService
[1]),
1245 PChar(StrPort
), PChar('UDP'), nil
1247 conwritefln(' port %d: %d', [NetPortForwarded
+ 1, I
]);
1250 NetPortForwarded
:= 0;
1259 NetIn
.Alloc(NET_BUFSIZE
);
1260 NetOut
.Alloc(NET_BUFSIZE
);