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
= 173;
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;
50 NET_DISC_NONE
: enet_uint32
= 0;
51 NET_DISC_PROTOCOL
: enet_uint32
= 1;
52 NET_DISC_VERSION
: enet_uint32
= 2;
53 NET_DISC_FULL
: enet_uint32
= 3;
54 NET_DISC_KICK
: enet_uint32
= 4;
55 NET_DISC_DOWN
: enet_uint32
= 5;
56 NET_DISC_PASSWORD
: enet_uint32
= 6;
57 NET_DISC_TEMPBAN
: enet_uint32
= 7;
58 NET_DISC_BAN
: enet_uint32
= 8;
59 NET_DISC_MAX
: enet_uint32
= 8;
65 BANLIST_FILENAME
= 'banlist.txt';
66 NETDUMP_FILENAME
= 'netdump';
75 RequestedFullUpdate
: Boolean;
83 pTNetClient
= ^TNetClient
;
85 AByte
= array of Byte;
88 NetInitDone
: Boolean = False;
89 NetMode
: Byte = NET_NONE
;
90 NetDump
: Boolean = False;
92 NetServerName
: string = 'Unnamed Server';
93 NetPassword
: string = '';
94 NetPort
: Word = 25666;
96 NetAllowRCON
: Boolean = False;
97 NetRCONPassword
: string = '';
99 NetTimeToUpdate
: Cardinal = 0;
100 NetTimeToReliable
: Cardinal = 0;
101 NetTimeToMaster
: Cardinal = 0;
103 NetHost
: pENetHost
= nil;
104 NetPeer
: pENetPeer
= nil;
106 NetAddr
: ENetAddress
;
108 NetPongAddr
: ENetAddress
;
109 NetPongSock
: ENetSocket
= ENET_SOCKET_NULL
;
111 NetUseMaster
: Boolean = True;
112 NetSlistAddr
: ENetAddress
;
113 NetSlistIP
: string = 'mpms.doom2d.org';
114 NetSlistPort
: Word = 25665;
116 NetClientIP
: string = '127.0.0.1';
117 NetClientPort
: Word = 25666;
121 NetClients
: array of TNetClient
;
122 NetClientCount
: Byte = 0;
123 NetMaxClients
: Byte = 255;
124 NetBannedHosts
: array of TBanRecord
;
126 NetState
: Integer = NET_STATE_NONE
;
128 NetMyID
: Integer = -1;
129 NetPlrUID1
: Integer = -1;
130 NetPlrUID2
: Integer = -1;
132 NetInterpLevel
: Integer = 1;
133 NetUpdateRate
: Cardinal = 0; // as soon as possible
134 NetRelupdRate
: Cardinal = 18; // around two times a second
135 NetMasterRate
: Cardinal = 60000;
137 NetForcePlayerUpdate
: Boolean = False;
138 NetPredictSelf
: Boolean = True;
139 NetForwardPorts
: Boolean = False;
141 NetGotEverything
: Boolean = False;
142 NetGotKeys
: Boolean = False;
144 {$IFDEF USE_MINIUPNPC}
145 NetPortForwarded
: Word = 0;
146 NetPongForwarded
: Boolean = False;
147 NetIGDControl
: AnsiString;
148 NetIGDService
: TURLStr
;
151 NetDumpFile
: TStream
;
153 function g_Net_Init(): Boolean;
154 procedure g_Net_Cleanup();
155 procedure g_Net_Free();
156 procedure g_Net_Flush();
158 function g_Net_Host(IPAddr
: LongWord; Port
: enet_uint16
; MaxClients
: Cardinal = 16): Boolean;
159 procedure g_Net_Host_Die();
160 procedure g_Net_Host_Send(ID
: Integer; Reliable
: Boolean; Chan
: Byte = NET_CHAN_GAME
);
161 function g_Net_Host_Update(): enet_size_t
;
163 function g_Net_Connect(IP
: string; Port
: enet_uint16
): Boolean;
164 procedure g_Net_Disconnect(Forced
: Boolean = False);
165 procedure g_Net_Client_Send(Reliable
: Boolean; Chan
: Byte = NET_CHAN_GAME
);
166 function g_Net_Client_Update(): enet_size_t
;
167 function g_Net_Client_UpdateWhileLoading(): enet_size_t
;
169 function g_Net_Client_ByName(Name
: string): pTNetClient
;
170 function g_Net_Client_ByPlayer(PID
: Word): pTNetClient
;
171 function g_Net_ClientName_ByID(ID
: Integer): string;
173 procedure g_Net_SendData(Data
:AByte
; peer
: pENetPeer
; Reliable
: Boolean; Chan
: Byte = NET_CHAN_DOWNLOAD
);
174 function g_Net_Wait_Event(msgId
: Word): TMemoryStream
;
176 function IpToStr(IP
: LongWord): string;
177 function StrToIp(IPstr
: string; var IP
: LongWord): Boolean;
179 function g_Net_IsHostBanned(IP
: LongWord; Perm
: Boolean = False): Boolean;
180 procedure g_Net_BanHost(IP
: LongWord; Perm
: Boolean = True); overload
;
181 procedure g_Net_BanHost(IP
: string; Perm
: Boolean = True); overload
;
182 function g_Net_UnbanHost(IP
: string): Boolean; overload
;
183 function g_Net_UnbanHost(IP
: LongWord): Boolean; overload
;
184 procedure g_Net_UnbanNonPermHosts();
185 procedure g_Net_SaveBanList();
187 procedure g_Net_DumpStart();
188 procedure g_Net_DumpSendBuffer();
189 procedure g_Net_DumpRecvBuffer(Buf
: penet_uint8
; Len
: LongWord);
190 procedure g_Net_DumpEnd();
192 function g_Net_ForwardPorts(ForwardPongPort
: Boolean = True): Boolean;
193 procedure g_Net_UnforwardPorts();
199 e_input
, g_nethandler
, g_netmsg
, g_netmaster
, g_player
, g_window
, g_console
,
200 g_main
, g_game
, g_language
, g_weapons
, utils
;
203 { /// SERVICE FUNCTIONS /// }
206 function g_Net_FindSlot(): Integer;
215 for I
:= Low(NetClients
) to High(NetClients
) do
217 if NetClients
[I
].Used
then
226 if C
>= NetMaxClients
then
234 if (Length(NetClients
) >= NetMaxClients
) then
238 SetLength(NetClients
, Length(NetClients
) + 1);
239 N
:= High(NetClients
);
245 NetClients
[N
].Used
:= True;
246 NetClients
[N
].ID
:= N
;
247 NetClients
[N
].RequestedFullUpdate
:= False;
248 NetClients
[N
].RCONAuth
:= False;
249 NetClients
[N
].Voted
:= False;
250 NetClients
[N
].Player
:= 0;
256 function g_Net_Init(): Boolean;
264 SetLength(NetClients
, 0);
270 NetAddr
.port
:= 25666;
271 SetLength(NetBannedHosts
, 0);
272 if FileExists(DataDir
+ BANLIST_FILENAME
) then
274 Assign(F
, DataDir
+ BANLIST_FILENAME
);
279 if StrToIp(IPstr
, IP
) then
286 Result
:= (enet_initialize() = 0);
289 procedure g_Net_Flush();
291 enet_host_flush(NetHost
);
294 procedure g_Net_Cleanup();
299 SetLength(NetClients
, 0);
309 NetState
:= NET_STATE_NONE
;
311 NetPongSock
:= ENET_SOCKET_NULL
;
313 NetTimeToMaster
:= 0;
314 NetTimeToUpdate
:= 0;
315 NetTimeToReliable
:= 0;
319 g_Net_UnforwardPorts();
325 procedure g_Net_Free();
330 NetInitDone
:= False;
334 { /// SERVER FUNCTIONS /// }
337 function g_Net_Host(IPAddr
: LongWord; Port
: enet_uint16
; MaxClients
: Cardinal = 16): Boolean;
339 if NetMode
<> NET_NONE
then
341 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_INGAME
]);
348 g_Console_Add(_lc
[I_NET_MSG
] + Format(_lc
[I_NET_MSG_HOST
], [Port
]));
349 if not NetInitDone
then
351 if (not g_Net_Init()) then
353 g_Console_Add(_lc
[I_NET_MSG_FERROR
] + _lc
[I_NET_ERR_ENET
]);
361 NetAddr
.host
:= IPAddr
;
362 NetAddr
.port
:= Port
;
364 if NetForwardPorts
then g_Net_ForwardPorts();
366 NetHost
:= enet_host_create(@NetAddr
, NET_MAXCLIENTS
, NET_CHANS
, 0, 0);
368 if (NetHost
= nil) then
370 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + Format(_lc
[I_NET_ERR_HOST
], [Port
]));
376 NetPongSock
:= enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM
);
377 if NetPongSock
<> ENET_SOCKET_NULL
then
379 NetPongAddr
.host
:= IPAddr
;
380 NetPongAddr
.port
:= Port
+ 1;
381 if enet_socket_bind(NetPongSock
, @NetPongAddr
) < 0 then
383 enet_socket_destroy(NetPongSock
);
384 NetPongSock
:= ENET_SOCKET_NULL
;
387 enet_socket_set_option(NetPongSock
, ENET_SOCKOPT_NONBLOCK
, 1);
390 NetMode
:= NET_SERVER
;
397 procedure g_Net_Host_Die();
401 if NetMode
<> NET_SERVER
then Exit
;
403 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_HOST_DISCALL
]);
404 for I
:= 0 to High(NetClients
) do
405 if NetClients
[I
].Used
then
406 enet_peer_disconnect(NetClients
[I
].Peer
, NET_DISC_DOWN
);
408 while enet_host_service(NetHost
, @NetEvent
, 1000) > 0 do
409 if NetEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
then
410 enet_packet_destroy(NetEvent
.packet
);
412 for I
:= 0 to High(NetClients
) do
413 if NetClients
[I
].Used
then
415 FreeMemory(NetClients
[I
].Peer
^.data
);
416 NetClients
[I
].Peer
^.data
:= nil;
417 enet_peer_reset(NetClients
[I
].Peer
);
418 NetClients
[I
].Peer
:= nil;
419 NetClients
[I
].Used
:= False;
422 if (NetMPeer
<> nil) and (NetMHost
<> nil) then g_Net_Slist_Disconnect
;
423 if NetPongSock
<> ENET_SOCKET_NULL
then
424 enet_socket_destroy(NetPongSock
);
426 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_HOST_DIE
]);
427 enet_host_destroy(NetHost
);
432 e_WriteLog('NET: Server stopped', TMsgType
.Notify
);
436 procedure g_Net_Host_Send(ID
: Integer; Reliable
: Boolean; Chan
: Byte = NET_CHAN_GAME
);
442 F
:= LongWord(ENET_PACKET_FLAG_RELIABLE
)
448 if ID
> High(NetClients
) then Exit
;
449 if NetClients
[ID
].Peer
= nil then Exit
;
451 P
:= enet_packet_create(NetOut
.Data
, NetOut
.CurSize
, F
);
452 if not Assigned(P
) then Exit
;
454 enet_peer_send(NetClients
[ID
].Peer
, Chan
, P
);
458 P
:= enet_packet_create(NetOut
.Data
, NetOut
.CurSize
, F
);
459 if not Assigned(P
) then Exit
;
461 enet_host_broadcast(NetHost
, Chan
, P
);
464 if NetDump
then g_Net_DumpSendBuffer();
469 procedure g_Net_Host_CheckPings();
475 Ping
: array [0..9] of Byte;
478 if NetPongSock
= ENET_SOCKET_NULL
then Exit
;
480 Buf
.data
:= Addr(Ping
[0]);
481 Buf
.dataLength
:= 2+8;
485 Len
:= enet_socket_receive(NetPongSock
, @ClAddr
, @Buf
, 1);
486 if Len
< 0 then Exit
;
488 if (Ping
[0] = Ord('D')) and (Ping
[1] = Ord('F')) then
490 ClTime
:= Int64(Addr(Ping
[2])^);
493 NetOut
.Write(Byte(Ord('D')));
494 NetOut
.Write(Byte(Ord('F')));
495 NetOut
.Write(ClTime
);
496 g_Net_Slist_WriteInfo();
498 if gPlayer1
<> nil then Inc(NPl
);
499 if gPlayer2
<> nil then Inc(NPl
);
501 NetOut
.Write(gNumBots
);
503 Buf
.data
:= NetOut
.Data
;
504 Buf
.dataLength
:= NetOut
.CurSize
;
505 enet_socket_send(NetPongSock
, @ClAddr
, @Buf
, 1);
511 function g_Net_Host_Update(): enet_size_t
;
525 g_Net_Host_CheckPings
;
528 while (enet_host_service(NetHost
, @NetEvent
, 0) > 0) do
530 case (NetEvent
.kind
) of
531 ENET_EVENT_TYPE_CONNECT
:
533 IP
:= IpToStr(NetEvent
.Peer
^.address
.host
);
534 Port
:= NetEvent
.Peer
^.address
.port
;
535 g_Console_Add(_lc
[I_NET_MSG
] +
536 Format(_lc
[I_NET_MSG_HOST_CONN
], [IP
, Port
]));
538 if (NetEvent
.data
<> NET_PROTOCOL_VER
) then
540 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_HOST_REJECT
] +
541 _lc
[I_NET_DISC_PROTOCOL
]);
542 NetEvent
.peer
^.data
:= GetMemory(SizeOf(Byte));
543 Byte(NetEvent
.peer
^.data
^) := 255;
544 enet_peer_disconnect(NetEvent
.peer
, NET_DISC_PROTOCOL
);
545 enet_host_flush(NetHost
);
549 ID
:= g_Net_FindSlot();
553 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_HOST_REJECT
] +
554 _lc
[I_NET_DISC_FULL
]);
555 NetEvent
.Peer
^.data
:= GetMemory(SizeOf(Byte));
556 Byte(NetEvent
.peer
^.data
^) := 255;
557 enet_peer_disconnect(NetEvent
.peer
, NET_DISC_FULL
);
558 enet_host_flush(NetHost
);
562 NetClients
[ID
].Peer
:= NetEvent
.peer
;
563 NetClients
[ID
].Peer
^.data
:= GetMemory(SizeOf(Byte));
564 Byte(NetClients
[ID
].Peer
^.data
^) := ID
;
565 NetClients
[ID
].State
:= NET_STATE_AUTH
;
566 NetClients
[ID
].RCONAuth
:= False;
568 enet_peer_timeout(NetEvent
.peer
, ENET_PEER_TIMEOUT_LIMIT
* 2, ENET_PEER_TIMEOUT_MINIMUM
* 2, ENET_PEER_TIMEOUT_MAXIMUM
* 2);
571 g_Console_Add(_lc
[I_NET_MSG
] + Format(_lc
[I_NET_MSG_HOST_ADD
], [ID
]));
574 ENET_EVENT_TYPE_RECEIVE
:
576 ID
:= Byte(NetEvent
.peer
^.data
^);
577 if ID
> High(NetClients
) then Exit
;
578 TC
:= @NetClients
[ID
];
580 if NetDump
then g_Net_DumpRecvBuffer(NetEvent
.packet
^.data
, NetEvent
.packet
^.dataLength
);
581 g_Net_HostMsgHandler(TC
, NetEvent
.packet
);
584 ENET_EVENT_TYPE_DISCONNECT
:
586 ID
:= Byte(NetEvent
.peer
^.data
^);
587 if ID
> High(NetClients
) then Exit
;
588 TC
:= @NetClients
[ID
];
589 if TC
= nil then Exit
;
591 if not (TC
^.Used
) then Exit
;
593 TP
:= g_Player_Get(TC
^.Player
);
598 TP
.Kill(K_SIMPLEKILL
, 0, HIT_DISCON
);
599 g_Console_Add(Format(_lc
[I_PLAYER_LEAVE
], [TP
.Name
]), True);
600 e_WriteLog('NET: Client ' + TP
.Name
+ ' [' + IntToStr(ID
) + '] disconnected.', TMsgType
.Notify
);
601 g_Player_Remove(TP
.UID
);
605 TC
^.State
:= NET_STATE_NONE
;
608 TC
^.RequestedFullUpdate
:= False;
610 FreeMemory(NetEvent
.peer
^.data
);
611 NetEvent
.peer
^.data
:= nil;
612 g_Console_Add(_lc
[I_NET_MSG
] + Format(_lc
[I_NET_MSG_HOST_DISC
], [ID
]));
615 if NetUseMaster
then g_Net_Slist_Update
;
622 { /// CLIENT FUNCTIONS /// }
625 procedure g_Net_Disconnect(Forced
: Boolean = False);
627 if NetMode
<> NET_CLIENT
then Exit
;
628 if (NetHost
= nil) or (NetPeer
= nil) then Exit
;
632 enet_peer_disconnect(NetPeer
, NET_DISC_NONE
);
634 while (enet_host_service(NetHost
, @NetEvent
, 1500) > 0) do
636 if (NetEvent
.kind
= ENET_EVENT_TYPE_DISCONNECT
) then
642 if (NetEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
) then
643 enet_packet_destroy(NetEvent
.packet
);
646 if NetPeer
<> nil then
648 enet_peer_reset(NetPeer
);
654 e_WriteLog('NET: Kicked from server: ' + IntToStr(NetEvent
.data
), TMsgType
.Notify
);
655 if (NetEvent
.data
<= NET_DISC_MAX
) then
656 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_KICK
] +
657 _lc
[TStrings_Locale(Cardinal(I_NET_DISC_NONE
) + NetEvent
.data
)], True);
660 if NetHost
<> nil then
662 enet_host_destroy(NetHost
);
665 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_CLIENT_DISC
]);
668 e_WriteLog('NET: Disconnected', TMsgType
.Notify
);
671 procedure g_Net_Client_Send(Reliable
: Boolean; Chan
: Byte = NET_CHAN_GAME
);
677 F
:= LongWord(ENET_PACKET_FLAG_RELIABLE
)
681 P
:= enet_packet_create(NetOut
.Data
, NetOut
.CurSize
, F
);
682 if not Assigned(P
) then Exit
;
684 enet_peer_send(NetPeer
, Chan
, P
);
685 if NetDump
then g_Net_DumpSendBuffer();
690 function g_Net_Client_Update(): enet_size_t
;
693 while (enet_host_service(NetHost
, @NetEvent
, 0) > 0) do
695 case NetEvent
.kind
of
696 ENET_EVENT_TYPE_RECEIVE
:
698 if NetDump
then g_Net_DumpRecvBuffer(NetEvent
.packet
^.data
, NetEvent
.packet
^.dataLength
);
699 g_Net_ClientMsgHandler(NetEvent
.packet
);
702 ENET_EVENT_TYPE_DISCONNECT
:
704 g_Net_Disconnect(True);
712 function g_Net_Client_UpdateWhileLoading(): enet_size_t
;
715 while (enet_host_service(NetHost
, @NetEvent
, 0) > 0) do
717 case NetEvent
.kind
of
718 ENET_EVENT_TYPE_RECEIVE
:
720 if NetDump
then g_Net_DumpRecvBuffer(NetEvent
.packet
^.data
, NetEvent
.packet
^.dataLength
);
721 g_Net_ClientLightMsgHandler(NetEvent
.packet
);
724 ENET_EVENT_TYPE_DISCONNECT
:
726 g_Net_Disconnect(True);
735 function g_Net_Connect(IP
: string; Port
: enet_uint16
): Boolean;
739 if NetMode
<> NET_NONE
then
741 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_ERR_INGAME
], True);
748 g_Console_Add(_lc
[I_NET_MSG
] + Format(_lc
[I_NET_MSG_CLIENT_CONN
],
750 if not NetInitDone
then
752 if (not g_Net_Init()) then
754 g_Console_Add(_lc
[I_NET_MSG_FERROR
] + _lc
[I_NET_ERR_ENET
], True);
762 NetHost
:= enet_host_create(nil, 1, NET_CHANS
, 0, 0);
764 if (NetHost
= nil) then
766 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CLIENT
], True);
772 enet_address_set_host(@NetAddr
, PChar(Addr(IP
[1])));
773 NetAddr
.port
:= Port
;
775 NetPeer
:= enet_host_connect(NetHost
, @NetAddr
, NET_CHANS
, NET_PROTOCOL_VER
);
777 if (NetPeer
= nil) then
779 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CLIENT
], True);
780 enet_host_destroy(NetHost
);
789 while (enet_host_service(NetHost
, @NetEvent
, 0) > 0) do
791 if (NetEvent
.kind
= ENET_EVENT_TYPE_CONNECT
) then
793 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_CLIENT_DONE
]);
794 NetMode
:= NET_CLIENT
;
796 enet_peer_timeout(NetPeer
, ENET_PEER_TIMEOUT_LIMIT
* 2, ENET_PEER_TIMEOUT_MINIMUM
* 2, ENET_PEER_TIMEOUT_MAXIMUM
* 2);
798 NetClientPort
:= Port
;
805 ProcessLoading(true);
807 if e_KeyPressed(IK_ESCAPE
) or e_KeyPressed(IK_SPACE
) then
811 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_TIMEOUT
], True);
812 if NetPeer
<> nil then enet_peer_reset(NetPeer
);
813 if NetHost
<> nil then
815 enet_host_destroy(NetHost
);
822 function IpToStr(IP
: LongWord): string;
827 Result
:= IntToStr(PByte(Ptr
+ 0)^) + '.';
828 Result
:= Result
+ IntToStr(PByte(Ptr
+ 1)^) + '.';
829 Result
:= Result
+ IntToStr(PByte(Ptr
+ 2)^) + '.';
830 Result
:= Result
+ IntToStr(PByte(Ptr
+ 3)^);
833 function StrToIp(IPstr
: string; var IP
: LongWord): Boolean;
837 Result
:= enet_address_set_host(@EAddr
, PChar(@IPstr
[1])) = 0;
841 function g_Net_Client_ByName(Name
: string): pTNetClient
;
847 for a
:= Low(NetClients
) to High(NetClients
) do
848 if (NetClients
[a
].Used
) and (NetClients
[a
].State
= NET_STATE_GAME
) then
850 pl
:= g_Player_Get(NetClients
[a
].Player
);
851 if pl
= nil then continue
;
852 if Copy(LowerCase(pl
.Name
), 1, Length(Name
)) <> LowerCase(Name
) then continue
;
853 if NetClients
[a
].Peer
<> nil then
855 Result
:= @NetClients
[a
];
861 function g_Net_Client_ByPlayer(PID
: Word): pTNetClient
;
866 for a
:= Low(NetClients
) to High(NetClients
) do
867 if (NetClients
[a
].Used
) and (NetClients
[a
].State
= NET_STATE_GAME
) then
868 if NetClients
[a
].Player
= PID
then
870 Result
:= @NetClients
[a
];
875 function g_Net_ClientName_ByID(ID
: Integer): string;
881 if ID
= NET_EVERYONE
then
883 for a
:= Low(NetClients
) to High(NetClients
) do
884 if (NetClients
[a
].ID
= ID
) and (NetClients
[a
].Used
) and (NetClients
[a
].State
= NET_STATE_GAME
) then
886 pl
:= g_Player_Get(NetClients
[a
].Player
);
887 if pl
= nil then Exit
;
892 procedure g_Net_SendData(Data
:AByte
; peer
: pENetPeer
; Reliable
: Boolean; Chan
: Byte = NET_CHAN_DOWNLOAD
);
896 dataLength
: Cardinal;
898 dataLength
:= Length(Data
);
901 F
:= LongWord(ENET_PACKET_FLAG_RELIABLE
)
905 if (peer
<> nil) then
907 P
:= enet_packet_create(@Data
[0], dataLength
, F
);
908 if not Assigned(P
) then Exit
;
909 enet_peer_send(peer
, Chan
, P
);
913 P
:= enet_packet_create(@Data
[0], dataLength
, F
);
914 if not Assigned(P
) then Exit
;
915 enet_host_broadcast(NetHost
, Chan
, P
);
918 enet_host_flush(NetHost
);
921 function g_Net_Wait_Event(msgId
: Word): TMemoryStream
;
923 downloadEvent
: ENetEvent
;
927 msgStream
: TMemoryStream
;
929 FillChar(downloadEvent
, SizeOf(downloadEvent
), 0);
934 while (enet_host_service(NetHost
, @downloadEvent
, 0) > 0) do
936 if (downloadEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
) then
938 Ptr
:= downloadEvent
.packet
^.data
;
942 if (MID
= msgId
) then
944 msgStream
:= TMemoryStream
.Create
;
945 msgStream
.SetSize(downloadEvent
.packet
^.dataLength
);
946 msgStream
.WriteBuffer(Ptr
^, downloadEvent
.packet
^.dataLength
);
947 msgStream
.Seek(0, soFromBeginning
);
950 enet_packet_destroy(downloadEvent
.packet
);
954 enet_packet_destroy(downloadEvent
.packet
);
958 if (downloadEvent
.kind
= ENET_EVENT_TYPE_DISCONNECT
) then
960 if (downloadEvent
.data
<= NET_DISC_MAX
) then
961 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CONN
] + ' ' +
962 _lc
[TStrings_Locale(Cardinal(I_NET_DISC_NONE
) + downloadEvent
.data
)], True);
968 ProcessLoading(true);
970 if e_KeyPressed(IK_ESCAPE
) or e_KeyPressed(IK_SPACE
) then
976 function g_Net_IsHostBanned(IP
: LongWord; Perm
: Boolean = False): Boolean;
981 if NetBannedHosts
= nil then
983 for I
:= 0 to High(NetBannedHosts
) do
984 if (NetBannedHosts
[I
].IP
= IP
) and ((not Perm
) or (NetBannedHosts
[I
].Perm
)) then
991 procedure g_Net_BanHost(IP
: LongWord; Perm
: Boolean = True); overload
;
997 if g_Net_IsHostBanned(IP
, Perm
) then
1001 for I
:= Low(NetBannedHosts
) to High(NetBannedHosts
) do
1002 if NetBannedHosts
[I
].IP
= 0 then
1010 SetLength(NetBannedHosts
, Length(NetBannedHosts
) + 1);
1011 P
:= High(NetBannedHosts
);
1014 NetBannedHosts
[P
].IP
:= IP
;
1015 NetBannedHosts
[P
].Perm
:= Perm
;
1018 procedure g_Net_BanHost(IP
: string; Perm
: Boolean = True); overload
;
1023 b
:= StrToIp(IP
, a
);
1025 g_Net_BanHost(a
, Perm
);
1028 procedure g_Net_UnbanNonPermHosts();
1032 if NetBannedHosts
= nil then
1034 for I
:= Low(NetBannedHosts
) to High(NetBannedHosts
) do
1035 if (NetBannedHosts
[I
].IP
> 0) and not NetBannedHosts
[I
].Perm
then
1037 NetBannedHosts
[I
].IP
:= 0;
1038 NetBannedHosts
[I
].Perm
:= True;
1042 function g_Net_UnbanHost(IP
: string): Boolean; overload
;
1046 Result
:= StrToIp(IP
, a
);
1048 Result
:= g_Net_UnbanHost(a
);
1051 function g_Net_UnbanHost(IP
: LongWord): Boolean; overload
;
1058 if NetBannedHosts
= nil then
1060 for I
:= 0 to High(NetBannedHosts
) do
1061 if NetBannedHosts
[I
].IP
= IP
then
1063 NetBannedHosts
[I
].IP
:= 0;
1064 NetBannedHosts
[I
].Perm
:= True;
1066 // no break here to clear all bans of this host, perm and non-perm
1070 procedure g_Net_SaveBanList();
1075 Assign(F
, DataDir
+ BANLIST_FILENAME
);
1077 if NetBannedHosts
<> nil then
1078 for I
:= 0 to High(NetBannedHosts
) do
1079 if NetBannedHosts
[I
].Perm
and (NetBannedHosts
[I
].IP
> 0) then
1080 Writeln(F
, IpToStr(NetBannedHosts
[I
].IP
));
1084 procedure g_Net_DumpStart();
1086 if NetMode
= NET_SERVER
then
1087 NetDumpFile
:= createDiskFile(NETDUMP_FILENAME
+ '_server')
1089 NetDumpFile
:= createDiskFile(NETDUMP_FILENAME
+ '_client');
1092 procedure g_Net_DumpSendBuffer();
1094 writeInt(NetDumpFile
, gTime
);
1095 writeInt(NetDumpFile
, LongWord(NetOut
.CurSize
));
1096 writeInt(NetDumpFile
, Byte(1));
1097 NetDumpFile
.WriteBuffer(NetOut
.Data
^, NetOut
.CurSize
);
1100 procedure g_Net_DumpRecvBuffer(Buf
: penet_uint8
; Len
: LongWord);
1102 if (Buf
= nil) or (Len
= 0) then Exit
;
1103 writeInt(NetDumpFile
, gTime
);
1104 writeInt(NetDumpFile
, Len
);
1105 writeInt(NetDumpFile
, Byte(0));
1106 NetDumpFile
.WriteBuffer(Buf
^, Len
);
1109 procedure g_Net_DumpEnd();
1115 function g_Net_ForwardPorts(ForwardPongPort
: Boolean = True): Boolean;
1116 {$IFDEF USE_MINIUPNPC}
1121 LanAddr
: array [0..255] of Char;
1122 ExtAddr
: array [0..40] of Char;
1123 StrPort
: AnsiString;
1128 if NetPortForwarded
= NetPort
then
1134 conwriteln('trying to forward server ports...');
1136 NetPongForwarded
:= False;
1137 NetPortForwarded
:= 0;
1139 DevList
:= upnpDiscover(2000, nil, nil, 0, 0, Addr(Err
));
1140 if DevList
= nil then
1142 conwritefln(' upnpDiscover() failed: %d', [Err
]);
1146 I
:= UPNP_GetValidIGD(DevList
, @Urls
, @Data
, Addr(LanAddr
[0]), 256);
1150 conwriteln(' could not find an IGD device on this LAN, aborting');
1151 FreeUPNPDevList(DevList
);
1152 FreeUPNPUrls(@Urls
);
1156 conwritefln(' found IGD @ %s', [Urls
.controlURL
])
1158 conwritefln(' found some kind of UPNP device @ %s, maybe it''ll work', [Urls
.controlURL
]);
1160 UPNP_GetExternalIPAddress(Urls
.controlURL
, Addr(data
.first
.servicetype
[1]), Addr(ExtAddr
[0]));
1161 if ExtAddr
[0] <> #0 then
1162 conwritefln(' external IP address: %s', [Addr(ExtAddr
[0])]);
1164 StrPort
:= IntToStr(NetPort
);
1165 I
:= UPNP_AddPortMapping(
1166 Urls
.controlURL
, Addr(data
.first
.servicetype
[1]),
1167 PChar(StrPort
), PChar(StrPort
), Addr(LanAddr
[0]), PChar('D2DF'),
1168 PChar('UDP'), nil, PChar('0')
1173 conwritefln(' forwarding port %d failed: error %d', [NetPort
, I
]);
1174 FreeUPNPDevList(DevList
);
1175 FreeUPNPUrls(@Urls
);
1179 if ForwardPongPort
then
1181 StrPort
:= IntToStr(NetPort
+ 1);
1182 I
:= UPNP_AddPortMapping(
1183 Urls
.controlURL
, Addr(data
.first
.servicetype
[1]),
1184 PChar(StrPort
), PChar(StrPort
), Addr(LanAddr
[0]), PChar('D2DF'),
1185 PChar('UDP'), nil, PChar('0')
1190 conwritefln(' forwarding port %d failed: error %d', [NetPort
+ 1, I
]);
1191 NetPongForwarded
:= False;
1195 conwritefln(' forwarded port %d successfully', [NetPort
+ 1]);
1196 NetPongForwarded
:= True;
1200 conwritefln(' forwarded port %d successfully', [NetPort
]);
1201 NetIGDControl
:= AnsiString(Urls
.controlURL
);
1202 NetIGDService
:= data
.first
.servicetype
;
1203 NetPortForwarded
:= NetPort
;
1205 FreeUPNPDevList(DevList
);
1206 FreeUPNPUrls(@Urls
);
1215 procedure g_Net_UnforwardPorts();
1216 {$IFDEF USE_MINIUPNPC}
1219 StrPort
: AnsiString;
1221 if NetPortForwarded
= 0 then Exit
;
1223 conwriteln('unforwarding ports...');
1225 StrPort
:= IntToStr(NetPortForwarded
);
1226 I
:= UPNP_DeletePortMapping(
1227 PChar(NetIGDControl
), Addr(NetIGDService
[1]),
1228 PChar(StrPort
), PChar('UDP'), nil
1230 conwritefln(' port %d: %d', [NetPortForwarded
, I
]);
1232 if NetPongForwarded
then
1234 NetPongForwarded
:= False;
1235 StrPort
:= IntToStr(NetPortForwarded
+ 1);
1236 I
:= UPNP_DeletePortMapping(
1237 PChar(NetIGDControl
), Addr(NetIGDService
[1]),
1238 PChar(StrPort
), PChar('UDP'), nil
1240 conwritefln(' port %d: %d', [NetPortForwarded
+ 1, I
]);
1243 NetPortForwarded
:= 0;
1252 NetIn
.Alloc(NET_BUFSIZE
);
1253 NetOut
.Alloc(NET_BUFSIZE
);