DEADSOFTWARE

Fix handicap specifying in the 'bot_addlist' console command
[d2df-sdl.git] / src / game / g_net.pas
1 (* Copyright (C) Doom 2D: Forever Developers
2 *
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.
6 *
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.
11 *
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/>.
14 *)
15 {$INCLUDE ../shared/a_modes.inc}
16 unit g_net;
18 interface
20 uses
21 e_log, e_msg, utils, ENet, Classes, md5, MAPDEF{$IFDEF USE_MINIUPNPC}, miniupnpc;{$ELSE};{$ENDIF}
23 const
24 NET_PROTOCOL_VER = 188;
26 NET_MAXCLIENTS = 24;
27 NET_CHANS = 12;
29 NET_CHAN_SERVICE = 0;
30 NET_CHAN_IMPORTANT = 1;
31 NET_CHAN_GAME = 2;
32 NET_CHAN_PLAYER = 3;
33 NET_CHAN_PLAYERPOS = 4;
34 NET_CHAN_MONSTER = 5;
35 NET_CHAN_MONSTERPOS = 6;
36 NET_CHAN_LARGEDATA = 7;
37 NET_CHAN_CHAT = 8;
38 NET_CHAN_DOWNLOAD = 9;
39 NET_CHAN_SHOTS = 10;
40 NET_CHAN_DOWNLOAD_EX = 11;
42 NET_NONE = 0;
43 NET_SERVER = 1;
44 NET_CLIENT = 2;
46 NET_BUFSIZE = $FFFF;
47 NET_PING_PORT = $DF2D;
49 NET_EVERYONE = -1;
51 NET_UNRELIABLE = 0;
52 NET_RELIABLE = 1;
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;
66 NET_STATE_NONE = 0;
67 NET_STATE_AUTH = 1;
68 NET_STATE_GAME = 2;
70 NET_CONNECT_TIMEOUT = 1000 * 10;
72 BANLIST_FILENAME = 'banlist.txt';
73 NETDUMP_FILENAME = 'netdump';
75 type
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
80 end;
82 TNetMapResourceInfoArray = array of TNetMapResourceInfo;
84 TNetFileTransfer = record
85 diskName: string;
86 hash: TMD5Digest;
87 stream: TStream;
88 size: Integer; // file size in bytes
89 chunkSize: Integer;
90 lastSentChunk: Integer;
91 lastAckChunk: Integer;
92 lastAckTime: Int64; // msecs; if not "in progress", we're waiting for the first ack
93 inProgress: Boolean;
94 diskBuffer: PChar; // of `chunkSize` bytes
95 resumed: Boolean;
96 end;
98 TNetClient = record
99 ID: Byte;
100 Used: Boolean;
101 State: Byte;
102 Peer: pENetPeer;
103 Player: Word;
104 RequestedFullUpdate: Boolean;
105 WaitForFirstSpawn: Boolean; // set to `true` in server, used to spawn a player on first full state request
106 FullUpdateSent: Boolean;
107 RCONAuth: Boolean;
108 Voted: Boolean;
109 Crimes: Integer;
110 AuthTime: LongWord;
111 MsgTime: LongWord;
112 Transfer: TNetFileTransfer; // only one transfer may be active
113 NetOut: array [0..1] of TMsg;
114 end;
115 TBanRecord = record
116 IP: LongWord;
117 Perm: Boolean;
118 end;
119 pTNetClient = ^TNetClient;
121 AByte = array of Byte;
123 var
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;
141 NetEvent: ENetEvent;
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;
153 NetIn, NetOut: TMsg;
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;
194 {$ENDIF}
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();
212 procedure g_Net_Host_Kick(ID: Integer; Reason: enet_uint32);
214 function g_Net_Connect(IP: string; Port: enet_uint16): Boolean;
215 procedure g_Net_Disconnect(Forced: Boolean = False);
216 procedure g_Net_Client_Send(Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
217 procedure g_Net_Client_Update();
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);
262 implementation
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.
269 uses
270 SysUtils,
271 e_input, e_res,
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;
275 const
276 FILE_CHUNK_SIZE = 8192;
278 var
279 enet_init_success: Boolean = false;
280 g_Net_DownloadTimeout: Single;
281 trans_omsg: TMsg;
284 function g_Net_IsNetworkAvailable (): Boolean;
285 begin
286 result := enet_init_success;
287 end;
289 procedure g_Net_InitLowLevel ();
290 var v: ENetVersion;
291 begin
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);
296 end;
298 procedure g_Net_DeinitLowLevel ();
299 begin
300 if enet_init_success then
301 begin
302 enet_deinitialize();
303 enet_init_success := false;
304 end;
305 end;
308 //**************************************************************************
309 //
310 // SERVICE FUNCTIONS
311 //
312 //**************************************************************************
314 procedure clearNetClientTransfers (var nc: TNetClient);
315 begin
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;
321 end;
324 procedure clearNetClient (var nc: TNetClient);
325 begin
326 clearNetClientTransfers(nc);
327 end;
330 procedure clearNetClients (clearArray: Boolean);
331 var
332 f: Integer;
333 begin
334 for f := Low(NetClients) to High(NetClients) do clearNetClient(NetClients[f]);
335 if (clearArray) then SetLength(NetClients, 0);
336 end;
339 function g_Net_UserRequestExit (): Boolean;
340 begin
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)
348 end;
350 //**************************************************************************
351 //
352 // file transfer declaraions and host packet processor
353 //
354 //**************************************************************************
356 const
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);
374 begin
375 e_LogWritefln('disconnected client #%d due to file transfer error', [nc.ID], TMsgType.Warning);
376 g_Net_Host_Kick(nc.ID, NET_DISC_FILE_TIMEOUT);
377 clearNetClientTransfers(nc);
378 g_Net_Slist_ServerPlayerLeaves();
379 end;
382 // send file transfer message from server to client
383 function ftransSendServerMsg (var nc: TNetClient; var m: TMsg): Boolean;
384 var
385 pkt: PENetPacket;
386 begin
387 result := false;
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;
392 result := true;
393 end;
396 // send file transfer message from client to server
397 function ftransSendClientMsg (var m: TMsg): Boolean;
398 var
399 pkt: PENetPacket;
400 begin
401 result := false;
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;
406 result := true;
407 end;
410 // file chunk sender
411 procedure ProcessChunkSend (var nc: TNetClient);
412 var
413 tf: ^TNetFileTransfer;
414 ct: Int64;
415 chunks: Integer;
416 rd: Integer;
417 begin
418 tf := @nc.Transfer;
419 if (tf.stream = nil) then exit;
420 ct := GetTimerMS();
421 // arbitrary timeout number
422 if (ct-tf.lastAckTime >= 5000) then
423 begin
424 killClientByFT(nc);
425 exit;
426 end;
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
436 begin
437 killClientByFT(nc);
438 exit;
439 end;
441 trans_omsg.Clear();
442 if (tf.lastSentChunk = chunks) then
443 begin
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);
448 end
449 else
450 begin
451 // packet type
452 trans_omsg.Write(Byte(NTF_SERVER_CHUNK));
453 trans_omsg.Write(LongInt(tf.lastSentChunk));
454 // read chunk
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
460 try
461 tf.stream.Seek(tf.lastSentChunk*tf.chunkSize, soFromBeginning);
462 tf.stream.ReadBuffer(tf.diskBuffer^, rd);
463 trans_omsg.WriteData(tf.diskBuffer, rd);
464 except // sorry
465 killClientByFT(nc);
466 exit;
467 end;
468 end;
469 // send packet
470 ftransSendServerMsg(nc, trans_omsg);
471 end;
474 // server file transfer packet processor
475 // received packet is in `NetEvent`
476 procedure ProcessDownloadExPacket ();
477 var
478 f: Integer;
479 nc: ^TNetClient;
480 nid: Integer = -1;
481 msg: TMsg;
482 cmd: Byte;
483 tf: ^TNetFileTransfer;
484 fname: string;
485 chunk: Integer;
486 ridx: Integer;
487 dfn: AnsiString;
488 md5: TMD5Digest;
489 //st: TStream;
490 size: LongInt;
491 fi: TDiskFileInfo;
492 begin
493 // find client index by peer
494 for f := Low(NetClients) to High(NetClients) do
495 begin
496 if (not NetClients[f].Used) then continue;
497 if (NetClients[f].Peer = NetEvent.peer) then
498 begin
499 nid := f;
500 break;
501 end;
502 end;
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
509 begin
510 killClientByFT(nc^);
511 exit;
512 end;
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]);
525 case cmd of
526 NTF_CLIENT_FILE_REQUEST: // file request
527 begin
528 if (tf.stream <> nil) then
529 begin
530 killClientByFT(nc^);
531 exit;
532 end;
533 if (NetEvent.packet^.dataLength < 2) then
534 begin
535 killClientByFT(nc^);
536 exit;
537 end;
538 // new transfer request; build packet
539 if not msg.Init(NetEvent.packet^.data+1, NetEvent.packet^.dataLength-1, True) then
540 begin
541 killClientByFT(nc^);
542 exit;
543 end;
544 // get resource index
545 ridx := msg.ReadLongInt();
546 if (ridx < -1) or (ridx >= length(gExternalResources)) then
547 begin
548 e_LogWritefln('Invalid resource index %d', [ridx], TMsgType.Warning);
549 killClientByFT(nc^);
550 exit;
551 end;
552 if (ridx < 0) then fname := gGameSettings.WAD else fname := gExternalResources[ridx].diskName;
553 if (length(fname) = 0) then
554 begin
555 e_WriteLog('Invalid filename: '+fname, TMsgType.Warning);
556 killClientByFT(nc^);
557 exit;
558 end;
559 tf.diskName := findDiskWad(fname);
560 if (length(tf.diskName) = 0) then
561 begin
562 e_LogWritefln('NETWORK: file "%s" not found!', [fname], TMsgType.Fatal);
563 killClientByFT(nc^);
564 exit;
565 end;
566 // calculate hash
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);
571 try
572 tf.stream := openDiskFileRO(tf.diskName);
573 except
574 tf.stream := nil;
575 end;
576 if (tf.stream = nil) then
577 begin
578 e_WriteLog(Format('NETWORK: file "%s" not found!', [fname]), TMsgType.Fatal);
579 killClientByFT(nc^);
580 exit;
581 end;
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
591 trans_omsg.Clear();
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;
598 end;
599 NTF_CLIENT_ABORT: // do not send requested file, or abort current transfer
600 begin
601 e_LogWritefln('client #%d aborted file transfer', [nc.ID]);
602 clearNetClientTransfers(nc^);
603 end;
604 NTF_CLIENT_START: // start transfer; client may resume download by sending non-zero starting chunk
605 begin
606 if not Assigned(tf.stream) then
607 begin
608 killClientByFT(nc^);
609 exit;
610 end;
611 if (tf.lastSentChunk <> -1) or (tf.lastAckChunk <> -1) or (tf.inProgress) then
612 begin
613 // double ack, get lost
614 killClientByFT(nc^);
615 exit;
616 end;
617 if (NetEvent.packet^.dataLength < 2) then
618 begin
619 killClientByFT(nc^);
620 exit;
621 end;
622 // build packet
623 if not msg.Init(NetEvent.packet^.data+1, NetEvent.packet^.dataLength-1, True) then
624 begin
625 killClientByFT(nc^);
626 exit;
627 end;
628 chunk := msg.ReadLongInt();
629 if (chunk < 0) or (chunk > (tf.size+tf.chunkSize-1) div tf.chunkSize) then
630 begin
631 killClientByFT(nc^);
632 exit;
633 end;
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^);
640 end;
641 NTF_CLIENT_ACK: // chunk ack; chunk number follows
642 begin
643 if not Assigned(tf.stream) then
644 begin
645 killClientByFT(nc^);
646 exit;
647 end;
648 if (tf.lastSentChunk < 0) or (not tf.inProgress) then
649 begin
650 // double ack, get lost
651 killClientByFT(nc^);
652 exit;
653 end;
654 if (NetEvent.packet^.dataLength < 2) then
655 begin
656 killClientByFT(nc^);
657 exit;
658 end;
659 // build packet
660 if not msg.Init(NetEvent.packet^.data+1, NetEvent.packet^.dataLength-1, True) then
661 begin
662 killClientByFT(nc^);
663 exit;
664 end;
665 chunk := msg.ReadLongInt();
666 if (chunk < 0) or (chunk > (tf.size+tf.chunkSize-1) div tf.chunkSize) then
667 begin
668 killClientByFT(nc^);
669 exit;
670 end;
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^);
676 end;
677 NTF_CLIENT_MAP_REQUEST:
678 begin
679 e_LogWritefln('client #%d requested map info', [nc.ID]);
680 trans_omsg.Clear();
681 dfn := findDiskWad(gGameSettings.WAD);
682 if (dfn = '') then dfn := '!wad_not_found!.wad'; //FIXME
683 //md5 := MD5File(dfn);
684 md5 := gWADHash;
685 if (not GetDiskFileInfo(dfn, fi)) then
686 begin
687 e_LogWritefln('client #%d requested map info, but i cannot get file info', [nc.ID]);
688 killClientByFT(nc^);
689 exit;
690 end;
691 size := fi.size;
693 st := openDiskFileRO(dfn);
694 if not assigned(st) then exit; //wtf?!
695 size := st.size;
696 st.Free;
698 // packet type
699 trans_omsg.Write(Byte(NTF_SERVER_MAP_INFO));
700 // map wad name
701 trans_omsg.Write(ExtractFileName(gGameSettings.WAD));
702 // map wad md5
703 trans_omsg.Write(md5);
704 // map wad size
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
710 begin
711 // old style packet
712 //trans_omsg.Write(ExtractFileName(gExternalResources[f])); // GameDir+'/wads/'+ResList.Strings[i]
713 // new style packet
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));
718 end;
719 // send packet
720 if not ftransSendServerMsg(nc^, trans_omsg) then exit;
721 end;
722 else
723 begin
724 killClientByFT(nc^);
725 exit;
726 end;
727 end;
728 end;
731 //**************************************************************************
732 //
733 // file transfer crap (both client and server)
734 //
735 //**************************************************************************
737 function getNewTimeoutEnd (): Int64;
738 begin
739 result := GetTimerMS();
740 if (g_Net_DownloadTimeout <= 0) then
741 begin
742 result := result+1000*60*3; // 3 minutes
743 end
744 else
745 begin
746 result := result+trunc(g_Net_DownloadTimeout*1000);
747 end;
748 end;
751 // send map request to server, and wait for "map info" server reply
752 //
753 // returns `false` on error or user abort
754 // fills:
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
760 // returns:
761 // <0 on error
762 // 0 on success
763 // 1 on user abort
764 // 2 on server abort
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;
767 var
768 ev: ENetEvent;
769 rMsgId: Byte;
770 Ptr: Pointer;
771 msg: TMsg;
772 freePacket: Boolean = false;
773 ct, ett: Int64;
774 status: cint;
775 s: AnsiString;
776 rc, f: LongInt;
777 ri: ^TNetMapResourceInfo;
778 begin
779 SetLength(resList, 0);
781 // send request
782 trans_omsg.Clear();
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);
787 Result := -1;
788 try
789 ett := getNewTimeoutEnd();
790 repeat
791 status := enet_host_service(NetHost, @ev, 300);
793 if (status < 0) then
794 begin
795 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' network error', True);
796 Result := -1;
797 exit;
798 end;
800 if (status <= 0) then
801 begin
802 // check for timeout
803 ct := GetTimerMS();
804 if (ct >= ett) then
805 begin
806 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' timeout reached', True);
807 Result := -1;
808 exit;
809 end;
810 end
811 else
812 begin
813 // some event
814 case ev.kind of
815 ENET_EVENT_TYPE_RECEIVE:
816 begin
817 freePacket := true;
818 if (ev.channelID <> NET_CHAN_DOWNLOAD_EX) then
819 begin
820 //e_LogWritefln('g_Net_Wait_MapInfo: skip message from non-transfer channel', []);
821 freePacket := false;
822 g_Net_Client_HandlePacket(ev.packet, g_Net_ClientLightMsgHandler);
823 if (g_Res_received_map_start < 0) then begin result := -666; exit; end;
824 end
825 else
826 begin
827 ett := getNewTimeoutEnd();
828 if (ev.packet.dataLength < 1) then
829 begin
830 e_LogWritefln('g_Net_Wait_MapInfo: invalid server packet (no data)', []);
831 Result := -1;
832 exit;
833 end;
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
838 begin
839 e_LogWritefln('g_Net_Wait_MapInfo: waiting for map info reply, but got file info reply', []);
840 Result := -1;
841 exit;
842 end
843 else if (rMsgId = NTF_SERVER_ABORT) then
844 begin
845 e_LogWritefln('g_Net_Wait_MapInfo: server aborted transfer', []);
846 Result := 2;
847 exit;
848 end
849 else if (rMsgId = NTF_SERVER_MAP_INFO) then
850 begin
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
855 // map wad name
856 tf.diskName := msg.ReadString();
857 e_LogWritefln('g_Net_Wait_MapInfo: map wad is `%s`', [tf.diskName]);
858 // map wad md5
859 tf.hash := msg.ReadMD5();
860 // map wad size
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
866 begin
867 e_LogWritefln('g_Net_Wait_Event: invalid number of map external resources (%d)', [rc]);
868 Result := -1;
869 exit;
870 end;
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
875 begin
876 ri := @resList[f];
877 s := msg.ReadString();
878 if (length(s) = 0) then begin result := -1; exit; end;
879 if (s = '!') then
880 begin
881 // extended packet
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;
886 end
887 else
888 begin
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
893 end;
894 end;
895 e_LogWritefln('g_Net_Wait_MapInfo: got map info', []);
896 Result := 0; // success
897 exit;
898 end
899 else
900 begin
901 e_LogWritefln('g_Net_Wait_Event: invalid server packet type', []);
902 Result := -1;
903 exit;
904 end;
905 end;
906 end;
907 ENET_EVENT_TYPE_DISCONNECT:
908 begin
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);
911 Result := -1;
912 exit;
913 end;
914 else
915 begin
916 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' unknown ENet event ' + IntToStr(Ord(ev.kind)), True);
917 result := -1;
918 exit;
919 end;
920 end;
921 if (freePacket) then begin freePacket := false; enet_packet_destroy(ev.packet); end;
922 end;
924 ProcessLoading(False);
925 if g_Net_UserRequestExit() then
926 begin
927 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' user abort', True);
928 Result := 1;
929 exit;
930 end;
931 until false;
932 finally
933 if (freePacket) then enet_packet_destroy(ev.packet);
934 end;
935 end;
938 // send file request to server, and wait for server reply
939 //
940 // returns `false` on error or user abort
941 // fills:
942 // diskName (actually, base name)
943 // hash
944 // size
945 // chunkSize
946 // returns:
947 // <0 on error
948 // 0 on success
949 // 1 on user abort
950 // 2 on server abort
951 // for maps, first `tf.diskName` name will be map wad name, and `tf.hash`/`tf.size` will contain map info
952 function g_Net_RequestResFileInfo (resIndex: LongInt; out tf: TNetFileTransfer): Integer;
953 var
954 ev: ENetEvent;
955 rMsgId: Byte;
956 Ptr: Pointer;
957 msg: TMsg;
958 freePacket: Boolean = false;
959 ct, ett: Int64;
960 status: cint;
961 begin
962 // send request
963 trans_omsg.Clear();
964 trans_omsg.Write(Byte(NTF_CLIENT_FILE_REQUEST));
965 trans_omsg.Write(resIndex);
966 if not ftransSendClientMsg(trans_omsg) then begin result := -1; exit; end;
968 FillChar(ev, SizeOf(ev), 0);
969 Result := -1;
970 try
971 ett := getNewTimeoutEnd();
972 repeat
973 status := enet_host_service(NetHost, @ev, 300);
975 if (status < 0) then
976 begin
977 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' network error', True);
978 Result := -1;
979 exit;
980 end;
982 if (status <= 0) then
983 begin
984 // check for timeout
985 ct := GetTimerMS();
986 if (ct >= ett) then
987 begin
988 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' timeout reached', True);
989 Result := -1;
990 exit;
991 end;
992 end
993 else
994 begin
995 // some event
996 case ev.kind of
997 ENET_EVENT_TYPE_RECEIVE:
998 begin
999 freePacket := true;
1000 if (ev.channelID <> NET_CHAN_DOWNLOAD_EX) then
1001 begin
1002 //e_LogWriteln('g_Net_Wait_Event: skip message from non-transfer channel');
1003 freePacket := false;
1004 g_Net_Client_HandlePacket(ev.packet, g_Net_ClientLightMsgHandler);
1005 if (g_Res_received_map_start < 0) then begin result := -666; exit; end;
1006 end
1007 else
1008 begin
1009 ett := getNewTimeoutEnd();
1010 if (ev.packet.dataLength < 1) then
1011 begin
1012 e_LogWriteln('g_Net_Wait_Event: invalid server packet (no data)');
1013 Result := -1;
1014 exit;
1015 end;
1016 Ptr := ev.packet^.data;
1017 rMsgId := Byte(Ptr^);
1018 e_LogWritefln('received transfer packet with id %d (%u bytes)', [rMsgId, ev.packet^.dataLength]);
1019 if (rMsgId = NTF_SERVER_FILE_INFO) then
1020 begin
1021 if not msg.Init(ev.packet^.data+1, ev.packet^.dataLength-1, True) then exit;
1022 tf.hash := msg.ReadMD5();
1023 tf.size := msg.ReadLongInt();
1024 tf.chunkSize := msg.ReadLongInt();
1025 tf.diskName := ExtractFileName(msg.readString());
1026 if (tf.size < 0) or (tf.chunkSize <> FILE_CHUNK_SIZE) or (length(tf.diskName) = 0) then
1027 begin
1028 e_LogWritefln('g_Net_RequestResFileInfo: invalid file info packet', []);
1029 Result := -1;
1030 exit;
1031 end;
1032 e_LogWritefln('got file info for resource #%d: size=%d; name=%s', [resIndex, tf.size, tf.diskName]);
1033 Result := 0; // success
1034 exit;
1035 end
1036 else if (rMsgId = NTF_SERVER_ABORT) then
1037 begin
1038 e_LogWriteln('g_Net_RequestResFileInfo: server aborted transfer');
1039 Result := 2;
1040 exit;
1041 end
1042 else if (rMsgId = NTF_SERVER_MAP_INFO) then
1043 begin
1044 e_LogWriteln('g_Net_RequestResFileInfo: waiting for map info reply, but got file info reply');
1045 Result := -1;
1046 exit;
1047 end
1048 else
1049 begin
1050 e_LogWriteln('g_Net_RequestResFileInfo: invalid server packet type');
1051 Result := -1;
1052 exit;
1053 end;
1054 end;
1055 end;
1056 ENET_EVENT_TYPE_DISCONNECT:
1057 begin
1058 if (ev.data <= NET_DISC_MAX) then
1059 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' ' + _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + ev.data)], True);
1060 Result := -1;
1061 exit;
1062 end;
1063 else
1064 begin
1065 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' unknown ENet event ' + IntToStr(Ord(ev.kind)), True);
1066 result := -1;
1067 exit;
1068 end;
1069 end;
1070 if (freePacket) then begin freePacket := false; enet_packet_destroy(ev.packet); end;
1071 end;
1073 ProcessLoading(False);
1074 if g_Net_UserRequestExit() then
1075 begin
1076 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' user abort', True);
1077 Result := 1;
1078 exit;
1079 end;
1080 until false;
1081 finally
1082 if (freePacket) then enet_packet_destroy(ev.packet);
1083 end;
1084 end;
1087 // call this to cancel file transfer requested by `g_Net_RequestResFileInfo()`
1088 function g_Net_AbortResTransfer (var tf: TNetFileTransfer): Boolean;
1089 begin
1090 result := false;
1091 e_LogWritefln('aborting file transfer...', []);
1092 // send request
1093 trans_omsg.Clear();
1094 trans_omsg.Write(Byte(NTF_CLIENT_ABORT));
1095 result := ftransSendClientMsg(trans_omsg);
1096 if result then enet_host_flush(NetHost);
1097 end;
1100 // call this to start file transfer requested by `g_Net_RequestResFileInfo()`
1101 //
1102 // returns `false` on error or user abort
1103 // fills:
1104 // hash
1105 // size
1106 // chunkSize
1107 // returns:
1108 // <0 on error
1109 // 0 on success
1110 // 1 on user abort
1111 // 2 on server abort
1112 // for maps, first `tf.diskName` name will be map wad name, and `tf.hash`/`tf.size` will contain map info
1113 function g_Net_ReceiveResourceFile (resIndex: LongInt; var tf: TNetFileTransfer; strm: TStream): Integer;
1114 var
1115 ev: ENetEvent;
1116 rMsgId: Byte;
1117 Ptr: Pointer;
1118 msg: TMsg;
1119 freePacket: Boolean = false;
1120 ct, ett: Int64;
1121 status: cint;
1122 nextChunk: Integer = 0;
1123 chunkTotal: Integer;
1124 chunk: Integer;
1125 csize: Integer;
1126 buf: PChar = nil;
1127 resumed: Boolean;
1128 //stx: Int64;
1129 begin
1130 tf.resumed := false;
1131 e_LogWritefln('file `%s`, size=%d (%d)', [tf.diskName, Integer(strm.size), tf.size], TMsgType.Notify);
1132 // check if we should resume downloading
1133 resumed := (strm.size > tf.chunkSize) and (strm.size < tf.size);
1134 // send request
1135 trans_omsg.Clear();
1136 trans_omsg.Write(Byte(NTF_CLIENT_START));
1137 if resumed then chunk := strm.size div tf.chunkSize else chunk := 0;
1138 trans_omsg.Write(LongInt(chunk));
1139 if not ftransSendClientMsg(trans_omsg) then begin result := -1; exit; end;
1141 strm.Seek(chunk*tf.chunkSize, soFromBeginning);
1142 chunkTotal := (tf.size+tf.chunkSize-1) div tf.chunkSize;
1143 e_LogWritefln('receiving file `%s` (%d chunks)', [tf.diskName, chunkTotal], TMsgType.Notify);
1144 g_Game_SetLoadingText('downloading "'+ExtractFileName(tf.diskName)+'"', chunkTotal, False);
1145 tf.resumed := resumed;
1147 if (chunk > 0) then g_Game_StepLoading(chunk);
1148 nextChunk := chunk;
1150 // wait for reply data
1151 FillChar(ev, SizeOf(ev), 0);
1152 Result := -1;
1153 GetMem(buf, tf.chunkSize);
1154 try
1155 ett := getNewTimeoutEnd();
1156 repeat
1157 //stx := -GetTimerMS();
1158 status := enet_host_service(NetHost, @ev, 300);
1160 if (status < 0) then
1161 begin
1162 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' network error', True);
1163 Result := -1;
1164 exit;
1165 end;
1167 if (status <= 0) then
1168 begin
1169 // check for timeout
1170 ct := GetTimerMS();
1171 if (ct >= ett) then
1172 begin
1173 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' timeout reached', True);
1174 Result := -1;
1175 exit;
1176 end;
1177 end
1178 else
1179 begin
1180 // some event
1181 case ev.kind of
1182 ENET_EVENT_TYPE_RECEIVE:
1183 begin
1184 freePacket := true;
1185 if (ev.channelID <> NET_CHAN_DOWNLOAD_EX) then
1186 begin
1187 //e_LogWritefln('g_Net_Wait_Event: skip message from non-transfer channel', []);
1188 freePacket := false;
1189 g_Net_Client_HandlePacket(ev.packet, g_Net_ClientLightMsgHandler);
1190 if (g_Res_received_map_start < 0) then begin result := -666; exit; end;
1191 end
1192 else
1193 begin
1194 //stx := stx+GetTimerMS();
1195 //e_LogWritefln('g_Net_ReceiveResourceFile: stx=%d', [Integer(stx)]);
1196 //stx := -GetTimerMS();
1197 ett := getNewTimeoutEnd();
1198 if (ev.packet.dataLength < 1) then
1199 begin
1200 e_LogWritefln('g_Net_ReceiveResourceFile: invalid server packet (no data)', []);
1201 Result := -1;
1202 exit;
1203 end;
1204 Ptr := ev.packet^.data;
1205 rMsgId := Byte(Ptr^);
1206 if (rMsgId = NTF_SERVER_DONE) then
1207 begin
1208 e_LogWritefln('file transfer complete.', []);
1209 result := 0;
1210 exit;
1211 end
1212 else if (rMsgId = NTF_SERVER_CHUNK) then
1213 begin
1214 if not msg.Init(ev.packet^.data+1, ev.packet^.dataLength-1, True) then exit;
1215 chunk := msg.ReadLongInt();
1216 csize := msg.ReadLongInt();
1217 if (chunk <> nextChunk) then
1218 begin
1219 e_LogWritefln('received chunk %d, but expected chunk %d', [chunk, nextChunk]);
1220 Result := -1;
1221 exit;
1222 end;
1223 if (csize < 0) or (csize > tf.chunkSize) then
1224 begin
1225 e_LogWritefln('received chunk with size %d, but expected chunk size is %d', [csize, tf.chunkSize]);
1226 Result := -1;
1227 exit;
1228 end;
1229 //e_LogWritefln('got chunk #%d of #%d (csize=%d)', [chunk, (tf.size+tf.chunkSize-1) div tf.chunkSize, csize]);
1230 msg.ReadData(buf, csize);
1231 strm.WriteBuffer(buf^, csize);
1232 nextChunk := chunk+1;
1233 g_Game_StepLoading();
1234 // send ack
1235 trans_omsg.Clear();
1236 trans_omsg.Write(Byte(NTF_CLIENT_ACK));
1237 trans_omsg.Write(LongInt(chunk));
1238 if not ftransSendClientMsg(trans_omsg) then begin result := -1; exit; end;
1239 end
1240 else if (rMsgId = NTF_SERVER_ABORT) then
1241 begin
1242 e_LogWritefln('g_Net_ReceiveResourceFile: server aborted transfer', []);
1243 Result := 2;
1244 exit;
1245 end
1246 else
1247 begin
1248 e_LogWritefln('g_Net_ReceiveResourceFile: invalid server packet type', []);
1249 Result := -1;
1250 exit;
1251 end;
1252 //stx := stx+GetTimerMS();
1253 //e_LogWritefln('g_Net_ReceiveResourceFile: process stx=%d', [Integer(stx)]);
1254 end;
1255 end;
1256 ENET_EVENT_TYPE_DISCONNECT:
1257 begin
1258 if (ev.data <= NET_DISC_MAX) then
1259 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' ' + _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + ev.data)], True);
1260 Result := -1;
1261 exit;
1262 end;
1263 else
1264 begin
1265 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' unknown ENet event ' + IntToStr(Ord(ev.kind)), True);
1266 result := -1;
1267 exit;
1268 end;
1269 end;
1270 if (freePacket) then begin freePacket := false; enet_packet_destroy(ev.packet); end;
1271 end;
1273 ProcessLoading(False);
1274 if g_Net_UserRequestExit() then
1275 begin
1276 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' user abort', True);
1277 Result := 1;
1278 exit;
1279 end;
1280 until false;
1281 finally
1282 FreeMem(buf);
1283 if (freePacket) then enet_packet_destroy(ev.packet);
1284 end;
1285 end;
1288 //**************************************************************************
1289 //
1290 // common functions
1291 //
1292 //**************************************************************************
1294 function g_Net_FindSlot(): Integer;
1295 var
1296 I: Integer;
1297 F: Boolean;
1298 N, C: Integer;
1299 begin
1300 N := -1;
1301 F := False;
1302 C := 0;
1303 for I := Low(NetClients) to High(NetClients) do
1304 begin
1305 if NetClients[I].Used then
1306 Inc(C)
1307 else
1308 if not F then
1309 begin
1310 F := True;
1311 N := I;
1312 end;
1313 end;
1314 if C >= NetMaxClients then
1315 begin
1316 Result := -1;
1317 Exit;
1318 end;
1320 if not F then
1321 begin
1322 if (Length(NetClients) >= NetMaxClients) then
1323 N := -1
1324 else
1325 begin
1326 SetLength(NetClients, Length(NetClients) + 1);
1327 N := High(NetClients);
1328 end;
1329 end;
1331 if N >= 0 then
1332 begin
1333 NetClients[N].Used := True;
1334 NetClients[N].ID := N;
1335 NetClients[N].RequestedFullUpdate := False;
1336 NetClients[N].WaitForFirstSpawn := False;
1337 NetClients[N].RCONAuth := False;
1338 NetClients[N].Voted := False;
1339 NetClients[N].Player := 0;
1340 clearNetClientTransfers(NetClients[N]); // just in case
1341 end;
1343 Result := N;
1344 end;
1347 function g_Net_Init(): Boolean;
1348 var
1349 F: TextFile;
1350 IPstr: string;
1351 IP: LongWord;
1352 path: AnsiString;
1353 begin
1354 NetIn.Clear();
1355 NetOut.Clear();
1356 NetBuf[NET_UNRELIABLE].Clear();
1357 NetBuf[NET_RELIABLE].Clear();
1358 //SetLength(NetClients, 0);
1359 clearNetClients(true); // clear array
1360 NetPeer := nil;
1361 NetHost := nil;
1362 NetMyID := -1;
1363 NetPlrUID1 := -1;
1364 NetPlrUID2 := -1;
1365 NetAddr.port := 25666;
1366 SetLength(NetBannedHosts, 0);
1367 path := BANLIST_FILENAME;
1368 if e_FindResource(DataDirs, path) = true then
1369 begin
1370 Assign(F, path);
1371 Reset(F);
1372 while not EOF(F) do
1373 begin
1374 Readln(F, IPstr);
1375 if StrToIp(IPstr, IP) then
1376 g_Net_BanHost(IP);
1377 end;
1378 CloseFile(F);
1379 g_Net_SaveBanList();
1380 end;
1382 //Result := (enet_initialize() = 0);
1383 Result := enet_init_success;
1384 end;
1386 procedure g_Net_Flush();
1387 var
1388 T: Integer;
1389 P: pENetPacket;
1390 F, Chan: enet_uint32;
1391 I: Integer;
1392 begin
1393 F := 0;
1394 Chan := NET_CHAN_GAME;
1396 if NetMode = NET_SERVER then
1397 for T := NET_UNRELIABLE to NET_RELIABLE do
1398 begin
1399 if NetBuf[T].CurSize > 0 then
1400 begin
1401 P := enet_packet_create(NetBuf[T].Data, NetBuf[T].CurSize, F);
1402 if not Assigned(P) then continue;
1403 enet_host_broadcast(NetHost, Chan, P);
1404 NetBuf[T].Clear();
1405 end;
1407 for I := Low(NetClients) to High(NetClients) do
1408 begin
1409 if not NetClients[I].Used then continue;
1410 if NetClients[I].NetOut[T].CurSize <= 0 then continue;
1411 P := enet_packet_create(NetClients[I].NetOut[T].Data, NetClients[I].NetOut[T].CurSize, F);
1412 if not Assigned(P) then continue;
1413 enet_peer_send(NetClients[I].Peer, Chan, P);
1414 NetClients[I].NetOut[T].Clear();
1415 end;
1417 // next and last iteration is always RELIABLE
1418 F := LongWord(ENET_PACKET_FLAG_RELIABLE);
1419 Chan := NET_CHAN_IMPORTANT;
1420 end
1421 else if NetMode = NET_CLIENT then
1422 for T := NET_UNRELIABLE to NET_RELIABLE do
1423 begin
1424 if NetBuf[T].CurSize > 0 then
1425 begin
1426 P := enet_packet_create(NetBuf[T].Data, NetBuf[T].CurSize, F);
1427 if not Assigned(P) then continue;
1428 enet_peer_send(NetPeer, Chan, P);
1429 NetBuf[T].Clear();
1430 end;
1431 // next and last iteration is always RELIABLE
1432 F := LongWord(ENET_PACKET_FLAG_RELIABLE);
1433 Chan := NET_CHAN_IMPORTANT;
1434 end;
1435 end;
1437 procedure g_Net_Cleanup();
1438 begin
1439 NetIn.Clear();
1440 NetOut.Clear();
1441 NetBuf[NET_UNRELIABLE].Clear();
1442 NetBuf[NET_RELIABLE].Clear();
1444 //SetLength(NetClients, 0);
1445 clearNetClients(true); // clear array
1446 NetClientCount := 0;
1448 NetPeer := nil;
1449 NetHost := nil;
1450 g_Net_Slist_ServerClosed();
1451 NetMyID := -1;
1452 NetPlrUID1 := -1;
1453 NetPlrUID2 := -1;
1454 NetState := NET_STATE_NONE;
1456 NetPongSock := ENET_SOCKET_NULL;
1458 NetTimeToMaster := 0;
1459 NetTimeToUpdate := 0;
1460 NetTimeToReliable := 0;
1462 NetMode := NET_NONE;
1464 if NetPortThread <> NilThreadId then
1465 WaitForThreadTerminate(NetPortThread, 66666);
1467 NetPortThread := NilThreadId;
1468 g_Net_UnforwardPorts();
1470 if NetDump then
1471 g_Net_DumpEnd();
1472 end;
1474 procedure g_Net_Free();
1475 begin
1476 g_Net_Cleanup();
1478 //enet_deinitialize();
1479 NetInitDone := False;
1480 end;
1483 //**************************************************************************
1484 //
1485 // SERVER FUNCTIONS
1486 //
1487 //**************************************************************************
1489 function ForwardThread(Param: Pointer): PtrInt;
1490 begin
1491 Result := 0;
1492 if not g_Net_ForwardPorts() then Result := -1;
1493 end;
1495 function g_Net_Host(IPAddr: LongWord; Port: enet_uint16; MaxClients: Cardinal = 16): Boolean;
1496 begin
1497 if NetMode <> NET_NONE then
1498 begin
1499 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_INGAME]);
1500 Result := False;
1501 Exit;
1502 end;
1504 Result := True;
1506 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST], [Port]));
1507 if not NetInitDone then
1508 begin
1509 if (not g_Net_Init()) then
1510 begin
1511 g_Console_Add(_lc[I_NET_MSG_FERROR] + _lc[I_NET_ERR_ENET]);
1512 Result := False;
1513 Exit;
1514 end
1515 else
1516 NetInitDone := True;
1517 end;
1519 NetAddr.host := IPAddr;
1520 NetAddr.port := Port;
1522 NetHost := enet_host_create(@NetAddr, NET_MAXCLIENTS, NET_CHANS, 0, 0);
1524 if (NetHost = nil) then
1525 begin
1526 g_Console_Add(_lc[I_NET_MSG_ERROR] + Format(_lc[I_NET_ERR_HOST], [Port]));
1527 Result := False;
1528 g_Net_Cleanup;
1529 Exit;
1530 end;
1532 if NetForwardPorts then NetPortThread := BeginThread(ForwardThread);
1534 NetPongSock := enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM);
1535 if NetPongSock <> ENET_SOCKET_NULL then
1536 begin
1537 NetPongAddr.host := IPAddr;
1538 NetPongAddr.port := NET_PING_PORT;
1539 if enet_socket_bind(NetPongSock, @NetPongAddr) < 0 then
1540 begin
1541 enet_socket_destroy(NetPongSock);
1542 NetPongSock := ENET_SOCKET_NULL;
1543 end
1544 else
1545 enet_socket_set_option(NetPongSock, ENET_SOCKOPT_NONBLOCK, 1);
1546 end;
1548 NetMode := NET_SERVER;
1549 NetOut.Clear();
1550 NetBuf[NET_UNRELIABLE].Clear();
1551 NetBuf[NET_RELIABLE].Clear();
1553 if NetDump then
1554 g_Net_DumpStart();
1555 end;
1557 procedure g_Net_Host_Die();
1558 var
1559 I: Integer;
1560 begin
1561 if NetMode <> NET_SERVER then Exit;
1563 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_DISCALL]);
1564 for I := 0 to High(NetClients) do
1565 if NetClients[I].Used then
1566 enet_peer_disconnect(NetClients[I].Peer, NET_DISC_DOWN);
1568 while enet_host_service(NetHost, @NetEvent, 1000) > 0 do
1569 if NetEvent.kind = ENET_EVENT_TYPE_RECEIVE then
1570 enet_packet_destroy(NetEvent.packet);
1572 for I := 0 to High(NetClients) do
1573 if NetClients[I].Used then
1574 begin
1575 FreeMemory(NetClients[I].Peer^.data);
1576 NetClients[I].Peer^.data := nil;
1577 enet_peer_reset(NetClients[I].Peer);
1578 NetClients[I].Peer := nil;
1579 NetClients[I].Used := False;
1580 NetClients[I].Player := 0;
1581 NetClients[I].Crimes := 0;
1582 NetClients[I].AuthTime := 0;
1583 NetClients[I].MsgTime := 0;
1584 NetClients[I].NetOut[NET_UNRELIABLE].Free();
1585 NetClients[I].NetOut[NET_RELIABLE].Free();
1586 end;
1588 clearNetClients(false); // don't clear array
1589 g_Net_Slist_ServerClosed();
1590 if NetPongSock <> ENET_SOCKET_NULL then
1591 enet_socket_destroy(NetPongSock);
1593 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_DIE]);
1594 enet_host_destroy(NetHost);
1596 NetMode := NET_NONE;
1598 g_Net_Cleanup;
1599 e_WriteLog('NET: Server stopped', TMsgType.Notify);
1600 end;
1603 procedure g_Net_Host_Send(ID: Integer; Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
1604 var
1605 T: Integer;
1606 begin
1607 if (Reliable) then
1608 T := NET_RELIABLE
1609 else
1610 T := NET_UNRELIABLE;
1612 if (ID >= 0) then
1613 begin
1614 if ID > High(NetClients) then Exit;
1615 if NetClients[ID].Peer = nil then Exit;
1616 // write size first
1617 NetClients[ID].NetOut[T].Write(Integer(NetOut.CurSize));
1618 NetClients[ID].NetOut[T].Write(NetOut);
1619 end
1620 else
1621 begin
1622 // write size first
1623 NetBuf[T].Write(Integer(NetOut.CurSize));
1624 NetBuf[T].Write(NetOut);
1625 end;
1627 if NetDump then g_Net_DumpSendBuffer();
1628 NetOut.Clear();
1629 end;
1631 procedure g_Net_Host_Disconnect_Client(ID: Integer; Force: Boolean = False);
1632 var
1633 TP: TPlayer;
1634 TC: pTNetClient;
1635 begin
1636 TC := @NetClients[ID];
1637 if (TC = nil) then Exit;
1638 clearNetClient(NetClients[ID]);
1639 if not (TC^.Used) then Exit;
1641 TP := g_Player_Get(TC^.Player);
1643 if TP <> nil then
1644 begin
1645 TP.Lives := 0;
1646 TP.Kill(K_SIMPLEKILL, 0, HIT_DISCON);
1647 g_Console_Add(Format(_lc[I_PLAYER_LEAVE], [TP.Name]), True);
1648 e_WriteLog('NET: Client ' + TP.Name + ' [' + IntToStr(TC^.ID) + '] disconnected.', TMsgType.Notify);
1649 g_Player_Remove(TP.UID);
1650 end;
1652 if (TC^.Peer^.data <> nil) then
1653 begin
1654 FreeMemory(TC^.Peer^.data);
1655 TC^.Peer^.data := nil;
1656 end;
1658 if (Force) then
1659 enet_peer_reset(TC^.Peer);
1661 TC^.Used := False;
1662 TC^.State := NET_STATE_NONE;
1663 TC^.Peer := nil;
1664 TC^.Player := 0;
1665 TC^.Crimes := 0;
1666 TC^.AuthTime := 0;
1667 TC^.MsgTime := 0;
1668 TC^.RequestedFullUpdate := False;
1669 TC^.FullUpdateSent := False;
1670 TC^.WaitForFirstSpawn := False;
1671 TC^.NetOut[NET_UNRELIABLE].Free();
1672 TC^.NetOut[NET_RELIABLE].Free();
1674 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST_DISC], [ID]));
1675 Dec(NetClientCount);
1677 if NetUseMaster then g_Net_Slist_ServerPlayerLeaves();
1678 end;
1680 procedure g_Net_Host_Kick(ID: Integer; Reason: enet_uint32);
1681 var
1682 Peer: pENetPeer;
1683 TC: pTNetClient;
1684 begin
1685 TC := @NetClients[ID];
1686 if (TC <> nil) and TC^.Used and (TC^.Peer <> nil) then
1687 begin
1688 Peer := TC^.Peer;
1689 g_Net_Host_Disconnect_Client(ID);
1690 enet_peer_disconnect(Peer, Reason);
1691 end;
1692 end;
1694 procedure g_Net_Host_CheckPings();
1695 var
1696 ClAddr: ENetAddress;
1697 Buf: ENetBuffer;
1698 Len: Integer;
1699 ClTime: Int64;
1700 Ping: array [0..9] of Byte;
1701 NPl: Byte;
1702 begin
1703 if (NetPongSock = ENET_SOCKET_NULL) or (NetHost = nil) then Exit;
1705 Buf.data := Addr(Ping[0]);
1706 Buf.dataLength := 2+8;
1708 Ping[0] := 0;
1710 Len := enet_socket_receive(NetPongSock, @ClAddr, @Buf, 1);
1711 if Len < 0 then Exit;
1713 if (Ping[0] = Ord('D')) and (Ping[1] = Ord('F')) then
1714 begin
1715 ClTime := Int64(Addr(Ping[2])^);
1717 NetOut.Clear();
1718 NetOut.Write(Byte(Ord('D')));
1719 NetOut.Write(Byte(Ord('F')));
1720 NetOut.Write(NetHost.address.port);
1721 NetOut.Write(ClTime);
1722 TMasterHost.writeInfo(NetOut);
1723 NPl := 0;
1724 if gPlayer1 <> nil then Inc(NPl);
1725 if gPlayer2 <> nil then Inc(NPl);
1726 NetOut.Write(NPl);
1727 NetOut.Write(gNumBots);
1729 Buf.data := NetOut.Data;
1730 Buf.dataLength := NetOut.CurSize;
1731 enet_socket_send(NetPongSock, @ClAddr, @Buf, 1);
1733 NetOut.Clear();
1734 end;
1735 end;
1737 procedure g_Net_Host_CheckTimeouts();
1738 var
1739 ID: Integer;
1740 begin
1741 for ID := Low(NetClients) to High(NetClients) do
1742 begin
1743 with NetClients[ID] do
1744 begin
1745 if (Peer = nil) or (State = NET_STATE_NONE) then continue;
1746 if (State = NET_STATE_AUTH) and (AuthTime > 0) and (AuthTime <= gTime) then
1747 begin
1748 g_Net_Penalize(@NetClients[ID], 'auth taking too long');
1749 AuthTime := gTime + 1000; // do it every second to give them a chance
1750 end
1751 else if (State = NET_STATE_GAME) and (MsgTime > 0) and (MsgTime <= gTime) then
1752 begin
1753 // client hasn't sent packets in a while; either ban em or kick em
1754 if (NetAutoBanForTimeout) then
1755 begin
1756 g_Net_Penalize(@NetClients[ID], 'message timeout');
1757 MsgTime := gTime + (NetPacketTimeout div 2) + 500; // wait less for the next check
1758 end
1759 else
1760 begin
1761 e_LogWritefln('NET: client #%u (cid #%u) timed out', [ID, Player]);
1762 g_Net_Host_Disconnect_Client(ID, True);
1763 end;
1764 end;
1765 end;
1766 end;
1767 end;
1770 procedure g_Net_Host_Update();
1771 var
1772 IP: string;
1773 Port: Word;
1774 ID: Integer;
1775 TC: pTNetClient;
1776 begin
1777 IP := '';
1779 if NetUseMaster then g_Net_Slist_Pulse();
1780 g_Net_Host_CheckPings();
1781 g_Net_Host_CheckTimeouts();
1783 while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
1784 begin
1785 case (NetEvent.kind) of
1786 ENET_EVENT_TYPE_CONNECT:
1787 begin
1788 IP := IpToStr(NetEvent.Peer^.address.host);
1789 Port := NetEvent.Peer^.address.port;
1790 g_Console_Add(_lc[I_NET_MSG] +
1791 Format(_lc[I_NET_MSG_HOST_CONN], [IP, Port]));
1792 e_WriteLog('NET: Connection request from ' + IP + '.', TMsgType.Notify);
1794 if (NetEvent.data <> NET_PROTOCOL_VER) then
1795 begin
1796 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_REJECT] +
1797 _lc[I_NET_DISC_PROTOCOL]);
1798 e_WriteLog('NET: Connection request from ' + IP + ' rejected: version mismatch',
1799 TMsgType.Notify);
1800 enet_peer_disconnect(NetEvent.peer, NET_DISC_PROTOCOL);
1801 Exit;
1802 end;
1804 if g_Net_IsHostBanned(NetEvent.Peer^.address.host) then
1805 begin
1806 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_REJECT] +
1807 _lc[I_NET_DISC_BAN]);
1808 e_WriteLog('NET: Connection request from ' + IP + ' rejected: banned',
1809 TMsgType.Notify);
1810 enet_peer_disconnect(NetEvent.Peer, NET_DISC_BAN);
1811 Exit;
1812 end;
1814 ID := g_Net_FindSlot();
1816 if ID < 0 then
1817 begin
1818 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_REJECT] +
1819 _lc[I_NET_DISC_FULL]);
1820 e_WriteLog('NET: Connection request from ' + IP + ' rejected: server full',
1821 TMsgType.Notify);
1822 enet_peer_disconnect(NetEvent.peer, NET_DISC_FULL);
1823 Exit;
1824 end;
1826 NetClients[ID].Peer := NetEvent.peer;
1827 NetClients[ID].Peer^.data := GetMemory(SizeOf(Byte));
1828 Byte(NetClients[ID].Peer^.data^) := ID;
1829 NetClients[ID].State := NET_STATE_AUTH;
1830 NetClients[ID].Player := 0;
1831 NetClients[ID].Crimes := 0;
1832 NetClients[ID].RCONAuth := False;
1833 NetClients[ID].NetOut[NET_UNRELIABLE].Alloc(NET_BUFSIZE*2);
1834 NetClients[ID].NetOut[NET_RELIABLE].Alloc(NET_BUFSIZE*2);
1835 if (NetAuthTimeout > 0) then
1836 NetClients[ID].AuthTime := gTime + NetAuthTimeout
1837 else
1838 NetClients[ID].AuthTime := 0;
1839 if (NetPacketTimeout > 0) then
1840 NetClients[ID].MsgTime := gTime + NetPacketTimeout
1841 else
1842 NetClients[ID].MsgTime := 0;
1843 clearNetClientTransfers(NetClients[ID]); // just in case
1845 enet_peer_timeout(NetEvent.peer, ENET_PEER_TIMEOUT_LIMIT * 2, ENET_PEER_TIMEOUT_MINIMUM * 2, ENET_PEER_TIMEOUT_MAXIMUM * 2);
1847 Inc(NetClientCount);
1848 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST_ADD], [ID]));
1849 end;
1851 ENET_EVENT_TYPE_RECEIVE:
1852 begin
1853 //e_LogWritefln('RECEIVE: chan=%u', [NetEvent.channelID]);
1854 if (NetEvent.channelID = NET_CHAN_DOWNLOAD_EX) then
1855 begin
1856 ProcessDownloadExPacket();
1857 end
1858 else
1859 begin
1860 if NetEvent.peer^.data = nil then Exit;
1862 ID := Byte(NetEvent.peer^.data^);
1863 if ID > High(NetClients) then Exit;
1864 TC := @NetClients[ID];
1866 if (NetPacketTimeout > 0) then
1867 TC^.MsgTime := gTime + NetPacketTimeout;
1869 if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
1870 g_Net_Host_HandlePacket(TC, NetEvent.packet, g_Net_HostMsgHandler);
1871 end;
1872 end;
1874 ENET_EVENT_TYPE_DISCONNECT:
1875 begin
1876 if NetEvent.peer^.data <> nil then
1877 begin
1878 ID := Byte(NetEvent.peer^.data^);
1879 if ID > High(NetClients) then Exit;
1880 g_Net_Host_Disconnect_Client(ID);
1881 end;
1882 end;
1883 end;
1884 end;
1885 end;
1888 //**************************************************************************
1889 //
1890 // CLIENT FUNCTIONS
1891 //
1892 //**************************************************************************
1894 procedure g_Net_Disconnect(Forced: Boolean = False);
1895 begin
1896 if NetMode <> NET_CLIENT then Exit;
1897 if (NetHost = nil) or (NetPeer = nil) then Exit;
1899 if not Forced then
1900 begin
1901 enet_peer_disconnect(NetPeer, NET_DISC_NONE);
1903 while (enet_host_service(NetHost, @NetEvent, 1500) > 0) do
1904 begin
1905 if (NetEvent.kind = ENET_EVENT_TYPE_DISCONNECT) then
1906 begin
1907 NetPeer := nil;
1908 break;
1909 end;
1911 if (NetEvent.kind = ENET_EVENT_TYPE_RECEIVE) then
1912 enet_packet_destroy(NetEvent.packet);
1913 end;
1915 if NetPeer <> nil then
1916 begin
1917 enet_peer_reset(NetPeer);
1918 NetPeer := nil;
1919 end;
1920 end
1921 else
1922 begin
1923 e_WriteLog('NET: Kicked from server: ' + IntToStr(NetEvent.data), TMsgType.Notify);
1924 if (NetEvent.data <= NET_DISC_MAX) then
1925 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_KICK] +
1926 _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + NetEvent.data)], True);
1927 end;
1929 if NetHost <> nil then
1930 begin
1931 enet_host_destroy(NetHost);
1932 NetHost := nil;
1933 end;
1934 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_CLIENT_DISC]);
1936 g_Net_Cleanup;
1937 e_WriteLog('NET: Disconnected', TMsgType.Notify);
1938 end;
1940 procedure g_Net_Client_Send(Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
1941 var
1942 T: Integer;
1943 begin
1944 if (Reliable) then
1945 T := NET_RELIABLE
1946 else
1947 T := NET_UNRELIABLE;
1949 // write size first
1950 NetBuf[T].Write(Integer(NetOut.CurSize));
1951 NetBuf[T].Write(NetOut);
1953 if NetDump then g_Net_DumpSendBuffer();
1954 NetOut.Clear();
1955 g_Net_Flush(); // FIXME: for now, send immediately
1956 end;
1958 procedure g_Net_Client_Update();
1959 begin
1960 while (NetHost <> nil) and (enet_host_service(NetHost, @NetEvent, 0) > 0) do
1961 begin
1962 case NetEvent.kind of
1963 ENET_EVENT_TYPE_RECEIVE:
1964 begin
1965 if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
1966 g_Net_Client_HandlePacket(NetEvent.packet, g_Net_ClientMsgHandler);
1967 end;
1969 ENET_EVENT_TYPE_DISCONNECT:
1970 begin
1971 g_Net_Disconnect(True);
1972 Exit;
1973 end;
1974 end;
1975 end
1976 end;
1978 function g_Net_Connect(IP: string; Port: enet_uint16): Boolean;
1979 var
1980 OuterLoop: Boolean;
1981 TimeoutTime, T: Int64;
1982 begin
1983 if NetMode <> NET_NONE then
1984 begin
1985 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_ERR_INGAME], True);
1986 Result := False;
1987 Exit;
1988 end;
1990 Result := True;
1992 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_CLIENT_CONN],
1993 [IP, Port]));
1994 if not NetInitDone then
1995 begin
1996 if (not g_Net_Init()) then
1997 begin
1998 g_Console_Add(_lc[I_NET_MSG_FERROR] + _lc[I_NET_ERR_ENET], True);
1999 Result := False;
2000 Exit;
2001 end
2002 else
2003 NetInitDone := True;
2004 end;
2006 NetHost := enet_host_create(nil, 1, NET_CHANS, 0, 0);
2008 if (NetHost = nil) then
2009 begin
2010 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT], True);
2011 g_Net_Cleanup;
2012 Result := False;
2013 Exit;
2014 end;
2016 enet_address_set_host(@NetAddr, PChar(Addr(IP[1])));
2017 NetAddr.port := Port;
2019 NetPeer := enet_host_connect(NetHost, @NetAddr, NET_CHANS, NET_PROTOCOL_VER);
2021 if (NetPeer = nil) then
2022 begin
2023 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT], True);
2024 enet_host_destroy(NetHost);
2025 g_Net_Cleanup;
2026 Result := False;
2027 Exit;
2028 end;
2030 // предупредить что ждем слишком долго через N секунд
2031 TimeoutTime := sys_GetTicks() + NET_CONNECT_TIMEOUT;
2033 OuterLoop := True;
2034 while OuterLoop do
2035 begin
2036 while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
2037 begin
2038 if (NetEvent.kind = ENET_EVENT_TYPE_CONNECT) then
2039 begin
2040 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_CLIENT_DONE]);
2041 NetMode := NET_CLIENT;
2042 NetOut.Clear();
2043 enet_peer_timeout(NetPeer, ENET_PEER_TIMEOUT_LIMIT * 2, ENET_PEER_TIMEOUT_MINIMUM * 2, ENET_PEER_TIMEOUT_MAXIMUM * 2);
2044 NetClientIP := IP;
2045 NetClientPort := Port;
2046 if NetDump then
2047 g_Net_DumpStart();
2048 Exit;
2049 end;
2050 end;
2052 T := sys_GetTicks();
2053 if T > TimeoutTime then
2054 begin
2055 TimeoutTime := T + NET_CONNECT_TIMEOUT * 100; // одного предупреждения хватит
2056 g_Console_Add(_lc[I_NET_MSG_TIMEOUT_WARN], True);
2057 g_Console_Add(Format(_lc[I_NET_MSG_PORTS], [Integer(Port), Integer(NET_PING_PORT)]), True);
2058 end;
2060 ProcessLoading(True);
2061 if e_KeyPressed(IK_SPACE) or e_KeyPressed(IK_ESCAPE) or e_KeyPressed(VK_ESCAPE) or
2062 e_KeyPressed(JOY0_JUMP) or e_KeyPressed(JOY1_JUMP) or e_KeyPressed(JOY2_JUMP) or e_KeyPressed(JOY3_JUMP) then
2063 OuterLoop := False;
2064 end;
2066 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_TIMEOUT], True);
2067 g_Console_Add(Format(_lc[I_NET_MSG_PORTS], [Integer(Port), Integer(NET_PING_PORT)]), True);
2068 if NetPeer <> nil then enet_peer_reset(NetPeer);
2069 if NetHost <> nil then
2070 begin
2071 enet_host_destroy(NetHost);
2072 NetHost := nil;
2073 end;
2074 g_Net_Cleanup();
2075 Result := False;
2076 end;
2078 function IpToStr(IP: LongWord): string;
2079 var
2080 Ptr: Pointer;
2081 begin
2082 Ptr := Addr(IP);
2083 Result := IntToStr(PByte(Ptr + 0)^) + '.';
2084 Result := Result + IntToStr(PByte(Ptr + 1)^) + '.';
2085 Result := Result + IntToStr(PByte(Ptr + 2)^) + '.';
2086 Result := Result + IntToStr(PByte(Ptr + 3)^);
2087 end;
2089 function StrToIp(IPstr: string; var IP: LongWord): Boolean;
2090 var
2091 EAddr: ENetAddress;
2092 begin
2093 Result := enet_address_set_host(@EAddr, PChar(@IPstr[1])) = 0;
2094 IP := EAddr.host;
2095 end;
2097 function g_Net_Client_ByName(Name: string): pTNetClient;
2098 var
2099 a: Integer;
2100 pl: TPlayer;
2101 begin
2102 Result := nil;
2103 for a := Low(NetClients) to High(NetClients) do
2104 if (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
2105 begin
2106 pl := g_Player_Get(NetClients[a].Player);
2107 if pl = nil then continue;
2108 if Copy(LowerCase(pl.Name), 1, Length(Name)) <> LowerCase(Name) then continue;
2109 if NetClients[a].Peer <> nil then
2110 begin
2111 Result := @NetClients[a];
2112 Exit;
2113 end;
2114 end;
2115 end;
2117 function g_Net_Client_ByPlayer(PID: Word): pTNetClient;
2118 var
2119 a: Integer;
2120 begin
2121 Result := nil;
2122 for a := Low(NetClients) to High(NetClients) do
2123 if (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
2124 if NetClients[a].Player = PID then
2125 begin
2126 Result := @NetClients[a];
2127 Exit;
2128 end;
2129 end;
2131 function g_Net_ClientName_ByID(ID: Integer): string;
2132 var
2133 a: Integer;
2134 pl: TPlayer;
2135 begin
2136 Result := '';
2137 if ID = NET_EVERYONE then
2138 Exit;
2139 for a := Low(NetClients) to High(NetClients) do
2140 if (NetClients[a].ID = ID) and (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
2141 begin
2142 pl := g_Player_Get(NetClients[a].Player);
2143 if pl = nil then Exit;
2144 Result := pl.Name;
2145 end;
2146 end;
2148 procedure g_Net_SendData(Data: AByte; peer: pENetPeer; Reliable: Boolean; Chan: Byte = NET_CHAN_DOWNLOAD);
2149 var
2150 P: pENetPacket;
2151 F: enet_uint32;
2152 dataLength: Cardinal;
2153 begin
2154 dataLength := Length(Data);
2156 if Reliable
2157 then F := LongWord(ENET_PACKET_FLAG_RELIABLE)
2158 else F := 0;
2160 P := enet_packet_create(@Data[0], dataLength, F);
2161 if not Assigned(P) then exit;
2163 if peer <> nil
2164 then enet_peer_send(peer, Chan, P)
2165 else enet_host_broadcast(NetHost, Chan, P);
2167 enet_host_flush(NetHost);
2168 end;
2170 function g_Net_IsHostBanned(IP: LongWord; Perm: Boolean = False): Boolean;
2171 var
2172 I: Integer;
2173 begin
2174 Result := False;
2175 if NetBannedHosts = nil then
2176 Exit;
2177 for I := 0 to High(NetBannedHosts) do
2178 if (NetBannedHosts[I].IP = IP) and ((not Perm) or (NetBannedHosts[I].Perm)) then
2179 begin
2180 Result := True;
2181 break;
2182 end;
2183 end;
2185 procedure g_Net_BanHost(IP: LongWord; Perm: Boolean = True); overload;
2186 var
2187 I, P: Integer;
2188 begin
2189 if IP = 0 then
2190 Exit;
2191 if g_Net_IsHostBanned(IP, Perm) then
2192 Exit;
2194 P := -1;
2195 for I := Low(NetBannedHosts) to High(NetBannedHosts) do
2196 if NetBannedHosts[I].IP = 0 then
2197 begin
2198 P := I;
2199 break;
2200 end;
2202 if P < 0 then
2203 begin
2204 SetLength(NetBannedHosts, Length(NetBannedHosts) + 1);
2205 P := High(NetBannedHosts);
2206 end;
2208 NetBannedHosts[P].IP := IP;
2209 NetBannedHosts[P].Perm := Perm;
2210 end;
2212 procedure g_Net_BanHost(IP: string; Perm: Boolean = True); overload;
2213 var
2214 a: LongWord;
2215 b: Boolean;
2216 begin
2217 b := StrToIp(IP, a);
2218 if b then
2219 g_Net_BanHost(a, Perm);
2220 end;
2222 procedure g_Net_UnbanNonPermHosts();
2223 var
2224 I: Integer;
2225 begin
2226 if NetBannedHosts = nil then
2227 Exit;
2228 for I := Low(NetBannedHosts) to High(NetBannedHosts) do
2229 if (NetBannedHosts[I].IP > 0) and not NetBannedHosts[I].Perm then
2230 begin
2231 NetBannedHosts[I].IP := 0;
2232 NetBannedHosts[I].Perm := True;
2233 end;
2234 end;
2236 function g_Net_UnbanHost(IP: string): Boolean; overload;
2237 var
2238 a: LongWord;
2239 begin
2240 Result := StrToIp(IP, a);
2241 if Result then
2242 Result := g_Net_UnbanHost(a);
2243 end;
2245 function g_Net_UnbanHost(IP: LongWord): Boolean; overload;
2246 var
2247 I: Integer;
2248 begin
2249 Result := False;
2250 if IP = 0 then
2251 Exit;
2252 if NetBannedHosts = nil then
2253 Exit;
2254 for I := 0 to High(NetBannedHosts) do
2255 if NetBannedHosts[I].IP = IP then
2256 begin
2257 NetBannedHosts[I].IP := 0;
2258 NetBannedHosts[I].Perm := True;
2259 Result := True;
2260 // no break here to clear all bans of this host, perm and non-perm
2261 end;
2262 end;
2264 procedure g_Net_SaveBanList();
2265 var
2266 F: TextFile;
2267 I: Integer;
2268 path: AnsiString;
2269 begin
2270 path := e_GetWriteableDir(DataDirs);
2271 if path <> '' then
2272 begin
2273 path := e_CatPath(path, BANLIST_FILENAME);
2274 Assign(F, path);
2275 Rewrite(F);
2276 if NetBannedHosts <> nil then
2277 for I := 0 to High(NetBannedHosts) do
2278 if NetBannedHosts[I].Perm and (NetBannedHosts[I].IP > 0) then
2279 Writeln(F, IpToStr(NetBannedHosts[I].IP));
2280 CloseFile(F)
2281 end
2282 end;
2284 procedure g_Net_Penalize(C: pTNetClient; Reason: string);
2285 var
2286 s: string;
2287 begin
2288 e_LogWritefln('NET: client #%u (cid #%u) triggered a penalty (%d/%d): %s',
2289 [C^.ID, C^.Player, C^.Crimes + 1, NetAutoBanLimit, Reason]);
2291 if (NetAutoBanLimit <= 0) then Exit;
2293 if (C^.Crimes >= NetAutoBanLimit) then
2294 begin
2295 // we have tried asking nicely before, now it is time to die
2296 e_LogWritefln('NET: client #%u (cid #%u) force kicked',
2297 [C^.ID, C^.Player]);
2298 g_Net_Host_Disconnect_Client(C^.ID, True);
2299 Exit;
2300 end;
2302 Inc(C^.Crimes);
2304 if (NetAutoBanWarn) then
2305 MH_SEND_Chat('You have been warned by the server: ' + Reason, NET_CHAT_SYSTEM, C^.ID);
2307 if (C^.Crimes >= NetAutoBanLimit) then
2308 begin
2309 s := '#' + IntToStr(C^.ID); // can't be arsed
2310 g_Net_BanHost(C^.Peer^.address.host, NetAutoBanPerm);
2311 g_Net_Host_Kick(C^.ID, NET_DISC_BAN);
2312 g_Console_Add(Format(_lc[I_PLAYER_BAN], [s]));
2313 MH_SEND_GameEvent(NET_EV_PLAYER_BAN, 0, s);
2314 g_Net_Slist_ServerPlayerLeaves();
2315 end;
2316 end;
2318 procedure g_Net_DumpStart();
2319 begin
2320 if NetMode = NET_SERVER then
2321 NetDumpFile := e_CreateResource(LogDirs, NETDUMP_FILENAME + '_server')
2322 else
2323 NetDumpFile := e_CreateResource(LogDirs, NETDUMP_FILENAME + '_client');
2324 end;
2326 procedure g_Net_DumpSendBuffer();
2327 begin
2328 writeInt(NetDumpFile, gTime);
2329 writeInt(NetDumpFile, LongWord(NetOut.CurSize));
2330 writeInt(NetDumpFile, Byte(1));
2331 NetDumpFile.WriteBuffer(NetOut.Data^, NetOut.CurSize);
2332 end;
2334 procedure g_Net_DumpRecvBuffer(Buf: penet_uint8; Len: LongWord);
2335 begin
2336 if (Buf = nil) or (Len = 0) then Exit;
2337 writeInt(NetDumpFile, gTime);
2338 writeInt(NetDumpFile, Len);
2339 writeInt(NetDumpFile, Byte(0));
2340 NetDumpFile.WriteBuffer(Buf^, Len);
2341 end;
2343 procedure g_Net_DumpEnd();
2344 begin
2345 NetDumpFile.Free();
2346 NetDumpFile := nil;
2347 end;
2349 function g_Net_ForwardPorts(ForwardPongPort: Boolean = True): Boolean;
2350 {$IFDEF USE_MINIUPNPC}
2351 var
2352 DevList: PUPNPDev;
2353 Urls: TUPNPUrls;
2354 Data: TIGDDatas;
2355 LanAddr: array [0..255] of Char;
2356 StrPort: AnsiString;
2357 Err, I: Integer;
2358 begin
2359 Result := False;
2361 if NetHost = nil then
2362 exit;
2364 if NetPortForwarded = NetHost.address.port then
2365 begin
2366 Result := True;
2367 exit;
2368 end;
2370 NetPongForwarded := False;
2371 NetPortForwarded := 0;
2373 DevList := upnpDiscover(1000, nil, nil, 0, 0, 2, Addr(Err));
2374 if DevList = nil then
2375 begin
2376 conwritefln('port forwarding failed: upnpDiscover() failed: %d', [Err]);
2377 exit;
2378 end;
2380 I := UPNP_GetValidIGD(DevList, @Urls, @Data, Addr(LanAddr[0]), 256);
2382 if I = 0 then
2383 begin
2384 conwriteln('port forwarding failed: could not find an IGD device on this LAN');
2385 FreeUPNPDevList(DevList);
2386 FreeUPNPUrls(@Urls);
2387 exit;
2388 end;
2390 StrPort := IntToStr(NetHost.address.port);
2391 I := UPNP_AddPortMapping(
2392 Urls.controlURL, Addr(data.first.servicetype[1]),
2393 PChar(StrPort), PChar(StrPort), Addr(LanAddr[0]), PChar('D2DF'),
2394 PChar('UDP'), nil, PChar('0')
2395 );
2397 if I <> 0 then
2398 begin
2399 conwritefln('forwarding port %d failed: error %d', [NetHost.address.port, I]);
2400 FreeUPNPDevList(DevList);
2401 FreeUPNPUrls(@Urls);
2402 exit;
2403 end;
2405 if ForwardPongPort then
2406 begin
2407 StrPort := IntToStr(NET_PING_PORT);
2408 I := UPNP_AddPortMapping(
2409 Urls.controlURL, Addr(data.first.servicetype[1]),
2410 PChar(StrPort), PChar(StrPort), Addr(LanAddr[0]), PChar('D2DF'),
2411 PChar('UDP'), nil, PChar('0')
2412 );
2414 if I <> 0 then
2415 begin
2416 conwritefln('forwarding port %d failed: error %d', [NET_PING_PORT, I]);
2417 NetPongForwarded := False;
2418 end
2419 else
2420 begin
2421 conwritefln('forwarded port %d successfully', [NET_PING_PORT]);
2422 NetPongForwarded := True;
2423 end;
2424 end;
2426 conwritefln('forwarded port %d successfully', [NetHost.address.port]);
2427 NetIGDControl := AnsiString(Urls.controlURL);
2428 NetIGDService := data.first.servicetype;
2429 NetPortForwarded := NetHost.address.port;
2431 FreeUPNPDevList(DevList);
2432 FreeUPNPUrls(@Urls);
2433 Result := True;
2434 end;
2435 {$ELSE}
2436 begin
2437 Result := False;
2438 end;
2439 {$ENDIF}
2441 procedure g_Net_UnforwardPorts();
2442 {$IFDEF USE_MINIUPNPC}
2443 var
2444 I: Integer;
2445 StrPort: AnsiString;
2446 begin
2447 if NetPortForwarded = 0 then Exit;
2449 conwriteln('unforwarding ports...');
2451 StrPort := IntToStr(NetPortForwarded);
2452 I := UPNP_DeletePortMapping(
2453 PChar(NetIGDControl), Addr(NetIGDService[1]),
2454 PChar(StrPort), PChar('UDP'), nil
2455 );
2456 conwritefln(' port %d: %d', [NetPortForwarded, I]);
2458 if NetPongForwarded then
2459 begin
2460 NetPongForwarded := False;
2461 StrPort := IntToStr(NET_PING_PORT);
2462 I := UPNP_DeletePortMapping(
2463 PChar(NetIGDControl), Addr(NetIGDService[1]),
2464 PChar(StrPort), PChar('UDP'), nil
2465 );
2466 conwritefln(' port %d: %d', [NET_PING_PORT, I]);
2467 end;
2469 NetPortForwarded := 0;
2470 end;
2471 {$ELSE}
2472 begin
2473 end;
2474 {$ENDIF}
2476 procedure NetServerCVars(P: SSArray);
2477 var
2478 cmd, s: string;
2479 a, b: Integer;
2480 begin
2481 cmd := LowerCase(P[0]);
2482 case cmd of
2483 'sv_name':
2484 begin
2485 if (Length(P) > 1) and (Length(P[1]) > 0) then
2486 begin
2487 NetServerName := P[1];
2488 if Length(NetServerName) > 64 then
2489 SetLength(NetServerName, 64);
2490 g_Net_Slist_ServerRenamed();
2491 end;
2492 g_Console_Add(cmd + ' "' + NetServerName + '"');
2493 end;
2494 'sv_passwd':
2495 begin
2496 if (Length(P) > 1) and (Length(P[1]) > 0) then
2497 begin
2498 NetPassword := P[1];
2499 if Length(NetPassword) > 24 then
2500 SetLength(NetPassword, 24);
2501 g_Net_Slist_ServerRenamed();
2502 end;
2503 g_Console_Add(cmd + ' "' + AnsiLowerCase(NetPassword) + '"');
2504 end;
2505 'sv_maxplrs':
2506 begin
2507 if (Length(P) > 1) then
2508 begin
2509 NetMaxClients := nclamp(StrToIntDef(P[1], NetMaxClients), 1, NET_MAXCLIENTS);
2510 if g_Game_IsServer and g_Game_IsNet then
2511 begin
2512 b := 0;
2513 for a := 0 to High(NetClients) do
2514 begin
2515 if NetClients[a].Used then
2516 begin
2517 Inc(b);
2518 if b > NetMaxClients then
2519 begin
2520 s := g_Player_Get(NetClients[a].Player).Name;
2521 g_Net_Host_Kick(NetClients[a].ID, NET_DISC_FULL);
2522 g_Console_Add(Format(_lc[I_PLAYER_KICK], [s]));
2523 MH_SEND_GameEvent(NET_EV_PLAYER_KICK, 0, s);
2524 end;
2525 end;
2526 end;
2527 g_Net_Slist_ServerRenamed();
2528 end;
2529 end;
2530 g_Console_Add(cmd + ' ' + IntToStr(NetMaxClients));
2531 end;
2532 'sv_public':
2533 begin
2534 if (Length(P) > 1) then
2535 begin
2536 NetUseMaster := StrToIntDef(P[1], Byte(NetUseMaster)) <> 0;
2537 if NetUseMaster then g_Net_Slist_Public() else g_Net_Slist_Private();
2538 end;
2539 g_Console_Add(cmd + ' ' + IntToStr(Byte(NetUseMaster)));
2540 end;
2541 'sv_port':
2542 begin
2543 if (Length(P) > 1) then
2544 begin
2545 if not g_Game_IsNet then
2546 NetPort := nclamp(StrToIntDef(P[1], NetPort), 0, $FFFF)
2547 else
2548 g_Console_Add(_lc[I_MSG_NOT_NETGAME]);
2549 end;
2550 g_Console_Add(cmd + ' ' + IntToStr(Ord(NetUseMaster)));
2551 end;
2552 end;
2553 end;
2555 initialization
2556 conRegVar('cl_downloadtimeout', @g_Net_DownloadTimeout, 0.0, 1000000.0, '', 'timeout in seconds, 0 to disable it');
2557 conRegVar('cl_predictself', @NetPredictSelf, '', 'predict local player');
2558 conRegVar('cl_forceplayerupdate', @NetForcePlayerUpdate, '', 'update net players on NET_MSG_PLRPOS');
2559 conRegVar('cl_interp', @NetInterpLevel, '', 'net player interpolation steps');
2560 conRegVar('cl_last_ip', @NetClientIP, '', 'address of the last you have connected to');
2561 conRegVar('cl_last_port', @NetClientPort, '', 'port of the last server you have connected to');
2562 conRegVar('cl_deafen', @NetDeafLevel, '', 'filter server messages (0-3)');
2564 conRegVar('sv_forwardports', @NetForwardPorts, '', 'forward server port using miniupnpc (requires server restart)');
2565 conRegVar('sv_rcon', @NetAllowRCON, '', 'enable remote console');
2566 conRegVar('sv_rcon_password', @NetRCONPassword, '', 'remote console password');
2567 conRegVar('sv_update_interval', @NetUpdateRate, '', 'unreliable update interval');
2568 conRegVar('sv_reliable_interval', @NetRelupdRate, '', 'reliable update interval');
2569 conRegVar('sv_master_interval', @NetMasterRate, '', 'master server update interval');
2571 conRegVar('sv_autoban_threshold', @NetAutoBanLimit, '', 'max crimes before autoban (0 = no autoban)');
2572 conRegVar('sv_autoban_permanent', @NetAutoBanPerm, '', 'whether autobans are permanent');
2573 conRegVar('sv_autoban_warn', @NetAutoBanWarn, '', 'send warnings to the client when he triggers penalties');
2574 conRegVar('sv_autoban_packet_timeout', @NetAutoBanForTimeout, '', 'autoban for packet timeouts');
2576 conRegVar('sv_auth_timeout', @NetAuthTimeout, '', 'number of msec in which connecting clients must complete auth (0 = unlimited)');
2577 conRegVar('sv_packet_timeout', @NetPacketTimeout, '', 'number of msec the client must idle to be kicked (0 = unlimited)');
2579 conRegVar('net_master_list', @NetMasterList, '', 'list of master servers');
2581 SetLength(NetClients, 0);
2582 g_Net_DownloadTimeout := 60;
2583 NetIn.Alloc(NET_BUFSIZE);
2584 NetOut.Alloc(NET_BUFSIZE);
2585 NetBuf[NET_UNRELIABLE].Alloc(NET_BUFSIZE*2);
2586 NetBuf[NET_RELIABLE].Alloc(NET_BUFSIZE*2);
2587 trans_omsg.Alloc(NET_BUFSIZE);
2588 finalization
2589 NetIn.Free();
2590 NetOut.Free();
2591 NetBuf[NET_UNRELIABLE].Free();
2592 NetBuf[NET_RELIABLE].Free();
2593 end.