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, version 3 of the License ONLY.
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * GNU General Public License for more details.
12 * You should have received a copy of the GNU General Public License
13 * along with this program. If not, see <http://www.gnu.org/licenses/>.
15 {$INCLUDE ../shared/a_modes.inc}
21 e_log
, e_msg
, utils
, ENet
, Classes
, md5
, MAPDEF
{$IFDEF USE_MINIUPNPC}, miniupnpc
;{$ELSE};{$ENDIF}
24 NET_PROTOCOL_VER
= 188;
30 NET_CHAN_IMPORTANT
= 1;
33 NET_CHAN_PLAYERPOS
= 4;
35 NET_CHAN_MONSTERPOS
= 6;
36 NET_CHAN_LARGEDATA
= 7;
38 NET_CHAN_DOWNLOAD
= 9;
40 NET_CHAN_DOWNLOAD_EX
= 11;
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;
64 NET_DISC_FILE_TIMEOUT
: enet_uint32
= 13;
70 NET_CONNECT_TIMEOUT
= 1000 * 10;
72 BANLIST_FILENAME
= 'banlist.txt';
73 NETDUMP_FILENAME
= 'netdump';
76 TNetMapResourceInfo
= record
77 wadName
: AnsiString; // wad file name, without a path
78 size
: Integer; // wad file size (-1: size and hash are not known)
79 hash
: TMD5Digest
; // wad hash
82 TNetMapResourceInfoArray
= array of TNetMapResourceInfo
;
84 TNetFileTransfer
= record
88 size
: Integer; // file size in bytes
90 lastSentChunk
: Integer;
91 lastAckChunk
: Integer;
92 lastAckTime
: Int64; // msecs; if not "in progress", we're waiting for the first ack
94 diskBuffer
: PChar; // of `chunkSize` bytes
104 RequestedFullUpdate
: Boolean;
105 WaitForFirstSpawn
: Boolean; // set to `true` in server, used to spawn a player on first full state request
106 FullUpdateSent
: Boolean;
112 Transfer
: TNetFileTransfer
; // only one transfer may be active
113 NetOut
: array [0..1] of TMsg
;
119 pTNetClient
= ^TNetClient
;
121 AByte
= array of Byte;
124 NetInitDone
: Boolean = False;
125 NetMode
: Byte = NET_NONE
;
126 NetDump
: Boolean = False;
128 NetServerName
: string = 'Unnamed Server';
129 NetPassword
: string = '';
130 NetPort
: Word = 25666;
132 NetAllowRCON
: Boolean = False;
133 NetRCONPassword
: string = '';
135 NetTimeToUpdate
: Cardinal = 0;
136 NetTimeToReliable
: Cardinal = 0;
137 NetTimeToMaster
: Cardinal = 0;
139 NetHost
: pENetHost
= nil;
140 NetPeer
: pENetPeer
= nil;
142 NetAddr
: ENetAddress
;
144 NetPongAddr
: ENetAddress
;
145 NetPongSock
: ENetSocket
= ENET_SOCKET_NULL
;
147 NetUseMaster
: Boolean = True;
148 NetMasterList
: string = 'mpms.doom2d.org:25665, deadsoftware.ru:25665';
150 NetClientIP
: string = '127.0.0.1';
151 NetClientPort
: Word = 25666;
154 NetBuf
: array [0..1] of TMsg
;
156 NetClients
: array of TNetClient
;
157 NetClientCount
: Byte = 0;
158 NetMaxClients
: Byte = 255;
159 NetBannedHosts
: array of TBanRecord
;
161 NetAutoBanLimit
: Integer = 5;
162 NetAutoBanPerm
: Boolean = True;
163 NetAutoBanWarn
: Boolean = False;
164 NetAutoBanForTimeout
: Boolean = False;
166 NetAuthTimeout
: Integer = 30 * 1000;
167 NetPacketTimeout
: Integer = 60 * 1000;
169 NetState
: Integer = NET_STATE_NONE
;
171 NetMyID
: Integer = -1;
172 NetPlrUID1
: Integer = -1;
173 NetPlrUID2
: Integer = -1;
175 NetInterpLevel
: Integer = 1;
176 NetUpdateRate
: Cardinal = 0; // as soon as possible
177 NetRelupdRate
: Cardinal = 18; // around two times a second
178 NetMasterRate
: Cardinal = 60000;
180 NetForcePlayerUpdate
: Boolean = False;
181 NetPredictSelf
: Boolean = True;
182 NetForwardPorts
: Boolean = False;
184 NetGotEverything
: Boolean = False;
185 NetGotKeys
: Boolean = False;
187 NetDeafLevel
: Integer = 0;
189 {$IFDEF USE_MINIUPNPC}
190 NetPortForwarded
: Word = 0;
191 NetPongForwarded
: Boolean = False;
192 NetIGDControl
: AnsiString;
193 NetIGDService
: TURLStr
;
196 NetPortThread
: TThreadID
= NilThreadId
;
198 NetDumpFile
: TStream
;
200 g_Res_received_map_start
: Integer = 0; // set if we received "map change" event
203 function g_Net_Init(): Boolean;
204 procedure g_Net_Cleanup();
205 procedure g_Net_Free();
206 procedure g_Net_Flush();
208 function g_Net_Host(IPAddr
: LongWord; Port
: enet_uint16
; MaxClients
: Cardinal = 16): Boolean;
209 procedure g_Net_Host_Die();
210 procedure g_Net_Host_Send(ID
: Integer; Reliable
: Boolean; Chan
: Byte = NET_CHAN_GAME
);
211 procedure g_Net_Host_Update();
213 function g_Net_Connect(IP
: string; Port
: enet_uint16
): Boolean;
214 procedure g_Net_Disconnect(Forced
: Boolean = False);
215 procedure g_Net_Client_Send(Reliable
: Boolean; Chan
: Byte = NET_CHAN_GAME
);
216 procedure g_Net_Client_Update();
217 procedure g_Net_Client_UpdateWhileLoading();
219 function g_Net_Client_ByName(Name
: string): pTNetClient
;
220 function g_Net_Client_ByPlayer(PID
: Word): pTNetClient
;
221 function g_Net_ClientName_ByID(ID
: Integer): string;
223 procedure g_Net_SendData(Data
: AByte
; peer
: pENetPeer
; Reliable
: Boolean; Chan
: Byte = NET_CHAN_DOWNLOAD
);
224 //function g_Net_Wait_Event(msgId: Word): TMemoryStream;
225 //function g_Net_Wait_FileInfo (var tf: TNetFileTransfer; asMap: Boolean; out resList: TStringList): Integer;
227 function IpToStr(IP
: LongWord): string;
228 function StrToIp(IPstr
: string; var IP
: LongWord): Boolean;
230 function g_Net_IsHostBanned(IP
: LongWord; Perm
: Boolean = False): Boolean;
231 procedure g_Net_BanHost(IP
: LongWord; Perm
: Boolean = True); overload
;
232 procedure g_Net_BanHost(IP
: string; Perm
: Boolean = True); overload
;
233 function g_Net_UnbanHost(IP
: string): Boolean; overload
;
234 function g_Net_UnbanHost(IP
: LongWord): Boolean; overload
;
235 procedure g_Net_UnbanNonPermHosts();
236 procedure g_Net_SaveBanList();
238 procedure g_Net_Penalize(C
: pTNetClient
; Reason
: string);
240 procedure g_Net_DumpStart();
241 procedure g_Net_DumpSendBuffer();
242 procedure g_Net_DumpRecvBuffer(Buf
: penet_uint8
; Len
: LongWord);
243 procedure g_Net_DumpEnd();
245 function g_Net_ForwardPorts(ForwardPongPort
: Boolean = True): Boolean;
246 procedure g_Net_UnforwardPorts();
248 function g_Net_UserRequestExit
: Boolean;
250 function g_Net_Wait_MapInfo (var tf
: TNetFileTransfer
; var resList
: TNetMapResourceInfoArray
): Integer;
251 function g_Net_RequestResFileInfo (resIndex
: LongInt; out tf
: TNetFileTransfer
): Integer;
252 function g_Net_AbortResTransfer (var tf
: TNetFileTransfer
): Boolean;
253 function g_Net_ReceiveResourceFile (resIndex
: LongInt; var tf
: TNetFileTransfer
; strm
: TStream
): Integer;
255 function g_Net_IsNetworkAvailable (): Boolean;
256 procedure g_Net_InitLowLevel ();
257 procedure g_Net_DeinitLowLevel ();
259 procedure NetServerCVars(P
: SSArray
);
264 // *enet_host_service()*
265 // fuck! https://www.mail-archive.com/enet-discuss@cubik.org/msg00852.html
266 // tl;dr: on shitdows, we can get -1 sometimes, and it is *NOT* a failure.
267 // thank you, enet. let's ignore failures altogether then.
272 g_nethandler
, g_netmsg
, g_netmaster
, g_player
, g_window
, g_console
,
273 g_main
, g_game
, g_language
, g_weapons
, ctypes
, g_system
, g_map
;
276 FILE_CHUNK_SIZE
= 8192;
279 enet_init_success
: Boolean = false;
280 g_Net_DownloadTimeout
: Single;
284 function g_Net_IsNetworkAvailable (): Boolean;
286 result
:= enet_init_success
;
289 procedure g_Net_InitLowLevel ();
292 v
:= enet_linked_version();
293 e_LogWritefln('ENet Version: %s.%s.%s', [ENET_VERSION_GET_MAJOR(v
), ENET_VERSION_GET_MINOR(v
), ENET_VERSION_GET_PATCH(v
)]);
294 if enet_init_success
then raise Exception
.Create('wuta?!');
295 enet_init_success
:= (enet_initialize() = 0);
298 procedure g_Net_DeinitLowLevel ();
300 if enet_init_success
then
303 enet_init_success
:= false;
308 //**************************************************************************
312 //**************************************************************************
314 procedure clearNetClientTransfers (var nc
: TNetClient
);
316 nc
.Transfer
.stream
.Free
;
317 nc
.Transfer
.diskName
:= ''; // just in case
318 if (nc
.Transfer
.diskBuffer
<> nil) then FreeMem(nc
.Transfer
.diskBuffer
);
319 nc
.Transfer
.stream
:= nil;
320 nc
.Transfer
.diskBuffer
:= nil;
324 procedure clearNetClient (var nc
: TNetClient
);
326 clearNetClientTransfers(nc
);
330 procedure clearNetClients (clearArray
: Boolean);
334 for f
:= Low(NetClients
) to High(NetClients
) do clearNetClient(NetClients
[f
]);
335 if (clearArray
) then SetLength(NetClients
, 0);
339 function g_Net_UserRequestExit (): Boolean;
341 Result
:= {e_KeyPressed(IK_SPACE) or}
342 e_KeyPressed(IK_ESCAPE
) or
343 e_KeyPressed(VK_ESCAPE
) or
344 e_KeyPressed(JOY0_JUMP
) or
345 e_KeyPressed(JOY1_JUMP
) or
346 e_KeyPressed(JOY2_JUMP
) or
347 e_KeyPressed(JOY3_JUMP
)
350 //**************************************************************************
352 // file transfer declaraions and host packet processor
354 //**************************************************************************
357 // server packet type
358 NTF_SERVER_DONE
= 10; // done with this file
359 NTF_SERVER_FILE_INFO
= 11; // sent after client request
360 NTF_SERVER_CHUNK
= 12; // next chunk; chunk number follows
361 NTF_SERVER_ABORT
= 13; // server abort
362 NTF_SERVER_MAP_INFO
= 14;
364 // client packet type
365 NTF_CLIENT_MAP_REQUEST
= 100; // map file request; also, returns list of additional wads to download
366 NTF_CLIENT_FILE_REQUEST
= 101; // resource file request (by index)
367 NTF_CLIENT_ABORT
= 102; // do not send requested file, or abort current transfer
368 NTF_CLIENT_START
= 103; // start transfer; client may resume download by sending non-zero starting chunk
369 NTF_CLIENT_ACK
= 104; // chunk ack; chunk number follows
372 // disconnect client due to some file transfer error
373 procedure killClientByFT (var nc
: TNetClient
);
375 e_LogWritefln('disconnected client #%d due to file transfer error', [nc
.ID
], TMsgType
.Warning
);
376 enet_peer_disconnect(nc
.Peer
, NET_DISC_FILE_TIMEOUT
);
377 clearNetClientTransfers(nc
);
378 g_Net_Slist_ServerPlayerLeaves();
382 // send file transfer message from server to client
383 function ftransSendServerMsg (var nc
: TNetClient
; var m
: TMsg
): Boolean;
388 if (m
.CurSize
< 1) then exit
;
389 pkt
:= enet_packet_create(m
.Data
, m
.CurSize
, ENET_PACKET_FLAG_RELIABLE
);
390 if not Assigned(pkt
) then begin killClientByFT(nc
); exit
; end;
391 if (enet_peer_send(nc
.Peer
, NET_CHAN_DOWNLOAD_EX
, pkt
) <> 0) then begin killClientByFT(nc
); exit
; end;
396 // send file transfer message from client to server
397 function ftransSendClientMsg (var m
: TMsg
): Boolean;
402 if (m
.CurSize
< 1) then exit
;
403 pkt
:= enet_packet_create(m
.Data
, m
.CurSize
, ENET_PACKET_FLAG_RELIABLE
);
404 if not Assigned(pkt
) then exit
;
405 if (enet_peer_send(NetPeer
, NET_CHAN_DOWNLOAD_EX
, pkt
) <> 0) then exit
;
411 procedure ProcessChunkSend (var nc
: TNetClient
);
413 tf
: ^TNetFileTransfer
;
419 if (tf
.stream
= nil) then exit
;
421 // arbitrary timeout number
422 if (ct
-tf
.lastAckTime
>= 5000) then
427 // check if we need to send something
428 if (not tf
.inProgress
) then exit
; // waiting for the initial ack
429 // ok, we're sending chunks
430 if (tf
.lastAckChunk
<> tf
.lastSentChunk
) then exit
;
431 Inc(tf
.lastSentChunk
);
432 // do it one chunk at a time; client ack will advance our chunk counter
433 chunks
:= (tf
.size
+tf
.chunkSize
-1) div tf
.chunkSize
;
435 if (tf
.lastSentChunk
> chunks
) then
442 if (tf
.lastSentChunk
= chunks
) then
444 // we're done with this file
445 e_LogWritefln('download: client #%d, DONE sending chunks #%d/#%d', [nc
.ID
, tf
.lastSentChunk
, chunks
]);
446 trans_omsg
.Write(Byte(NTF_SERVER_DONE
));
447 clearNetClientTransfers(nc
);
452 trans_omsg
.Write(Byte(NTF_SERVER_CHUNK
));
453 trans_omsg
.Write(LongInt(tf
.lastSentChunk
));
455 rd
:= tf
.size
-(tf
.lastSentChunk
*tf
.chunkSize
);
456 if (rd
> tf
.chunkSize
) then rd
:= tf
.chunkSize
;
457 trans_omsg
.Write(LongInt(rd
));
458 //e_LogWritefln('download: client #%d, sending chunk #%d/#%d (%d bytes)', [nc.ID, tf.lastSentChunk, chunks, rd]);
459 //FIXME: check for errors here
461 tf
.stream
.Seek(tf
.lastSentChunk
*tf
.chunkSize
, soFromBeginning
);
462 tf
.stream
.ReadBuffer(tf
.diskBuffer
^, rd
);
463 trans_omsg
.WriteData(tf
.diskBuffer
, rd
);
470 ftransSendServerMsg(nc
, trans_omsg
);
474 // server file transfer packet processor
475 // received packet is in `NetEvent`
476 procedure ProcessDownloadExPacket ();
483 tf
: ^TNetFileTransfer
;
493 // find client index by peer
494 for f
:= Low(NetClients
) to High(NetClients
) do
496 if (not NetClients
[f
].Used
) then continue
;
497 if (NetClients
[f
].Peer
= NetEvent
.peer
) then
503 //e_LogWritefln('RECEIVE: dlpacket; client=%d (datalen=%u)', [nid, NetEvent.packet^.dataLength]);
505 if (nid
< 0) then exit
; // wtf?!
506 nc
:= @NetClients
[nid
];
508 if (NetEvent
.packet
^.dataLength
= 0) then
514 // don't time out clients during a file transfer
515 if (NetAuthTimeout
> 0) then
516 nc
^.AuthTime
:= gTime
+ NetAuthTimeout
;
517 if (NetPacketTimeout
> 0) then
518 nc
^.MsgTime
:= gTime
+ NetPacketTimeout
;
520 tf
:= @NetClients
[nid
].Transfer
;
521 tf
.lastAckTime
:= GetTimerMS();
523 cmd
:= Byte(NetEvent
.packet
^.data
^);
524 //e_LogWritefln('RECEIVE: nid=%d; cmd=%u', [nid, cmd]);
526 NTF_CLIENT_FILE_REQUEST
: // file request
528 if (tf
.stream
<> nil) then
533 if (NetEvent
.packet
^.dataLength
< 2) then
538 // new transfer request; build packet
539 if not msg
.Init(NetEvent
.packet
^.data
+1, NetEvent
.packet
^.dataLength
-1, True) then
544 // get resource index
545 ridx
:= msg
.ReadLongInt();
546 if (ridx
< -1) or (ridx
>= length(gExternalResources
)) then
548 e_LogWritefln('Invalid resource index %d', [ridx
], TMsgType
.Warning
);
552 if (ridx
< 0) then fname
:= gGameSettings
.WAD
else fname
:= gExternalResources
[ridx
].diskName
;
553 if (length(fname
) = 0) then
555 e_WriteLog('Invalid filename: '+fname
, TMsgType
.Warning
);
559 tf
.diskName
:= findDiskWad(fname
);
560 if (length(tf
.diskName
) = 0) then
562 e_LogWritefln('NETWORK: file "%s" not found!', [fname
], TMsgType
.Fatal
);
567 //tf.hash := MD5File(tf.diskName);
568 if (ridx
< 0) then tf
.hash
:= gWADHash
else tf
.hash
:= gExternalResources
[ridx
].hash
;
569 // create file stream
570 tf
.diskName
:= findDiskWad(fname
);
572 tf
.stream
:= openDiskFileRO(tf
.diskName
);
576 if (tf
.stream
= nil) then
578 e_WriteLog(Format('NETWORK: file "%s" not found!', [fname
]), TMsgType
.Fatal
);
582 e_LogWritefln('client #%d requested resource #%d (file is `%s` : `%s`)', [nc
.ID
, ridx
, fname
, tf
.diskName
]);
583 tf
.size
:= tf
.stream
.size
;
584 tf
.chunkSize
:= FILE_CHUNK_SIZE
; // arbitrary
585 tf
.lastSentChunk
:= -1;
586 tf
.lastAckChunk
:= -1;
587 tf
.lastAckTime
:= GetTimerMS();
588 tf
.inProgress
:= False; // waiting for the first ACK or for the cancel
589 GetMem(tf
.diskBuffer
, tf
.chunkSize
);
590 // sent file info message
592 trans_omsg
.Write(Byte(NTF_SERVER_FILE_INFO
));
593 trans_omsg
.Write(tf
.hash
);
594 trans_omsg
.Write(tf
.size
);
595 trans_omsg
.Write(tf
.chunkSize
);
596 trans_omsg
.Write(ExtractFileName(fname
));
597 if not ftransSendServerMsg(nc
^, trans_omsg
) then exit
;
599 NTF_CLIENT_ABORT
: // do not send requested file, or abort current transfer
601 e_LogWritefln('client #%d aborted file transfer', [nc
.ID
]);
602 clearNetClientTransfers(nc
^);
604 NTF_CLIENT_START
: // start transfer; client may resume download by sending non-zero starting chunk
606 if not Assigned(tf
.stream
) then
611 if (tf
.lastSentChunk
<> -1) or (tf
.lastAckChunk
<> -1) or (tf
.inProgress
) then
613 // double ack, get lost
617 if (NetEvent
.packet
^.dataLength
< 2) then
623 if not msg
.Init(NetEvent
.packet
^.data
+1, NetEvent
.packet
^.dataLength
-1, True) then
628 chunk
:= msg
.ReadLongInt();
629 if (chunk
< 0) or (chunk
> (tf
.size
+tf
.chunkSize
-1) div tf
.chunkSize
) then
634 e_LogWritefln('client #%d started file transfer from chunk %d', [nc
.ID
, chunk
]);
635 // start sending chunks
636 tf
.inProgress
:= True;
637 tf
.lastSentChunk
:= chunk
-1;
638 tf
.lastAckChunk
:= chunk
-1;
639 ProcessChunkSend(nc
^);
641 NTF_CLIENT_ACK
: // chunk ack; chunk number follows
643 if not Assigned(tf
.stream
) then
648 if (tf
.lastSentChunk
< 0) or (not tf
.inProgress
) then
650 // double ack, get lost
654 if (NetEvent
.packet
^.dataLength
< 2) then
660 if not msg
.Init(NetEvent
.packet
^.data
+1, NetEvent
.packet
^.dataLength
-1, True) then
665 chunk
:= msg
.ReadLongInt();
666 if (chunk
< 0) or (chunk
> (tf
.size
+tf
.chunkSize
-1) div tf
.chunkSize
) then
671 // do it this way, so client may seek, or request retransfers for some reason
672 tf
.lastAckChunk
:= chunk
;
673 tf
.lastSentChunk
:= chunk
;
674 //e_LogWritefln('client #%d acked file transfer chunk %d', [nc.ID, chunk]);
675 ProcessChunkSend(nc
^);
677 NTF_CLIENT_MAP_REQUEST
:
679 e_LogWritefln('client #%d requested map info', [nc
.ID
]);
681 dfn
:= findDiskWad(gGameSettings
.WAD
);
682 if (dfn
= '') then dfn
:= '!wad_not_found!.wad'; //FIXME
683 //md5 := MD5File(dfn);
685 if (not GetDiskFileInfo(dfn
, fi
)) then
687 e_LogWritefln('client #%d requested map info, but i cannot get file info', [nc
.ID
]);
693 st := openDiskFileRO(dfn);
694 if not assigned(st) then exit; //wtf?!
699 trans_omsg
.Write(Byte(NTF_SERVER_MAP_INFO
));
701 trans_omsg
.Write(ExtractFileName(gGameSettings
.WAD
));
703 trans_omsg
.Write(md5
);
705 trans_omsg
.Write(size
);
706 // number of external resources for map
707 trans_omsg
.Write(LongInt(length(gExternalResources
)));
708 // external resource names
709 for f
:= 0 to High(gExternalResources
) do
712 //trans_omsg.Write(ExtractFileName(gExternalResources[f])); // GameDir+'/wads/'+ResList.Strings[i]
714 trans_omsg
.Write('!');
715 trans_omsg
.Write(LongInt(gExternalResources
[f
].size
));
716 trans_omsg
.Write(gExternalResources
[f
].hash
);
717 trans_omsg
.Write(ExtractFileName(gExternalResources
[f
].diskName
));
720 if not ftransSendServerMsg(nc
^, trans_omsg
) then exit
;
731 //**************************************************************************
733 // file transfer crap (both client and server)
735 //**************************************************************************
737 function getNewTimeoutEnd (): Int64;
739 result
:= GetTimerMS();
740 if (g_Net_DownloadTimeout
<= 0) then
742 result
:= result
+1000*60*3; // 3 minutes
746 result
:= result
+trunc(g_Net_DownloadTimeout
*1000);
751 // send map request to server, and wait for "map info" server reply
753 // returns `false` on error or user abort
755 // diskName: map wad file name (without a path)
756 // hash: map wad hash
757 // size: map wad size
758 // chunkSize: set too
759 // resList: list of resource wads
765 // for maps, first `tf.diskName` name will be map wad name, and `tf.hash`/`tf.size` will contain map info
766 function g_Net_Wait_MapInfo (var tf
: TNetFileTransfer
; var resList
: TNetMapResourceInfoArray
): Integer;
772 freePacket
: Boolean = false;
777 ri
: ^TNetMapResourceInfo
;
779 SetLength(resList
, 0);
783 trans_omsg
.Write(Byte(NTF_CLIENT_MAP_REQUEST
));
784 if not ftransSendClientMsg(trans_omsg
) then begin result
:= -1; exit
; end;
786 FillChar(ev
, SizeOf(ev
), 0);
789 ett
:= getNewTimeoutEnd();
791 status
:= enet_host_service(NetHost
, @ev
, 300);
795 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' network error', True);
800 if (status
<= 0) then
806 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CONN
] + ' timeout reached', True);
815 ENET_EVENT_TYPE_RECEIVE
:
818 if (ev
.channelID
<> NET_CHAN_DOWNLOAD_EX
) then
820 //e_LogWritefln('g_Net_Wait_MapInfo: skip message from non-transfer channel', []);
822 g_Net_Client_HandlePacket(ev
.packet
, g_Net_ClientLightMsgHandler
);
823 if (g_Res_received_map_start
< 0) then begin result
:= -666; exit
; end;
827 ett
:= getNewTimeoutEnd();
828 if (ev
.packet
.dataLength
< 1) then
830 e_LogWritefln('g_Net_Wait_MapInfo: invalid server packet (no data)', []);
834 Ptr
:= ev
.packet
^.data
;
835 rMsgId
:= Byte(Ptr
^);
836 e_LogWritefln('g_Net_Wait_MapInfo: got message %u from server (dataLength=%u)', [rMsgId
, ev
.packet
^.dataLength
]);
837 if (rMsgId
= NTF_SERVER_FILE_INFO
) then
839 e_LogWritefln('g_Net_Wait_MapInfo: waiting for map info reply, but got file info reply', []);
843 else if (rMsgId
= NTF_SERVER_ABORT
) then
845 e_LogWritefln('g_Net_Wait_MapInfo: server aborted transfer', []);
849 else if (rMsgId
= NTF_SERVER_MAP_INFO
) then
851 e_LogWritefln('g_Net_Wait_MapInfo: creating map info packet...', []);
852 if not msg
.Init(ev
.packet
^.data
+1, ev
.packet
^.dataLength
-1, True) then exit
;
853 e_LogWritefln('g_Net_Wait_MapInfo: parsing map info packet (rd=%d; max=%d)...', [msg
.ReadCount
, msg
.MaxSize
]);
854 SetLength(resList
, 0); // just in case
856 tf
.diskName
:= msg
.ReadString();
857 e_LogWritefln('g_Net_Wait_MapInfo: map wad is `%s`', [tf
.diskName
]);
859 tf
.hash
:= msg
.ReadMD5();
861 tf
.size
:= msg
.ReadLongInt();
862 e_LogWritefln('g_Net_Wait_MapInfo: map wad size is %d', [tf
.size
]);
863 // number of external resources for map
864 rc
:= msg
.ReadLongInt();
865 if (rc
< 0) or (rc
> 1024) then
867 e_LogWritefln('g_Net_Wait_Event: invalid number of map external resources (%d)', [rc
]);
871 e_LogWritefln('g_Net_Wait_MapInfo: map external resource count is %d', [rc
]);
872 SetLength(resList
, rc
);
873 // external resource names
874 for f
:= 0 to rc
-1 do
877 s
:= msg
.ReadString();
878 if (length(s
) = 0) then begin result
:= -1; exit
; end;
882 ri
.size
:= msg
.ReadLongInt();
883 ri
.hash
:= msg
.ReadMD5();
884 ri
.wadName
:= ExtractFileName(msg
.ReadString());
885 if (length(ri
.wadName
) = 0) or (ri
.size
< 0) then begin result
:= -1; exit
; end;
889 // old-style packet, only name
890 ri
.wadName
:= ExtractFileName(s
);
891 if (length(ri
.wadName
) = 0) then begin result
:= -1; exit
; end;
892 ri
.size
:= -1; // unknown
895 e_LogWritefln('g_Net_Wait_MapInfo: got map info', []);
896 Result
:= 0; // success
901 e_LogWritefln('g_Net_Wait_Event: invalid server packet type', []);
907 ENET_EVENT_TYPE_DISCONNECT
:
909 if (ev
.data
<= NET_DISC_MAX
) then
910 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CONN
] + ' ' + _lc
[TStrings_Locale(Cardinal(I_NET_DISC_NONE
) + ev
.data
)], True);
916 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CONN
] + ' unknown ENet event ' + IntToStr(Ord(ev
.kind
)), True);
921 if (freePacket
) then begin freePacket
:= false; enet_packet_destroy(ev
.packet
); end;
924 if g_Net_UserRequestExit() then
926 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CONN
] + ' user abort', True);
932 if (freePacket
) then enet_packet_destroy(ev
.packet
);
937 // send file request to server, and wait for server reply
939 // returns `false` on error or user abort
941 // diskName (actually, base name)
950 // for maps, first `tf.diskName` name will be map wad name, and `tf.hash`/`tf.size` will contain map info
951 function g_Net_RequestResFileInfo (resIndex
: LongInt; out tf
: TNetFileTransfer
): Integer;
957 freePacket
: Boolean = false;
963 trans_omsg
.Write(Byte(NTF_CLIENT_FILE_REQUEST
));
964 trans_omsg
.Write(resIndex
);
965 if not ftransSendClientMsg(trans_omsg
) then begin result
:= -1; exit
; end;
967 FillChar(ev
, SizeOf(ev
), 0);
970 ett
:= getNewTimeoutEnd();
972 status
:= enet_host_service(NetHost
, @ev
, 300);
976 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' network error', True);
981 if (status
<= 0) then
987 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CONN
] + ' timeout reached', True);
996 ENET_EVENT_TYPE_RECEIVE
:
999 if (ev
.channelID
<> NET_CHAN_DOWNLOAD_EX
) then
1001 //e_LogWriteln('g_Net_Wait_Event: skip message from non-transfer channel');
1002 freePacket
:= false;
1003 g_Net_Client_HandlePacket(ev
.packet
, g_Net_ClientLightMsgHandler
);
1004 if (g_Res_received_map_start
< 0) then begin result
:= -666; exit
; end;
1008 ett
:= getNewTimeoutEnd();
1009 if (ev
.packet
.dataLength
< 1) then
1011 e_LogWriteln('g_Net_Wait_Event: invalid server packet (no data)');
1015 Ptr
:= ev
.packet
^.data
;
1016 rMsgId
:= Byte(Ptr
^);
1017 e_LogWritefln('received transfer packet with id %d (%u bytes)', [rMsgId
, ev
.packet
^.dataLength
]);
1018 if (rMsgId
= NTF_SERVER_FILE_INFO
) then
1020 if not msg
.Init(ev
.packet
^.data
+1, ev
.packet
^.dataLength
-1, True) then exit
;
1021 tf
.hash
:= msg
.ReadMD5();
1022 tf
.size
:= msg
.ReadLongInt();
1023 tf
.chunkSize
:= msg
.ReadLongInt();
1024 tf
.diskName
:= ExtractFileName(msg
.readString());
1025 if (tf
.size
< 0) or (tf
.chunkSize
<> FILE_CHUNK_SIZE
) or (length(tf
.diskName
) = 0) then
1027 e_LogWritefln('g_Net_RequestResFileInfo: invalid file info packet', []);
1031 e_LogWritefln('got file info for resource #%d: size=%d; name=%s', [resIndex
, tf
.size
, tf
.diskName
]);
1032 Result
:= 0; // success
1035 else if (rMsgId
= NTF_SERVER_ABORT
) then
1037 e_LogWriteln('g_Net_RequestResFileInfo: server aborted transfer');
1041 else if (rMsgId
= NTF_SERVER_MAP_INFO
) then
1043 e_LogWriteln('g_Net_RequestResFileInfo: waiting for map info reply, but got file info reply');
1049 e_LogWriteln('g_Net_RequestResFileInfo: invalid server packet type');
1055 ENET_EVENT_TYPE_DISCONNECT
:
1057 if (ev
.data
<= NET_DISC_MAX
) then
1058 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 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CONN
] + ' unknown ENet event ' + IntToStr(Ord(ev
.kind
)), True);
1069 if (freePacket
) then begin freePacket
:= false; enet_packet_destroy(ev
.packet
); end;
1072 if g_Net_UserRequestExit() then
1074 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CONN
] + ' user abort', True);
1080 if (freePacket
) then enet_packet_destroy(ev
.packet
);
1085 // call this to cancel file transfer requested by `g_Net_RequestResFileInfo()`
1086 function g_Net_AbortResTransfer (var tf
: TNetFileTransfer
): Boolean;
1089 e_LogWritefln('aborting file transfer...', []);
1092 trans_omsg
.Write(Byte(NTF_CLIENT_ABORT
));
1093 result
:= ftransSendClientMsg(trans_omsg
);
1094 if result
then enet_host_flush(NetHost
);
1098 // call this to start file transfer requested by `g_Net_RequestResFileInfo()`
1100 // returns `false` on error or user abort
1109 // 2 on server abort
1110 // for maps, first `tf.diskName` name will be map wad name, and `tf.hash`/`tf.size` will contain map info
1111 function g_Net_ReceiveResourceFile (resIndex
: LongInt; var tf
: TNetFileTransfer
; strm
: TStream
): Integer;
1117 freePacket
: Boolean = false;
1120 nextChunk
: Integer = 0;
1121 chunkTotal
: Integer;
1128 tf
.resumed
:= false;
1129 e_LogWritefln('file `%s`, size=%d (%d)', [tf
.diskName
, Integer(strm
.size
), tf
.size
], TMsgType
.Notify
);
1130 // check if we should resume downloading
1131 resumed
:= (strm
.size
> tf
.chunkSize
) and (strm
.size
< tf
.size
);
1134 trans_omsg
.Write(Byte(NTF_CLIENT_START
));
1135 if resumed
then chunk
:= strm
.size
div tf
.chunkSize
else chunk
:= 0;
1136 trans_omsg
.Write(LongInt(chunk
));
1137 if not ftransSendClientMsg(trans_omsg
) then begin result
:= -1; exit
; end;
1139 strm
.Seek(chunk
*tf
.chunkSize
, soFromBeginning
);
1140 chunkTotal
:= (tf
.size
+tf
.chunkSize
-1) div tf
.chunkSize
;
1141 e_LogWritefln('receiving file `%s` (%d chunks)', [tf
.diskName
, chunkTotal
], TMsgType
.Notify
);
1142 g_Game_SetLoadingText('downloading "'+ExtractFileName(tf
.diskName
)+'"', chunkTotal
, False);
1143 tf
.resumed
:= resumed
;
1145 if (chunk
> 0) then g_Game_StepLoading(chunk
);
1148 // wait for reply data
1149 FillChar(ev
, SizeOf(ev
), 0);
1151 GetMem(buf
, tf
.chunkSize
);
1153 ett
:= getNewTimeoutEnd();
1155 //stx := -GetTimerMS();
1156 status
:= enet_host_service(NetHost
, @ev
, 300);
1158 if (status < 0) then
1160 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' network error', True);
1165 if (status
<= 0) then
1167 // check for timeout
1171 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CONN
] + ' timeout reached', True);
1180 ENET_EVENT_TYPE_RECEIVE
:
1183 if (ev
.channelID
<> NET_CHAN_DOWNLOAD_EX
) then
1185 //e_LogWritefln('g_Net_Wait_Event: skip message from non-transfer channel', []);
1186 freePacket
:= false;
1187 g_Net_Client_HandlePacket(ev
.packet
, g_Net_ClientLightMsgHandler
);
1188 if (g_Res_received_map_start
< 0) then begin result
:= -666; exit
; end;
1192 //stx := stx+GetTimerMS();
1193 //e_LogWritefln('g_Net_ReceiveResourceFile: stx=%d', [Integer(stx)]);
1194 //stx := -GetTimerMS();
1195 ett
:= getNewTimeoutEnd();
1196 if (ev
.packet
.dataLength
< 1) then
1198 e_LogWritefln('g_Net_ReceiveResourceFile: invalid server packet (no data)', []);
1202 Ptr
:= ev
.packet
^.data
;
1203 rMsgId
:= Byte(Ptr
^);
1204 if (rMsgId
= NTF_SERVER_DONE
) then
1206 e_LogWritefln('file transfer complete.', []);
1210 else if (rMsgId
= NTF_SERVER_CHUNK
) then
1212 if not msg
.Init(ev
.packet
^.data
+1, ev
.packet
^.dataLength
-1, True) then exit
;
1213 chunk
:= msg
.ReadLongInt();
1214 csize
:= msg
.ReadLongInt();
1215 if (chunk
<> nextChunk
) then
1217 e_LogWritefln('received chunk %d, but expected chunk %d', [chunk
, nextChunk
]);
1221 if (csize
< 0) or (csize
> tf
.chunkSize
) then
1223 e_LogWritefln('received chunk with size %d, but expected chunk size is %d', [csize
, tf
.chunkSize
]);
1227 //e_LogWritefln('got chunk #%d of #%d (csize=%d)', [chunk, (tf.size+tf.chunkSize-1) div tf.chunkSize, csize]);
1228 msg
.ReadData(buf
, csize
);
1229 strm
.WriteBuffer(buf
^, csize
);
1230 nextChunk
:= chunk
+1;
1231 g_Game_StepLoading();
1234 trans_omsg
.Write(Byte(NTF_CLIENT_ACK
));
1235 trans_omsg
.Write(LongInt(chunk
));
1236 if not ftransSendClientMsg(trans_omsg
) then begin result
:= -1; exit
; end;
1238 else if (rMsgId
= NTF_SERVER_ABORT
) then
1240 e_LogWritefln('g_Net_ReceiveResourceFile: server aborted transfer', []);
1246 e_LogWritefln('g_Net_ReceiveResourceFile: invalid server packet type', []);
1250 //stx := stx+GetTimerMS();
1251 //e_LogWritefln('g_Net_ReceiveResourceFile: process stx=%d', [Integer(stx)]);
1254 ENET_EVENT_TYPE_DISCONNECT
:
1256 if (ev
.data
<= NET_DISC_MAX
) then
1257 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CONN
] + ' ' + _lc
[TStrings_Locale(Cardinal(I_NET_DISC_NONE
) + ev
.data
)], True);
1263 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CONN
] + ' unknown ENet event ' + IntToStr(Ord(ev
.kind
)), True);
1268 if (freePacket
) then begin freePacket
:= false; enet_packet_destroy(ev
.packet
); end;
1271 if g_Net_UserRequestExit() then
1273 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CONN
] + ' user abort', True);
1280 if (freePacket
) then enet_packet_destroy(ev
.packet
);
1285 //**************************************************************************
1289 //**************************************************************************
1291 function g_Net_FindSlot(): Integer;
1300 for I
:= Low(NetClients
) to High(NetClients
) do
1302 if NetClients
[I
].Used
then
1311 if C
>= NetMaxClients
then
1319 if (Length(NetClients
) >= NetMaxClients
) then
1323 SetLength(NetClients
, Length(NetClients
) + 1);
1324 N
:= High(NetClients
);
1330 NetClients
[N
].Used
:= True;
1331 NetClients
[N
].ID
:= N
;
1332 NetClients
[N
].RequestedFullUpdate
:= False;
1333 NetClients
[N
].WaitForFirstSpawn
:= False;
1334 NetClients
[N
].RCONAuth
:= False;
1335 NetClients
[N
].Voted
:= False;
1336 NetClients
[N
].Player
:= 0;
1337 clearNetClientTransfers(NetClients
[N
]); // just in case
1344 function g_Net_Init(): Boolean;
1353 NetBuf
[NET_UNRELIABLE
].Clear();
1354 NetBuf
[NET_RELIABLE
].Clear();
1355 //SetLength(NetClients, 0);
1356 clearNetClients(true); // clear array
1362 NetAddr
.port
:= 25666;
1363 SetLength(NetBannedHosts
, 0);
1364 path
:= BANLIST_FILENAME
;
1365 if e_FindResource(DataDirs
, path
) = true then
1372 if StrToIp(IPstr
, IP
) then
1376 g_Net_SaveBanList();
1379 //Result := (enet_initialize() = 0);
1380 Result
:= enet_init_success
;
1383 procedure g_Net_Flush();
1387 F
, Chan
: enet_uint32
;
1391 Chan
:= NET_CHAN_GAME
;
1393 if NetMode
= NET_SERVER
then
1394 for T
:= NET_UNRELIABLE
to NET_RELIABLE
do
1396 if NetBuf
[T
].CurSize
> 0 then
1398 P
:= enet_packet_create(NetBuf
[T
].Data
, NetBuf
[T
].CurSize
, F
);
1399 if not Assigned(P
) then continue
;
1400 enet_host_broadcast(NetHost
, Chan
, P
);
1404 for I
:= Low(NetClients
) to High(NetClients
) do
1406 if not NetClients
[I
].Used
then continue
;
1407 if NetClients
[I
].NetOut
[T
].CurSize
<= 0 then continue
;
1408 P
:= enet_packet_create(NetClients
[I
].NetOut
[T
].Data
, NetClients
[I
].NetOut
[T
].CurSize
, F
);
1409 if not Assigned(P
) then continue
;
1410 enet_peer_send(NetClients
[I
].Peer
, Chan
, P
);
1411 NetClients
[I
].NetOut
[T
].Clear();
1414 // next and last iteration is always RELIABLE
1415 F
:= LongWord(ENET_PACKET_FLAG_RELIABLE
);
1416 Chan
:= NET_CHAN_IMPORTANT
;
1418 else if NetMode
= NET_CLIENT
then
1419 for T
:= NET_UNRELIABLE
to NET_RELIABLE
do
1421 if NetBuf
[T
].CurSize
> 0 then
1423 P
:= enet_packet_create(NetBuf
[T
].Data
, NetBuf
[T
].CurSize
, F
);
1424 if not Assigned(P
) then continue
;
1425 enet_peer_send(NetPeer
, Chan
, P
);
1428 // next and last iteration is always RELIABLE
1429 F
:= LongWord(ENET_PACKET_FLAG_RELIABLE
);
1430 Chan
:= NET_CHAN_IMPORTANT
;
1434 procedure g_Net_Cleanup();
1438 NetBuf
[NET_UNRELIABLE
].Clear();
1439 NetBuf
[NET_RELIABLE
].Clear();
1441 //SetLength(NetClients, 0);
1442 clearNetClients(true); // clear array
1443 NetClientCount
:= 0;
1447 g_Net_Slist_ServerClosed();
1451 NetState
:= NET_STATE_NONE
;
1453 NetPongSock
:= ENET_SOCKET_NULL
;
1455 NetTimeToMaster
:= 0;
1456 NetTimeToUpdate
:= 0;
1457 NetTimeToReliable
:= 0;
1459 NetMode
:= NET_NONE
;
1461 if NetPortThread
<> NilThreadId
then
1462 WaitForThreadTerminate(NetPortThread
, 66666);
1464 NetPortThread
:= NilThreadId
;
1465 g_Net_UnforwardPorts();
1471 procedure g_Net_Free();
1475 //enet_deinitialize();
1476 NetInitDone
:= False;
1480 //**************************************************************************
1484 //**************************************************************************
1486 function ForwardThread(Param
: Pointer): PtrInt
;
1489 if not g_Net_ForwardPorts() then Result
:= -1;
1492 function g_Net_Host(IPAddr
: LongWord; Port
: enet_uint16
; MaxClients
: Cardinal = 16): Boolean;
1494 if NetMode
<> NET_NONE
then
1496 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_INGAME
]);
1503 g_Console_Add(_lc
[I_NET_MSG
] + Format(_lc
[I_NET_MSG_HOST
], [Port
]));
1504 if not NetInitDone
then
1506 if (not g_Net_Init()) then
1508 g_Console_Add(_lc
[I_NET_MSG_FERROR
] + _lc
[I_NET_ERR_ENET
]);
1513 NetInitDone
:= True;
1516 NetAddr
.host
:= IPAddr
;
1517 NetAddr
.port
:= Port
;
1519 NetHost
:= enet_host_create(@NetAddr
, NET_MAXCLIENTS
, NET_CHANS
, 0, 0);
1521 if (NetHost
= nil) then
1523 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + Format(_lc
[I_NET_ERR_HOST
], [Port
]));
1529 if NetForwardPorts
then NetPortThread
:= BeginThread(ForwardThread
);
1531 NetPongSock
:= enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM
);
1532 if NetPongSock
<> ENET_SOCKET_NULL
then
1534 NetPongAddr
.host
:= IPAddr
;
1535 NetPongAddr
.port
:= NET_PING_PORT
;
1536 if enet_socket_bind(NetPongSock
, @NetPongAddr
) < 0 then
1538 enet_socket_destroy(NetPongSock
);
1539 NetPongSock
:= ENET_SOCKET_NULL
;
1542 enet_socket_set_option(NetPongSock
, ENET_SOCKOPT_NONBLOCK
, 1);
1545 NetMode
:= NET_SERVER
;
1547 NetBuf
[NET_UNRELIABLE
].Clear();
1548 NetBuf
[NET_RELIABLE
].Clear();
1554 procedure g_Net_Host_Die();
1558 if NetMode
<> NET_SERVER
then Exit
;
1560 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_HOST_DISCALL
]);
1561 for I
:= 0 to High(NetClients
) do
1562 if NetClients
[I
].Used
then
1563 enet_peer_disconnect(NetClients
[I
].Peer
, NET_DISC_DOWN
);
1565 while enet_host_service(NetHost
, @NetEvent
, 1000) > 0 do
1566 if NetEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
then
1567 enet_packet_destroy(NetEvent
.packet
);
1569 for I
:= 0 to High(NetClients
) do
1570 if NetClients
[I
].Used
then
1572 FreeMemory(NetClients
[I
].Peer
^.data
);
1573 NetClients
[I
].Peer
^.data
:= nil;
1574 enet_peer_reset(NetClients
[I
].Peer
);
1575 NetClients
[I
].Peer
:= nil;
1576 NetClients
[I
].Used
:= False;
1577 NetClients
[I
].Player
:= 0;
1578 NetClients
[I
].Crimes
:= 0;
1579 NetClients
[I
].AuthTime
:= 0;
1580 NetClients
[I
].MsgTime
:= 0;
1581 NetClients
[I
].NetOut
[NET_UNRELIABLE
].Free();
1582 NetClients
[I
].NetOut
[NET_RELIABLE
].Free();
1585 clearNetClients(false); // don't clear array
1586 g_Net_Slist_ServerClosed();
1587 if NetPongSock
<> ENET_SOCKET_NULL
then
1588 enet_socket_destroy(NetPongSock
);
1590 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_HOST_DIE
]);
1591 enet_host_destroy(NetHost
);
1593 NetMode
:= NET_NONE
;
1596 e_WriteLog('NET: Server stopped', TMsgType
.Notify
);
1600 procedure g_Net_Host_Send(ID
: Integer; Reliable
: Boolean; Chan
: Byte = NET_CHAN_GAME
);
1607 T
:= NET_UNRELIABLE
;
1611 if ID
> High(NetClients
) then Exit
;
1612 if NetClients
[ID
].Peer
= nil then Exit
;
1614 NetClients
[ID
].NetOut
[T
].Write(Integer(NetOut
.CurSize
));
1615 NetClients
[ID
].NetOut
[T
].Write(NetOut
);
1620 NetBuf
[T
].Write(Integer(NetOut
.CurSize
));
1621 NetBuf
[T
].Write(NetOut
);
1624 if NetDump
then g_Net_DumpSendBuffer();
1628 procedure g_Net_Host_Disconnect_Client(ID
: Integer; Force
: Boolean = False);
1633 TC
:= @NetClients
[ID
];
1634 if (TC
= nil) then Exit
;
1635 clearNetClient(NetClients
[ID
]);
1636 if not (TC
^.Used
) then Exit
;
1638 TP
:= g_Player_Get(TC
^.Player
);
1643 TP
.Kill(K_SIMPLEKILL
, 0, HIT_DISCON
);
1644 g_Console_Add(Format(_lc
[I_PLAYER_LEAVE
], [TP
.Name
]), True);
1645 e_WriteLog('NET: Client ' + TP
.Name
+ ' [' + IntToStr(TC
^.ID
) + '] disconnected.', TMsgType
.Notify
);
1646 g_Player_Remove(TP
.UID
);
1649 if (TC
^.Peer
^.data
<> nil) then
1651 FreeMemory(TC
^.Peer
^.data
);
1652 TC
^.Peer
^.data
:= nil;
1656 enet_peer_reset(TC
^.Peer
);
1659 TC
^.State
:= NET_STATE_NONE
;
1665 TC
^.RequestedFullUpdate
:= False;
1666 TC
^.FullUpdateSent
:= False;
1667 TC
^.WaitForFirstSpawn
:= False;
1668 TC
^.NetOut
[NET_UNRELIABLE
].Free();
1669 TC
^.NetOut
[NET_RELIABLE
].Free();
1671 g_Console_Add(_lc
[I_NET_MSG
] + Format(_lc
[I_NET_MSG_HOST_DISC
], [ID
]));
1672 Dec(NetClientCount
);
1674 if NetUseMaster
then g_Net_Slist_ServerPlayerLeaves();
1677 procedure g_Net_Host_CheckPings();
1679 ClAddr
: ENetAddress
;
1683 Ping
: array [0..9] of Byte;
1686 if (NetPongSock
= ENET_SOCKET_NULL
) or (NetHost
= nil) then Exit
;
1688 Buf
.data
:= Addr(Ping
[0]);
1689 Buf
.dataLength
:= 2+8;
1693 Len
:= enet_socket_receive(NetPongSock
, @ClAddr
, @Buf
, 1);
1694 if Len
< 0 then Exit
;
1696 if (Ping
[0] = Ord('D')) and (Ping
[1] = Ord('F')) then
1698 ClTime
:= Int64(Addr(Ping
[2])^);
1701 NetOut
.Write(Byte(Ord('D')));
1702 NetOut
.Write(Byte(Ord('F')));
1703 NetOut
.Write(NetHost
.address
.port
);
1704 NetOut
.Write(ClTime
);
1705 TMasterHost
.writeInfo(NetOut
);
1707 if gPlayer1
<> nil then Inc(NPl
);
1708 if gPlayer2
<> nil then Inc(NPl
);
1710 NetOut
.Write(gNumBots
);
1712 Buf
.data
:= NetOut
.Data
;
1713 Buf
.dataLength
:= NetOut
.CurSize
;
1714 enet_socket_send(NetPongSock
, @ClAddr
, @Buf
, 1);
1720 procedure g_Net_Host_CheckTimeouts();
1724 for ID
:= Low(NetClients
) to High(NetClients
) do
1726 with NetClients
[ID
] do
1728 if (Peer
= nil) or (State
= NET_STATE_NONE
) then continue
;
1729 if (State
= NET_STATE_AUTH
) and (AuthTime
> 0) and (AuthTime
<= gTime
) then
1731 g_Net_Penalize(@NetClients
[ID
], 'auth taking too long');
1732 AuthTime
:= gTime
+ 1000; // do it every second to give them a chance
1734 else if (State
= NET_STATE_GAME
) and (MsgTime
> 0) and (MsgTime
<= gTime
) then
1736 // client hasn't sent packets in a while; either ban em or kick em
1737 if (NetAutoBanForTimeout
) then
1739 g_Net_Penalize(@NetClients
[ID
], 'message timeout');
1740 MsgTime
:= gTime
+ (NetPacketTimeout
div 2) + 500; // wait less for the next check
1744 e_LogWritefln('NET: client #%u (cid #%u) timed out', [ID
, Player
]);
1745 g_Net_Host_Disconnect_Client(ID
, True);
1753 procedure g_Net_Host_Update();
1762 if NetUseMaster
then g_Net_Slist_Pulse();
1763 g_Net_Host_CheckPings();
1764 g_Net_Host_CheckTimeouts();
1766 while (enet_host_service(NetHost
, @NetEvent
, 0) > 0) do
1768 case (NetEvent
.kind
) of
1769 ENET_EVENT_TYPE_CONNECT
:
1771 IP
:= IpToStr(NetEvent
.Peer
^.address
.host
);
1772 Port
:= NetEvent
.Peer
^.address
.port
;
1773 g_Console_Add(_lc
[I_NET_MSG
] +
1774 Format(_lc
[I_NET_MSG_HOST_CONN
], [IP
, Port
]));
1775 e_WriteLog('NET: Connection request from ' + IP
+ '.', TMsgType
.Notify
);
1777 if (NetEvent
.data
<> NET_PROTOCOL_VER
) then
1779 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_HOST_REJECT
] +
1780 _lc
[I_NET_DISC_PROTOCOL
]);
1781 e_WriteLog('NET: Connection request from ' + IP
+ ' rejected: version mismatch',
1783 NetEvent
.peer
^.data
:= GetMemory(SizeOf(Byte));
1784 Byte(NetEvent
.peer
^.data
^) := 255;
1785 enet_peer_disconnect(NetEvent
.peer
, NET_DISC_PROTOCOL
);
1786 enet_host_flush(NetHost
);
1790 if g_Net_IsHostBanned(NetEvent
.Peer
^.address
.host
) then
1792 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_HOST_REJECT
] +
1793 _lc
[I_NET_DISC_BAN
]);
1794 e_WriteLog('NET: Connection request from ' + IP
+ ' rejected: banned',
1796 NetEvent
.peer
^.data
:= GetMemory(SizeOf(Byte));
1797 Byte(NetEvent
.peer
^.data
^) := 255;
1798 enet_peer_disconnect(NetEvent
.Peer
, NET_DISC_BAN
);
1799 enet_host_flush(NetHost
);
1803 ID
:= g_Net_FindSlot();
1807 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_HOST_REJECT
] +
1808 _lc
[I_NET_DISC_FULL
]);
1809 e_WriteLog('NET: Connection request from ' + IP
+ ' rejected: server full',
1811 NetEvent
.Peer
^.data
:= GetMemory(SizeOf(Byte));
1812 Byte(NetEvent
.peer
^.data
^) := 255;
1813 enet_peer_disconnect(NetEvent
.peer
, NET_DISC_FULL
);
1814 enet_host_flush(NetHost
);
1818 NetClients
[ID
].Peer
:= NetEvent
.peer
;
1819 NetClients
[ID
].Peer
^.data
:= GetMemory(SizeOf(Byte));
1820 Byte(NetClients
[ID
].Peer
^.data
^) := ID
;
1821 NetClients
[ID
].State
:= NET_STATE_AUTH
;
1822 NetClients
[ID
].Player
:= 0;
1823 NetClients
[ID
].Crimes
:= 0;
1824 NetClients
[ID
].RCONAuth
:= False;
1825 NetClients
[ID
].NetOut
[NET_UNRELIABLE
].Alloc(NET_BUFSIZE
*2);
1826 NetClients
[ID
].NetOut
[NET_RELIABLE
].Alloc(NET_BUFSIZE
*2);
1827 if (NetAuthTimeout
> 0) then
1828 NetClients
[ID
].AuthTime
:= gTime
+ NetAuthTimeout
1830 NetClients
[ID
].AuthTime
:= 0;
1831 if (NetPacketTimeout
> 0) then
1832 NetClients
[ID
].MsgTime
:= gTime
+ NetPacketTimeout
1834 NetClients
[ID
].MsgTime
:= 0;
1835 clearNetClientTransfers(NetClients
[ID
]); // just in case
1837 enet_peer_timeout(NetEvent
.peer
, ENET_PEER_TIMEOUT_LIMIT
* 2, ENET_PEER_TIMEOUT_MINIMUM
* 2, ENET_PEER_TIMEOUT_MAXIMUM
* 2);
1839 Inc(NetClientCount
);
1840 g_Console_Add(_lc
[I_NET_MSG
] + Format(_lc
[I_NET_MSG_HOST_ADD
], [ID
]));
1843 ENET_EVENT_TYPE_RECEIVE
:
1845 //e_LogWritefln('RECEIVE: chan=%u', [NetEvent.channelID]);
1846 if (NetEvent
.channelID
= NET_CHAN_DOWNLOAD_EX
) then
1848 ProcessDownloadExPacket();
1852 ID
:= Byte(NetEvent
.peer
^.data
^);
1853 if ID
> High(NetClients
) then Exit
;
1854 TC
:= @NetClients
[ID
];
1856 if (NetPacketTimeout
> 0) then
1857 TC
^.MsgTime
:= gTime
+ NetPacketTimeout
;
1859 if NetDump
then g_Net_DumpRecvBuffer(NetEvent
.packet
^.data
, NetEvent
.packet
^.dataLength
);
1860 g_Net_Host_HandlePacket(TC
, NetEvent
.packet
, g_Net_HostMsgHandler
);
1864 ENET_EVENT_TYPE_DISCONNECT
:
1866 ID
:= Byte(NetEvent
.peer
^.data
^);
1867 if ID
> High(NetClients
) then Exit
;
1868 g_Net_Host_Disconnect_Client(ID
);
1875 //**************************************************************************
1879 //**************************************************************************
1881 procedure g_Net_Disconnect(Forced
: Boolean = False);
1883 if NetMode
<> NET_CLIENT
then Exit
;
1884 if (NetHost
= nil) or (NetPeer
= nil) then Exit
;
1888 enet_peer_disconnect(NetPeer
, NET_DISC_NONE
);
1890 while (enet_host_service(NetHost
, @NetEvent
, 1500) > 0) do
1892 if (NetEvent
.kind
= ENET_EVENT_TYPE_DISCONNECT
) then
1898 if (NetEvent
.kind
= ENET_EVENT_TYPE_RECEIVE
) then
1899 enet_packet_destroy(NetEvent
.packet
);
1902 if NetPeer
<> nil then
1904 enet_peer_reset(NetPeer
);
1910 e_WriteLog('NET: Kicked from server: ' + IntToStr(NetEvent
.data
), TMsgType
.Notify
);
1911 if (NetEvent
.data
<= NET_DISC_MAX
) then
1912 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_KICK
] +
1913 _lc
[TStrings_Locale(Cardinal(I_NET_DISC_NONE
) + NetEvent
.data
)], True);
1916 if NetHost
<> nil then
1918 enet_host_destroy(NetHost
);
1921 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_CLIENT_DISC
]);
1924 e_WriteLog('NET: Disconnected', TMsgType
.Notify
);
1927 procedure g_Net_Client_Send(Reliable
: Boolean; Chan
: Byte = NET_CHAN_GAME
);
1934 T
:= NET_UNRELIABLE
;
1937 NetBuf
[T
].Write(Integer(NetOut
.CurSize
));
1938 NetBuf
[T
].Write(NetOut
);
1940 if NetDump
then g_Net_DumpSendBuffer();
1942 g_Net_Flush(); // FIXME: for now, send immediately
1945 procedure g_Net_Client_Update();
1947 while (NetHost
<> nil) and (enet_host_service(NetHost
, @NetEvent
, 0) > 0) do
1949 case NetEvent
.kind
of
1950 ENET_EVENT_TYPE_RECEIVE
:
1952 if (NetEvent
.channelID
= NET_CHAN_DOWNLOAD_EX
) then continue
; // ignore all download packets, they're processed by separate code
1953 if NetDump
then g_Net_DumpRecvBuffer(NetEvent
.packet
^.data
, NetEvent
.packet
^.dataLength
);
1954 g_Net_Client_HandlePacket(NetEvent
.packet
, g_Net_ClientMsgHandler
);
1957 ENET_EVENT_TYPE_DISCONNECT
:
1959 g_Net_Disconnect(True);
1966 procedure g_Net_Client_UpdateWhileLoading();
1968 while (enet_host_service(NetHost
, @NetEvent
, 0) > 0) do
1970 case NetEvent
.kind
of
1971 ENET_EVENT_TYPE_RECEIVE
:
1973 if (NetEvent
.channelID
= NET_CHAN_DOWNLOAD_EX
) then continue
; // ignore all download packets, they're processed by separate code
1974 if NetDump
then g_Net_DumpRecvBuffer(NetEvent
.packet
^.data
, NetEvent
.packet
^.dataLength
);
1975 g_Net_Client_HandlePacket(NetEvent
.packet
, g_Net_ClientLightMsgHandler
);
1978 ENET_EVENT_TYPE_DISCONNECT
:
1980 g_Net_Disconnect(True);
1988 function g_Net_Connect(IP
: string; Port
: enet_uint16
): Boolean;
1991 TimeoutTime
, T
: Int64;
1993 if NetMode
<> NET_NONE
then
1995 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_ERR_INGAME
], True);
2002 g_Console_Add(_lc
[I_NET_MSG
] + Format(_lc
[I_NET_MSG_CLIENT_CONN
],
2004 if not NetInitDone
then
2006 if (not g_Net_Init()) then
2008 g_Console_Add(_lc
[I_NET_MSG_FERROR
] + _lc
[I_NET_ERR_ENET
], True);
2013 NetInitDone
:= True;
2016 NetHost
:= enet_host_create(nil, 1, NET_CHANS
, 0, 0);
2018 if (NetHost
= nil) then
2020 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CLIENT
], True);
2026 enet_address_set_host(@NetAddr
, PChar(Addr(IP
[1])));
2027 NetAddr
.port
:= Port
;
2029 NetPeer
:= enet_host_connect(NetHost
, @NetAddr
, NET_CHANS
, NET_PROTOCOL_VER
);
2031 if (NetPeer
= nil) then
2033 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_CLIENT
], True);
2034 enet_host_destroy(NetHost
);
2040 // предупредить что ждем слишком долго через N секунд
2041 TimeoutTime
:= sys_GetTicks() + NET_CONNECT_TIMEOUT
;
2046 while (enet_host_service(NetHost
, @NetEvent
, 0) > 0) do
2048 if (NetEvent
.kind
= ENET_EVENT_TYPE_CONNECT
) then
2050 g_Console_Add(_lc
[I_NET_MSG
] + _lc
[I_NET_MSG_CLIENT_DONE
]);
2051 NetMode
:= NET_CLIENT
;
2053 enet_peer_timeout(NetPeer
, ENET_PEER_TIMEOUT_LIMIT
* 2, ENET_PEER_TIMEOUT_MINIMUM
* 2, ENET_PEER_TIMEOUT_MAXIMUM
* 2);
2055 NetClientPort
:= Port
;
2062 T
:= sys_GetTicks();
2063 if T
> TimeoutTime
then
2065 TimeoutTime
:= T
+ NET_CONNECT_TIMEOUT
* 100; // одного предупреждения хватит
2066 g_Console_Add(_lc
[I_NET_MSG_TIMEOUT_WARN
], True);
2067 g_Console_Add(Format(_lc
[I_NET_MSG_PORTS
], [Integer(Port
), Integer(NET_PING_PORT
)]), True);
2070 ProcessLoading(true);
2072 if e_KeyPressed(IK_SPACE
) or e_KeyPressed(IK_ESCAPE
) or e_KeyPressed(VK_ESCAPE
) or
2073 e_KeyPressed(JOY0_JUMP
) or e_KeyPressed(JOY1_JUMP
) or e_KeyPressed(JOY2_JUMP
) or e_KeyPressed(JOY3_JUMP
) then
2077 g_Console_Add(_lc
[I_NET_MSG_ERROR
] + _lc
[I_NET_ERR_TIMEOUT
], True);
2078 g_Console_Add(Format(_lc
[I_NET_MSG_PORTS
], [Integer(Port
), Integer(NET_PING_PORT
)]), True);
2079 if NetPeer
<> nil then enet_peer_reset(NetPeer
);
2080 if NetHost
<> nil then
2082 enet_host_destroy(NetHost
);
2089 function IpToStr(IP
: LongWord): string;
2094 Result
:= IntToStr(PByte(Ptr
+ 0)^) + '.';
2095 Result
:= Result
+ IntToStr(PByte(Ptr
+ 1)^) + '.';
2096 Result
:= Result
+ IntToStr(PByte(Ptr
+ 2)^) + '.';
2097 Result
:= Result
+ IntToStr(PByte(Ptr
+ 3)^);
2100 function StrToIp(IPstr
: string; var IP
: LongWord): Boolean;
2104 Result
:= enet_address_set_host(@EAddr
, PChar(@IPstr
[1])) = 0;
2108 function g_Net_Client_ByName(Name
: string): pTNetClient
;
2114 for a
:= Low(NetClients
) to High(NetClients
) do
2115 if (NetClients
[a
].Used
) and (NetClients
[a
].State
= NET_STATE_GAME
) then
2117 pl
:= g_Player_Get(NetClients
[a
].Player
);
2118 if pl
= nil then continue
;
2119 if Copy(LowerCase(pl
.Name
), 1, Length(Name
)) <> LowerCase(Name
) then continue
;
2120 if NetClients
[a
].Peer
<> nil then
2122 Result
:= @NetClients
[a
];
2128 function g_Net_Client_ByPlayer(PID
: Word): pTNetClient
;
2133 for a
:= Low(NetClients
) to High(NetClients
) do
2134 if (NetClients
[a
].Used
) and (NetClients
[a
].State
= NET_STATE_GAME
) then
2135 if NetClients
[a
].Player
= PID
then
2137 Result
:= @NetClients
[a
];
2142 function g_Net_ClientName_ByID(ID
: Integer): string;
2148 if ID
= NET_EVERYONE
then
2150 for a
:= Low(NetClients
) to High(NetClients
) do
2151 if (NetClients
[a
].ID
= ID
) and (NetClients
[a
].Used
) and (NetClients
[a
].State
= NET_STATE_GAME
) then
2153 pl
:= g_Player_Get(NetClients
[a
].Player
);
2154 if pl
= nil then Exit
;
2159 procedure g_Net_SendData(Data
: AByte
; peer
: pENetPeer
; Reliable
: Boolean; Chan
: Byte = NET_CHAN_DOWNLOAD
);
2163 dataLength
: Cardinal;
2165 dataLength
:= Length(Data
);
2168 F
:= LongWord(ENET_PACKET_FLAG_RELIABLE
)
2172 if (peer
<> nil) then
2174 P
:= enet_packet_create(@Data
[0], dataLength
, F
);
2175 if not Assigned(P
) then Exit
;
2176 enet_peer_send(peer
, Chan
, P
);
2180 P
:= enet_packet_create(@Data
[0], dataLength
, F
);
2181 if not Assigned(P
) then Exit
;
2182 enet_host_broadcast(NetHost
, Chan
, P
);
2185 enet_host_flush(NetHost
);
2188 function g_Net_IsHostBanned(IP
: LongWord; Perm
: Boolean = False): Boolean;
2193 if NetBannedHosts
= nil then
2195 for I
:= 0 to High(NetBannedHosts
) do
2196 if (NetBannedHosts
[I
].IP
= IP
) and ((not Perm
) or (NetBannedHosts
[I
].Perm
)) then
2203 procedure g_Net_BanHost(IP
: LongWord; Perm
: Boolean = True); overload
;
2209 if g_Net_IsHostBanned(IP
, Perm
) then
2213 for I
:= Low(NetBannedHosts
) to High(NetBannedHosts
) do
2214 if NetBannedHosts
[I
].IP
= 0 then
2222 SetLength(NetBannedHosts
, Length(NetBannedHosts
) + 1);
2223 P
:= High(NetBannedHosts
);
2226 NetBannedHosts
[P
].IP
:= IP
;
2227 NetBannedHosts
[P
].Perm
:= Perm
;
2230 procedure g_Net_BanHost(IP
: string; Perm
: Boolean = True); overload
;
2235 b
:= StrToIp(IP
, a
);
2237 g_Net_BanHost(a
, Perm
);
2240 procedure g_Net_UnbanNonPermHosts();
2244 if NetBannedHosts
= nil then
2246 for I
:= Low(NetBannedHosts
) to High(NetBannedHosts
) do
2247 if (NetBannedHosts
[I
].IP
> 0) and not NetBannedHosts
[I
].Perm
then
2249 NetBannedHosts
[I
].IP
:= 0;
2250 NetBannedHosts
[I
].Perm
:= True;
2254 function g_Net_UnbanHost(IP
: string): Boolean; overload
;
2258 Result
:= StrToIp(IP
, a
);
2260 Result
:= g_Net_UnbanHost(a
);
2263 function g_Net_UnbanHost(IP
: LongWord): Boolean; overload
;
2270 if NetBannedHosts
= nil then
2272 for I
:= 0 to High(NetBannedHosts
) do
2273 if NetBannedHosts
[I
].IP
= IP
then
2275 NetBannedHosts
[I
].IP
:= 0;
2276 NetBannedHosts
[I
].Perm
:= True;
2278 // no break here to clear all bans of this host, perm and non-perm
2282 procedure g_Net_SaveBanList();
2288 path
:= e_GetWriteableDir(DataDirs
);
2291 path
:= e_CatPath(path
, BANLIST_FILENAME
);
2294 if NetBannedHosts
<> nil then
2295 for I
:= 0 to High(NetBannedHosts
) do
2296 if NetBannedHosts
[I
].Perm
and (NetBannedHosts
[I
].IP
> 0) then
2297 Writeln(F
, IpToStr(NetBannedHosts
[I
].IP
));
2302 procedure g_Net_Penalize(C
: pTNetClient
; Reason
: string);
2306 e_LogWritefln('NET: client #%u (cid #%u) triggered a penalty (%d/%d): %s',
2307 [C
^.ID
, C
^.Player
, C
^.Crimes
+ 1, NetAutoBanLimit
, Reason
]);
2309 if (NetAutoBanLimit
<= 0) then Exit
;
2311 if (C
^.Crimes
>= NetAutoBanLimit
) then
2313 // we have tried asking nicely before, now it is time to die
2314 e_LogWritefln('NET: client #%u (cid #%u) force kicked',
2315 [C
^.ID
, C
^.Player
]);
2316 g_Net_Host_Disconnect_Client(C
^.ID
, True);
2322 if (NetAutoBanWarn
) then
2323 MH_SEND_Chat('You have been warned by the server: ' + Reason
, NET_CHAT_SYSTEM
, C
^.ID
);
2325 if (C
^.Crimes
>= NetAutoBanLimit
) then
2327 s
:= '#' + IntToStr(C
^.ID
); // can't be arsed
2328 g_Net_BanHost(C
^.Peer
^.address
.host
, NetAutoBanPerm
);
2329 enet_peer_disconnect(C
^.Peer
, NET_DISC_BAN
);
2330 g_Console_Add(Format(_lc
[I_PLAYER_BAN
], [s
]));
2331 MH_SEND_GameEvent(NET_EV_PLAYER_BAN
, 0, s
);
2332 g_Net_Slist_ServerPlayerLeaves();
2336 procedure g_Net_DumpStart();
2338 if NetMode
= NET_SERVER
then
2339 NetDumpFile
:= e_CreateResource(LogDirs
, NETDUMP_FILENAME
+ '_server')
2341 NetDumpFile
:= e_CreateResource(LogDirs
, NETDUMP_FILENAME
+ '_client');
2344 procedure g_Net_DumpSendBuffer();
2346 writeInt(NetDumpFile
, gTime
);
2347 writeInt(NetDumpFile
, LongWord(NetOut
.CurSize
));
2348 writeInt(NetDumpFile
, Byte(1));
2349 NetDumpFile
.WriteBuffer(NetOut
.Data
^, NetOut
.CurSize
);
2352 procedure g_Net_DumpRecvBuffer(Buf
: penet_uint8
; Len
: LongWord);
2354 if (Buf
= nil) or (Len
= 0) then Exit
;
2355 writeInt(NetDumpFile
, gTime
);
2356 writeInt(NetDumpFile
, Len
);
2357 writeInt(NetDumpFile
, Byte(0));
2358 NetDumpFile
.WriteBuffer(Buf
^, Len
);
2361 procedure g_Net_DumpEnd();
2367 function g_Net_ForwardPorts(ForwardPongPort
: Boolean = True): Boolean;
2368 {$IFDEF USE_MINIUPNPC}
2373 LanAddr
: array [0..255] of Char;
2374 StrPort
: AnsiString;
2379 if NetHost
= nil then
2382 if NetPortForwarded
= NetHost
.address
.port
then
2388 NetPongForwarded
:= False;
2389 NetPortForwarded
:= 0;
2391 DevList
:= upnpDiscover(1000, nil, nil, 0, 0, 2, Addr(Err
));
2392 if DevList
= nil then
2394 conwritefln('port forwarding failed: upnpDiscover() failed: %d', [Err
]);
2398 I
:= UPNP_GetValidIGD(DevList
, @Urls
, @Data
, Addr(LanAddr
[0]), 256);
2402 conwriteln('port forwarding failed: could not find an IGD device on this LAN');
2403 FreeUPNPDevList(DevList
);
2404 FreeUPNPUrls(@Urls
);
2408 StrPort
:= IntToStr(NetHost
.address
.port
);
2409 I
:= UPNP_AddPortMapping(
2410 Urls
.controlURL
, Addr(data
.first
.servicetype
[1]),
2411 PChar(StrPort
), PChar(StrPort
), Addr(LanAddr
[0]), PChar('D2DF'),
2412 PChar('UDP'), nil, PChar('0')
2417 conwritefln('forwarding port %d failed: error %d', [NetHost
.address
.port
, I
]);
2418 FreeUPNPDevList(DevList
);
2419 FreeUPNPUrls(@Urls
);
2423 if ForwardPongPort
then
2425 StrPort
:= IntToStr(NET_PING_PORT
);
2426 I
:= UPNP_AddPortMapping(
2427 Urls
.controlURL
, Addr(data
.first
.servicetype
[1]),
2428 PChar(StrPort
), PChar(StrPort
), Addr(LanAddr
[0]), PChar('D2DF'),
2429 PChar('UDP'), nil, PChar('0')
2434 conwritefln('forwarding port %d failed: error %d', [NET_PING_PORT
, I
]);
2435 NetPongForwarded
:= False;
2439 conwritefln('forwarded port %d successfully', [NET_PING_PORT
]);
2440 NetPongForwarded
:= True;
2444 conwritefln('forwarded port %d successfully', [NetHost
.address
.port
]);
2445 NetIGDControl
:= AnsiString(Urls
.controlURL
);
2446 NetIGDService
:= data
.first
.servicetype
;
2447 NetPortForwarded
:= NetHost
.address
.port
;
2449 FreeUPNPDevList(DevList
);
2450 FreeUPNPUrls(@Urls
);
2459 procedure g_Net_UnforwardPorts();
2460 {$IFDEF USE_MINIUPNPC}
2463 StrPort
: AnsiString;
2465 if NetPortForwarded
= 0 then Exit
;
2467 conwriteln('unforwarding ports...');
2469 StrPort
:= IntToStr(NetPortForwarded
);
2470 I
:= UPNP_DeletePortMapping(
2471 PChar(NetIGDControl
), Addr(NetIGDService
[1]),
2472 PChar(StrPort
), PChar('UDP'), nil
2474 conwritefln(' port %d: %d', [NetPortForwarded
, I
]);
2476 if NetPongForwarded
then
2478 NetPongForwarded
:= False;
2479 StrPort
:= IntToStr(NET_PING_PORT
);
2480 I
:= UPNP_DeletePortMapping(
2481 PChar(NetIGDControl
), Addr(NetIGDService
[1]),
2482 PChar(StrPort
), PChar('UDP'), nil
2484 conwritefln(' port %d: %d', [NET_PING_PORT
, I
]);
2487 NetPortForwarded
:= 0;
2494 procedure NetServerCVars(P
: SSArray
);
2499 cmd
:= LowerCase(P
[0]);
2503 if (Length(P
) > 1) and (Length(P
[1]) > 0) then
2505 NetServerName
:= P
[1];
2506 if Length(NetServerName
) > 64 then
2507 SetLength(NetServerName
, 64);
2508 g_Net_Slist_ServerRenamed();
2510 g_Console_Add(cmd
+ ' "' + NetServerName
+ '"');
2514 if (Length(P
) > 1) and (Length(P
[1]) > 0) then
2516 NetPassword
:= P
[1];
2517 if Length(NetPassword
) > 24 then
2518 SetLength(NetPassword
, 24);
2519 g_Net_Slist_ServerRenamed();
2521 g_Console_Add(cmd
+ ' "' + AnsiLowerCase(NetPassword
) + '"');
2525 if (Length(P
) > 1) then
2527 NetMaxClients
:= nclamp(StrToIntDef(P
[1], NetMaxClients
), 1, NET_MAXCLIENTS
);
2528 if g_Game_IsServer
and g_Game_IsNet
then
2531 for a
:= 0 to High(NetClients
) do
2533 if NetClients
[a
].Used
then
2536 if b
> NetMaxClients
then
2538 s
:= g_Player_Get(NetClients
[a
].Player
).Name
;
2539 enet_peer_disconnect(NetClients
[a
].Peer
, NET_DISC_FULL
);
2540 g_Console_Add(Format(_lc
[I_PLAYER_KICK
], [s
]));
2541 MH_SEND_GameEvent(NET_EV_PLAYER_KICK
, 0, s
);
2545 g_Net_Slist_ServerRenamed();
2548 g_Console_Add(cmd
+ ' ' + IntToStr(NetMaxClients
));
2552 if (Length(P
) > 1) then
2554 NetUseMaster
:= StrToIntDef(P
[1], Byte(NetUseMaster
)) <> 0;
2555 if NetUseMaster
then g_Net_Slist_Public() else g_Net_Slist_Private();
2557 g_Console_Add(cmd
+ ' ' + IntToStr(Byte(NetUseMaster
)));
2561 if (Length(P
) > 1) then
2563 if not g_Game_IsNet
then
2564 NetPort
:= nclamp(StrToIntDef(P
[1], NetPort
), 0, $FFFF)
2566 g_Console_Add(_lc
[I_MSG_NOT_NETGAME
]);
2568 g_Console_Add(cmd
+ ' ' + IntToStr(Ord(NetUseMaster
)));
2574 conRegVar('cl_downloadtimeout', @g_Net_DownloadTimeout
, 0.0, 1000000.0, '', 'timeout in seconds, 0 to disable it');
2575 conRegVar('cl_predictself', @NetPredictSelf
, '', 'predict local player');
2576 conRegVar('cl_forceplayerupdate', @NetForcePlayerUpdate
, '', 'update net players on NET_MSG_PLRPOS');
2577 conRegVar('cl_interp', @NetInterpLevel
, '', 'net player interpolation steps');
2578 conRegVar('cl_last_ip', @NetClientIP
, '', 'address of the last you have connected to');
2579 conRegVar('cl_last_port', @NetClientPort
, '', 'port of the last server you have connected to');
2580 conRegVar('cl_deafen', @NetDeafLevel
, '', 'filter server messages (0-3)');
2582 conRegVar('sv_forwardports', @NetForwardPorts
, '', 'forward server port using miniupnpc (requires server restart)');
2583 conRegVar('sv_rcon', @NetAllowRCON
, '', 'enable remote console');
2584 conRegVar('sv_rcon_password', @NetRCONPassword
, '', 'remote console password');
2585 conRegVar('sv_update_interval', @NetUpdateRate
, '', 'unreliable update interval');
2586 conRegVar('sv_reliable_interval', @NetRelupdRate
, '', 'reliable update interval');
2587 conRegVar('sv_master_interval', @NetMasterRate
, '', 'master server update interval');
2589 conRegVar('sv_autoban_threshold', @NetAutoBanLimit
, '', 'max crimes before autoban (0 = no autoban)');
2590 conRegVar('sv_autoban_permanent', @NetAutoBanPerm
, '', 'whether autobans are permanent');
2591 conRegVar('sv_autoban_warn', @NetAutoBanWarn
, '', 'send warnings to the client when he triggers penalties');
2592 conRegVar('sv_autoban_packet_timeout', @NetAutoBanForTimeout
, '', 'autoban for packet timeouts');
2594 conRegVar('sv_auth_timeout', @NetAuthTimeout
, '', 'number of msec in which connecting clients must complete auth (0 = unlimited)');
2595 conRegVar('sv_packet_timeout', @NetPacketTimeout
, '', 'number of msec the client must idle to be kicked (0 = unlimited)');
2597 conRegVar('net_master_list', @NetMasterList
, '', 'list of master servers');
2599 SetLength(NetClients
, 0);
2600 g_Net_DownloadTimeout
:= 60;
2601 NetIn
.Alloc(NET_BUFSIZE
);
2602 NetOut
.Alloc(NET_BUFSIZE
);
2603 NetBuf
[NET_UNRELIABLE
].Alloc(NET_BUFSIZE
*2);
2604 NetBuf
[NET_RELIABLE
].Alloc(NET_BUFSIZE
*2);
2605 trans_omsg
.Alloc(NET_BUFSIZE
);
2609 NetBuf
[NET_UNRELIABLE
].Free();
2610 NetBuf
[NET_RELIABLE
].Free();