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
= 180;
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
, ctypes
;
212 g_Net_DownloadTimeoutMs
: Single;
215 { /// SERVICE FUNCTIONS /// }
218 function g_Net_FindSlot(): Integer;
227 for I
:= Low(NetClients
) to High(NetClients
) do
229 if NetClients
[I
].Used
then
238 if C
>= NetMaxClients
then
246 if (Length(NetClients
) >= NetMaxClients
) then
250 SetLength(NetClients
, Length(NetClients
) + 1);
251 N
:= High(NetClients
);
257 NetClients
[N
].Used
:= True;
258 NetClients
[N
].ID
:= N
;
259 NetClients
[N
].RequestedFullUpdate
:= False;
260 NetClients
[N
].RCONAuth
:= False;
261 NetClients
[N
].Voted
:= False;
262 NetClients
[N
].Player
:= 0;
268 function g_Net_Init(): Boolean;
276 SetLength(NetClients
, 0);
282 NetAddr
.port
:= 25666;
283 SetLength(NetBannedHosts
, 0);
284 if FileExists(DataDir
+ BANLIST_FILENAME
) then
286 Assign(F
, DataDir
+ BANLIST_FILENAME
);
291 if StrToIp(IPstr
, IP
) then
298 Result
:= (enet_initialize() = 0);
301 procedure g_Net_Flush();
303 enet_host_flush(NetHost
);
306 procedure g_Net_Cleanup();
311 SetLength(NetClients
, 0);
321 NetState
:= NET_STATE_NONE
;
323 NetPongSock
:= ENET_SOCKET_NULL
;
325 NetTimeToMaster
:= 0;
326 NetTimeToUpdate
:= 0;
327 NetTimeToReliable
:= 0;
331 if NetPortThread
<> NilThreadId
then
332 WaitForThreadTerminate(NetPortThread
, 66666);
334 NetPortThread
:= NilThreadId
;
335 g_Net_UnforwardPorts();
341 procedure g_Net_Free();
346 NetInitDone
:= False;
350 { /// SERVER FUNCTIONS /// }
353 function ForwardThread(Param
: Pointer): PtrInt
;
356 if not g_Net_ForwardPorts() then Result
:= -1;
359 function g_Net_Host(IPAddr
: LongWord
; Port
: enet_uint16
; MaxClients
: Cardinal = 16): Boolean;
361 if NetMode
<> NET_NONE
then
363 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_INGAME
]);
370 g_Console_Add(_lc
[I_NET_MSG
] + Format(_lc
[I_NET_MSG_HOST
], [Port
]));
371 if not NetInitDone
then
373 if (not g_Net_Init()) then
375 g_Console_Add(_lc
[I_NET_MSG_FERROR
] + _lc
[I_NET_ERR_ENET
]);
383 NetAddr
.host
:= IPAddr
;
384 NetAddr
.port
:= Port
;
386 if NetForwardPorts
then NetPortThread
:= BeginThread(ForwardThread
);
388 NetHost
:= enet_host_create(@NetAddr
, NET_MAXCLIENTS
, NET_CHANS
, 0, 0);
390 if (NetHost
= nil) then
392 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + Format(_lc
[I_NET_ERR_HOST
], [Port
]));
398 NetPongSock
:= enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM
);
399 if NetPongSock
<> ENET_SOCKET_NULL
then
401 NetPongAddr
.host
:= IPAddr
;
402 NetPongAddr
.port
:= NET_PING_PORT
;
403 if enet_socket_bind(NetPongSock
, @NetPongAddr
) < 0 then
405 enet_socket_destroy(NetPongSock
);
406 NetPongSock
:= ENET_SOCKET_NULL
;
409 enet_socket_set_option(NetPongSock
, ENET_SOCKOPT_NONBLOCK
, 1);
412 NetMode
:= NET_SERVER
;
419 procedure g_Net_Host_Die();
423 if NetMode
<> NET_SERVER
then Exit
;
425 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_HOST_DISCALL
]);
426 for I
:= 0 to High(NetClients
) do
427 if NetClients
[I
].Used
then
428 enet_peer_disconnect(NetClients
[I
].Peer
, NET_DISC_DOWN
);
430 while enet_host_service(NetHost
, @NetEvent
, 1000) > 0 do
431 if NetEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
then
432 enet_packet_destroy(NetEvent
.packet
);
434 for I
:= 0 to High(NetClients
) do
435 if NetClients
[I
].Used
then
437 FreeMemory(NetClients
[I
].Peer
^.data
);
438 NetClients
[I
].Peer
^.data
:= nil;
439 enet_peer_reset(NetClients
[I
].Peer
);
440 NetClients
[I
].Peer
:= nil;
441 NetClients
[I
].Used
:= False;
444 if (NetMPeer
<> nil) and (NetMHost
<> nil) then g_Net_Slist_Disconnect
;
445 if NetPongSock
<> ENET_SOCKET_NULL
then
446 enet_socket_destroy(NetPongSock
);
448 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_HOST_DIE
]);
449 enet_host_destroy(NetHost
);
454 e_WriteLog('NET: Server stopped', TMsgType
.Notify
);
458 procedure g_Net_Host_Send(ID
: Integer; Reliable
: Boolean; Chan
: Byte = NET_CHAN_GAME
);
464 F
:= LongWord(ENET_PACKET_FLAG_RELIABLE
)
470 if ID
> High(NetClients
) then Exit
;
471 if NetClients
[ID
].Peer
= nil then Exit
;
473 P
:= enet_packet_create(NetOut
.Data
, NetOut
.CurSize
, F
);
474 if not Assigned(P
) then Exit
;
476 enet_peer_send(NetClients
[ID
].Peer
, Chan
, P
);
480 P
:= enet_packet_create(NetOut
.Data
, NetOut
.CurSize
, F
);
481 if not Assigned(P
) then Exit
;
483 enet_host_broadcast(NetHost
, Chan
, P
);
486 if NetDump
then g_Net_DumpSendBuffer();
491 procedure g_Net_Host_CheckPings();
497 Ping
: array [0..9] of Byte;
500 if NetPongSock
= ENET_SOCKET_NULL
then Exit
;
502 Buf
.data
:= Addr(Ping
[0]);
503 Buf
.dataLength
:= 2+8;
507 Len
:= enet_socket_receive(NetPongSock
, @ClAddr
, @Buf
, 1);
508 if Len
< 0 then Exit
;
510 if (Ping
[0] = Ord('D')) and (Ping
[1] = Ord('F')) then
512 ClTime
:= Int64(Addr(Ping
[2])^);
515 NetOut
.Write(Byte(Ord('D')));
516 NetOut
.Write(Byte(Ord('F')));
517 NetOut
.Write(NetPort
);
518 NetOut
.Write(ClTime
);
519 g_Net_Slist_WriteInfo();
521 if gPlayer1
<> nil then Inc(NPl
);
522 if gPlayer2
<> nil then Inc(NPl
);
524 NetOut
.Write(gNumBots
);
526 Buf
.data
:= NetOut
.Data
;
527 Buf
.dataLength
:= NetOut
.CurSize
;
528 enet_socket_send(NetPongSock
, @ClAddr
, @Buf
, 1);
534 function g_Net_Host_Update(): enet_size_t
;
547 g_Net_Host_CheckPings
;
549 while (enet_host_service(NetHost
, @NetEvent
, 0) > 0) do
551 case (NetEvent
.kind
) of
552 ENET_EVENT_TYPE_CONNECT
:
554 IP
:= IpToStr(NetEvent
.Peer
^.address
.host
);
555 Port
:= NetEvent
.Peer
^.address
.port
;
556 g_Console_Add(_lc
[I_NET_MSG
] +
557 Format(_lc
[I_NET_MSG_HOST_CONN
], [IP
, Port
]));
559 if (NetEvent
.data
<> NET_PROTOCOL_VER
) then
561 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_HOST_REJECT
] +
562 _lc
[I_NET_DISC_PROTOCOL
]);
563 NetEvent
.peer
^.data
:= GetMemory(SizeOf(Byte));
564 Byte(NetEvent
.peer
^.data
^) := 255;
565 enet_peer_disconnect(NetEvent
.peer
, NET_DISC_PROTOCOL
);
566 enet_host_flush(NetHost
);
570 ID
:= g_Net_FindSlot();
574 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_HOST_REJECT
] +
575 _lc
[I_NET_DISC_FULL
]);
576 NetEvent
.Peer
^.data
:= GetMemory(SizeOf(Byte));
577 Byte(NetEvent
.peer
^.data
^) := 255;
578 enet_peer_disconnect(NetEvent
.peer
, NET_DISC_FULL
);
579 enet_host_flush(NetHost
);
583 NetClients
[ID
].Peer
:= NetEvent
.peer
;
584 NetClients
[ID
].Peer
^.data
:= GetMemory(SizeOf(Byte));
585 Byte(NetClients
[ID
].Peer
^.data
^) := ID
;
586 NetClients
[ID
].State
:= NET_STATE_AUTH
;
587 NetClients
[ID
].RCONAuth
:= False;
589 enet_peer_timeout(NetEvent
.peer
, ENET_PEER_TIMEOUT_LIMIT
* 2, ENET_PEER_TIMEOUT_MINIMUM
* 2, ENET_PEER_TIMEOUT_MAXIMUM
* 2);
592 g_Console_Add(_lc
[I_NET_MSG
] + Format(_lc
[I_NET_MSG_HOST_ADD
], [ID
]));
595 ENET_EVENT_TYPE_RECEIVE
:
597 ID
:= Byte(NetEvent
.peer
^.data
^);
598 if ID
> High(NetClients
) then Exit
;
599 TC
:= @NetClients
[ID
];
601 if NetDump
then g_Net_DumpRecvBuffer(NetEvent
.packet
^.data
, NetEvent
.packet
^.dataLength
);
602 g_Net_HostMsgHandler(TC
, NetEvent
.packet
);
605 ENET_EVENT_TYPE_DISCONNECT
:
607 ID
:= Byte(NetEvent
.peer
^.data
^);
608 if ID
> High(NetClients
) then Exit
;
609 TC
:= @NetClients
[ID
];
610 if TC
= nil then Exit
;
612 if not (TC
^.Used
) then Exit
;
614 TP
:= g_Player_Get(TC
^.Player
);
619 TP
.Kill(K_SIMPLEKILL
, 0, HIT_DISCON
);
620 g_Console_Add(Format(_lc
[I_PLAYER_LEAVE
], [TP
.Name
]), True);
621 e_WriteLog('NET: Client ' + TP
.Name
+ ' [' + IntToStr(ID
) + '] disconnected.', TMsgType
.Notify
);
622 g_Player_Remove(TP
.UID
);
626 TC
^.State
:= NET_STATE_NONE
;
629 TC
^.RequestedFullUpdate
:= False;
631 FreeMemory(NetEvent
.peer
^.data
);
632 NetEvent
.peer
^.data
:= nil;
633 g_Console_Add(_lc
[I_NET_MSG
] + Format(_lc
[I_NET_MSG_HOST_DISC
], [ID
]));
636 if NetUseMaster
then g_Net_Slist_Update
;
643 { /// CLIENT FUNCTIONS /// }
646 procedure g_Net_Disconnect(Forced
: Boolean = False);
648 if NetMode
<> NET_CLIENT
then Exit
;
649 if (NetHost
= nil) or (NetPeer
= nil) then Exit
;
653 enet_peer_disconnect(NetPeer
, NET_DISC_NONE
);
655 while (enet_host_service(NetHost
, @NetEvent
, 1500) > 0) do
657 if (NetEvent
.kind
= ENET_EVENT_TYPE_DISCONNECT
) then
663 if (NetEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
) then
664 enet_packet_destroy(NetEvent
.packet
);
667 if NetPeer
<> nil then
669 enet_peer_reset(NetPeer
);
675 e_WriteLog('NET: Kicked from server: ' + IntToStr(NetEvent
.data
), TMsgType
.Notify
);
676 if (NetEvent
.data
<= NET_DISC_MAX
) then
677 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_KICK
] +
678 _lc
[TStrings_Locale(Cardinal(I_NET_DISC_NONE
) + NetEvent
.data
)], True);
681 if NetHost
<> nil then
683 enet_host_destroy(NetHost
);
686 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_CLIENT_DISC
]);
689 e_WriteLog('NET: Disconnected', TMsgType
.Notify
);
692 procedure g_Net_Client_Send(Reliable
: Boolean; Chan
: Byte = NET_CHAN_GAME
);
698 F
:= LongWord(ENET_PACKET_FLAG_RELIABLE
)
702 P
:= enet_packet_create(NetOut
.Data
, NetOut
.CurSize
, F
);
703 if not Assigned(P
) then Exit
;
705 enet_peer_send(NetPeer
, Chan
, P
);
706 if NetDump
then g_Net_DumpSendBuffer();
711 function g_Net_Client_Update(): enet_size_t
;
714 while (enet_host_service(NetHost
, @NetEvent
, 0) > 0) do
716 case NetEvent
.kind
of
717 ENET_EVENT_TYPE_RECEIVE
:
719 if NetDump
then g_Net_DumpRecvBuffer(NetEvent
.packet
^.data
, NetEvent
.packet
^.dataLength
);
720 g_Net_ClientMsgHandler(NetEvent
.packet
);
723 ENET_EVENT_TYPE_DISCONNECT
:
725 g_Net_Disconnect(True);
733 function g_Net_Client_UpdateWhileLoading(): enet_size_t
;
736 while (enet_host_service(NetHost
, @NetEvent
, 0) > 0) do
738 case NetEvent
.kind
of
739 ENET_EVENT_TYPE_RECEIVE
:
741 if NetDump
then g_Net_DumpRecvBuffer(NetEvent
.packet
^.data
, NetEvent
.packet
^.dataLength
);
742 g_Net_ClientLightMsgHandler(NetEvent
.packet
);
745 ENET_EVENT_TYPE_DISCONNECT
:
747 g_Net_Disconnect(True);
756 function g_Net_Connect(IP
: string; Port
: enet_uint16
): Boolean;
760 if NetMode
<> NET_NONE
then
762 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_ERR_INGAME
], True);
769 g_Console_Add(_lc
[I_NET_MSG
] + Format(_lc
[I_NET_MSG_CLIENT_CONN
],
771 if not NetInitDone
then
773 if (not g_Net_Init()) then
775 g_Console_Add(_lc
[I_NET_MSG_FERROR
] + _lc
[I_NET_ERR_ENET
], True);
783 NetHost
:= enet_host_create(nil, 1, NET_CHANS
, 0, 0);
785 if (NetHost
= nil) then
787 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CLIENT
], True);
793 enet_address_set_host(@NetAddr
, PChar(Addr(IP
[1])));
794 NetAddr
.port
:= Port
;
796 NetPeer
:= enet_host_connect(NetHost
, @NetAddr
, NET_CHANS
, NET_PROTOCOL_VER
);
798 if (NetPeer
= nil) then
800 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CLIENT
], True);
801 enet_host_destroy(NetHost
);
810 while (enet_host_service(NetHost
, @NetEvent
, 0) > 0) do
812 if (NetEvent
.kind
= ENET_EVENT_TYPE_CONNECT
) then
814 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_CLIENT_DONE
]);
815 NetMode
:= NET_CLIENT
;
817 enet_peer_timeout(NetPeer
, ENET_PEER_TIMEOUT_LIMIT
* 2, ENET_PEER_TIMEOUT_MINIMUM
* 2, ENET_PEER_TIMEOUT_MAXIMUM
* 2);
819 NetClientPort
:= Port
;
826 ProcessLoading(true);
828 if e_KeyPressed(IK_SPACE
) or e_KeyPressed(IK_ESCAPE
) or e_KeyPressed(VK_ESCAPE
) or
829 e_KeyPressed(JOY0_JUMP
) or e_KeyPressed(JOY1_JUMP
) or e_KeyPressed(JOY2_JUMP
) or e_KeyPressed(JOY3_JUMP
) then
833 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_TIMEOUT
], True);
834 if NetPeer
<> nil then enet_peer_reset(NetPeer
);
835 if NetHost
<> nil then
837 enet_host_destroy(NetHost
);
844 function IpToStr(IP
: LongWord
): string;
849 Result
:= IntToStr(PByte(Ptr
+ 0)^) + '.';
850 Result
:= Result
+ IntToStr(PByte(Ptr
+ 1)^) + '.';
851 Result
:= Result
+ IntToStr(PByte(Ptr
+ 2)^) + '.';
852 Result
:= Result
+ IntToStr(PByte(Ptr
+ 3)^);
855 function StrToIp(IPstr
: string; var IP
: LongWord
): Boolean;
859 Result
:= enet_address_set_host(@EAddr
, PChar(@IPstr
[1])) = 0;
863 function g_Net_Client_ByName(Name
: string): pTNetClient
;
869 for a
:= Low(NetClients
) to High(NetClients
) do
870 if (NetClients
[a
].Used
) and (NetClients
[a
].State
= NET_STATE_GAME
) then
872 pl
:= g_Player_Get(NetClients
[a
].Player
);
873 if pl
= nil then continue
;
874 if Copy(LowerCase(pl
.Name
), 1, Length(Name
)) <> LowerCase(Name
) then continue
;
875 if NetClients
[a
].Peer
<> nil then
877 Result
:= @NetClients
[a
];
883 function g_Net_Client_ByPlayer(PID
: Word): pTNetClient
;
888 for a
:= Low(NetClients
) to High(NetClients
) do
889 if (NetClients
[a
].Used
) and (NetClients
[a
].State
= NET_STATE_GAME
) then
890 if NetClients
[a
].Player
= PID
then
892 Result
:= @NetClients
[a
];
897 function g_Net_ClientName_ByID(ID
: Integer): string;
903 if ID
= NET_EVERYONE
then
905 for a
:= Low(NetClients
) to High(NetClients
) do
906 if (NetClients
[a
].ID
= ID
) and (NetClients
[a
].Used
) and (NetClients
[a
].State
= NET_STATE_GAME
) then
908 pl
:= g_Player_Get(NetClients
[a
].Player
);
909 if pl
= nil then Exit
;
914 procedure g_Net_SendData(Data
: AByte
; peer
: pENetPeer
; Reliable
: Boolean; Chan
: Byte = NET_CHAN_DOWNLOAD
);
918 dataLength
: Cardinal;
920 dataLength
:= Length(Data
);
923 F
:= LongWord(ENET_PACKET_FLAG_RELIABLE
)
927 if (peer
<> nil) then
929 P
:= enet_packet_create(@Data
[0], dataLength
, F
);
930 if not Assigned(P
) then Exit
;
931 enet_peer_send(peer
, Chan
, P
);
935 P
:= enet_packet_create(@Data
[0], dataLength
, F
);
936 if not Assigned(P
) then Exit
;
937 enet_host_broadcast(NetHost
, Chan
, P
);
940 enet_host_flush(NetHost
);
943 function UserRequestExit
: Boolean;
945 Result
:= e_KeyPressed(IK_SPACE
) or
946 e_KeyPressed(IK_ESCAPE
) or
947 e_KeyPressed(VK_ESCAPE
) or
948 e_KeyPressed(JOY0_JUMP
) or
949 e_KeyPressed(JOY1_JUMP
) or
950 e_KeyPressed(JOY2_JUMP
) or
951 e_KeyPressed(JOY3_JUMP
)
954 function g_Net_Wait_Event(msgId
: Word): TMemoryStream
;
959 stream
: TMemoryStream
;
962 FillChar(ev
, SizeOf(ev
), 0);
965 status
:= enet_host_service(NetHost
, @ev
, Trunc(g_Net_DownloadTimeoutMs
* 1000));
969 ENET_EVENT_TYPE_RECEIVE
:
971 Ptr
:= ev
.packet
^.data
;
972 rMsgId
:= Byte(Ptr
^);
973 if rMsgId
= msgId
then
975 stream
:= TMemoryStream
.Create
;
976 stream
.SetSize(ev
.packet
^.dataLength
);
977 stream
.WriteBuffer(Ptr
^, ev
.packet
^.dataLength
);
978 stream
.Seek(0, soFromBeginning
);
979 status
:= 1 (* received *)
983 (* looks that game state always received, so ignore it *)
984 e_LogWritefln('g_Net_Wait_Event(%s): skip message %s', [msgId
, rMsgId
]);
985 status
:= 2 (* continue *)
988 ENET_EVENT_TYPE_DISCONNECT
:
990 if (ev
.data
<= NET_DISC_MAX
) then
991 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CONN
] + ' ' + _lc
[TStrings_Locale(Cardinal(I_NET_DISC_NONE
) + ev
.data
)], True);
992 status
:= -2 (* error: disconnected *)
995 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CONN
] + ' unknown ENet event ' + IntToStr(Ord(ev
.kind
)), True);
996 status
:= -3 (* error: unknown event *)
998 enet_packet_destroy(ev
.packet
)
1002 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CONN
] + ' timeout reached', True);
1003 status
:= 0 (* error: timeout *)
1005 ProcessLoading(true);
1006 until (status
<> 2) or UserRequestExit();
1010 function g_Net_IsHostBanned(IP
: LongWord
; Perm
: Boolean = False): Boolean;
1015 if NetBannedHosts
= nil then
1017 for I
:= 0 to High(NetBannedHosts
) do
1018 if (NetBannedHosts
[I
].IP
= IP
) and ((not Perm
) or (NetBannedHosts
[I
].Perm
)) then
1025 procedure g_Net_BanHost(IP
: LongWord
; Perm
: Boolean = True); overload
;
1031 if g_Net_IsHostBanned(IP
, Perm
) then
1035 for I
:= Low(NetBannedHosts
) to High(NetBannedHosts
) do
1036 if NetBannedHosts
[I
].IP
= 0 then
1044 SetLength(NetBannedHosts
, Length(NetBannedHosts
) + 1);
1045 P
:= High(NetBannedHosts
);
1048 NetBannedHosts
[P
].IP
:= IP
;
1049 NetBannedHosts
[P
].Perm
:= Perm
;
1052 procedure g_Net_BanHost(IP
: string; Perm
: Boolean = True); overload
;
1057 b
:= StrToIp(IP
, a
);
1059 g_Net_BanHost(a
, Perm
);
1062 procedure g_Net_UnbanNonPermHosts();
1066 if NetBannedHosts
= nil then
1068 for I
:= Low(NetBannedHosts
) to High(NetBannedHosts
) do
1069 if (NetBannedHosts
[I
].IP
> 0) and not NetBannedHosts
[I
].Perm
then
1071 NetBannedHosts
[I
].IP
:= 0;
1072 NetBannedHosts
[I
].Perm
:= True;
1076 function g_Net_UnbanHost(IP
: string): Boolean; overload
;
1080 Result
:= StrToIp(IP
, a
);
1082 Result
:= g_Net_UnbanHost(a
);
1085 function g_Net_UnbanHost(IP
: LongWord
): Boolean; overload
;
1092 if NetBannedHosts
= nil then
1094 for I
:= 0 to High(NetBannedHosts
) do
1095 if NetBannedHosts
[I
].IP
= IP
then
1097 NetBannedHosts
[I
].IP
:= 0;
1098 NetBannedHosts
[I
].Perm
:= True;
1100 // no break here to clear all bans of this host, perm and non-perm
1104 procedure g_Net_SaveBanList();
1109 Assign(F
, DataDir
+ BANLIST_FILENAME
);
1111 if NetBannedHosts
<> nil then
1112 for I
:= 0 to High(NetBannedHosts
) do
1113 if NetBannedHosts
[I
].Perm
and (NetBannedHosts
[I
].IP
> 0) then
1114 Writeln(F
, IpToStr(NetBannedHosts
[I
].IP
));
1118 procedure g_Net_DumpStart();
1120 if NetMode
= NET_SERVER
then
1121 NetDumpFile
:= createDiskFile(NETDUMP_FILENAME
+ '_server')
1123 NetDumpFile
:= createDiskFile(NETDUMP_FILENAME
+ '_client');
1126 procedure g_Net_DumpSendBuffer();
1128 writeInt(NetDumpFile
, gTime
);
1129 writeInt(NetDumpFile
, LongWord(NetOut
.CurSize
));
1130 writeInt(NetDumpFile
, Byte(1));
1131 NetDumpFile
.WriteBuffer(NetOut
.Data
^, NetOut
.CurSize
);
1134 procedure g_Net_DumpRecvBuffer(Buf
: penet_uint8
; Len
: LongWord
);
1136 if (Buf
= nil) or (Len
= 0) then Exit
;
1137 writeInt(NetDumpFile
, gTime
);
1138 writeInt(NetDumpFile
, Len
);
1139 writeInt(NetDumpFile
, Byte(0));
1140 NetDumpFile
.WriteBuffer(Buf
^, Len
);
1143 procedure g_Net_DumpEnd();
1149 function g_Net_ForwardPorts(ForwardPongPort
: Boolean = True): Boolean;
1150 {$IFDEF USE_MINIUPNPC}
1155 LanAddr
: array [0..255] of Char;
1156 StrPort
: AnsiString
;
1161 if NetPortForwarded
= NetPort
then
1167 NetPongForwarded
:= False;
1168 NetPortForwarded
:= 0;
1170 DevList
:= upnpDiscover(1000, nil, nil, 0, 0, 2, Addr(Err
));
1171 if DevList
= nil then
1173 conwritefln('port forwarding failed: upnpDiscover() failed: %d', [Err
]);
1177 I
:= UPNP_GetValidIGD(DevList
, @Urls
, @Data
, Addr(LanAddr
[0]), 256);
1181 conwriteln('port forwarding failed: could not find an IGD device on this LAN');
1182 FreeUPNPDevList(DevList
);
1183 FreeUPNPUrls(@Urls
);
1187 StrPort
:= IntToStr(NetPort
);
1188 I
:= UPNP_AddPortMapping(
1189 Urls
.controlURL
, Addr(data
.first
.servicetype
[1]),
1190 PChar(StrPort
), PChar(StrPort
), Addr(LanAddr
[0]), PChar('D2DF'),
1191 PChar('UDP'), nil, PChar('0')
1196 conwritefln('forwarding port %d failed: error %d', [NetPort
, I
]);
1197 FreeUPNPDevList(DevList
);
1198 FreeUPNPUrls(@Urls
);
1202 if ForwardPongPort
then
1204 StrPort
:= IntToStr(NET_PING_PORT
);
1205 I
:= UPNP_AddPortMapping(
1206 Urls
.controlURL
, Addr(data
.first
.servicetype
[1]),
1207 PChar(StrPort
), PChar(StrPort
), Addr(LanAddr
[0]), PChar('D2DF'),
1208 PChar('UDP'), nil, PChar('0')
1213 conwritefln('forwarding port %d failed: error %d', [NetPort
+ 1, I
]);
1214 NetPongForwarded
:= False;
1218 conwritefln('forwarded port %d successfully', [NetPort
+ 1]);
1219 NetPongForwarded
:= True;
1223 conwritefln('forwarded port %d successfully', [NetPort
]);
1224 NetIGDControl
:= AnsiString(Urls
.controlURL
);
1225 NetIGDService
:= data
.first
.servicetype
;
1226 NetPortForwarded
:= NetPort
;
1228 FreeUPNPDevList(DevList
);
1229 FreeUPNPUrls(@Urls
);
1238 procedure g_Net_UnforwardPorts();
1239 {$IFDEF USE_MINIUPNPC}
1242 StrPort
: AnsiString
;
1244 if NetPortForwarded
= 0 then Exit
;
1246 conwriteln('unforwarding ports...');
1248 StrPort
:= IntToStr(NetPortForwarded
);
1249 I
:= UPNP_DeletePortMapping(
1250 PChar(NetIGDControl
), Addr(NetIGDService
[1]),
1251 PChar(StrPort
), PChar('UDP'), nil
1253 conwritefln(' port %d: %d', [NetPortForwarded
, I
]);
1255 if NetPongForwarded
then
1257 NetPongForwarded
:= False;
1258 StrPort
:= IntToStr(NetPortForwarded
+ 1);
1259 I
:= UPNP_DeletePortMapping(
1260 PChar(NetIGDControl
), Addr(NetIGDService
[1]),
1261 PChar(StrPort
), PChar('UDP'), nil
1263 conwritefln(' port %d: %d', [NetPortForwarded
+ 1, I
]);
1266 NetPortForwarded
:= 0;
1274 conRegVar('cl_downloadtimeout', @g_Net_DownloadTimeoutMs
, 0.0, 1000000.0, '', 'timeout in seconds, 0 to disable it');
1275 g_Net_DownloadTimeoutMs
:= 60;
1276 NetIn
.Alloc(NET_BUFSIZE
);
1277 NetOut
.Alloc(NET_BUFSIZE
);