DEADSOFTWARE

Net: Don't process network in ProcessLoading() for client's code
[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();
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();
218 function g_Net_Client_ByName(Name: string): pTNetClient;
219 function g_Net_Client_ByPlayer(PID: Word): pTNetClient;
220 function g_Net_ClientName_ByID(ID: Integer): string;
222 procedure g_Net_SendData(Data: AByte; peer: pENetPeer; Reliable: Boolean; Chan: Byte = NET_CHAN_DOWNLOAD);
223 //function g_Net_Wait_Event(msgId: Word): TMemoryStream;
224 //function g_Net_Wait_FileInfo (var tf: TNetFileTransfer; asMap: Boolean; out resList: TStringList): Integer;
226 function IpToStr(IP: LongWord): string;
227 function StrToIp(IPstr: string; var IP: LongWord): Boolean;
229 function g_Net_IsHostBanned(IP: LongWord; Perm: Boolean = False): Boolean;
230 procedure g_Net_BanHost(IP: LongWord; Perm: Boolean = True); overload;
231 procedure g_Net_BanHost(IP: string; Perm: Boolean = True); overload;
232 function g_Net_UnbanHost(IP: string): Boolean; overload;
233 function g_Net_UnbanHost(IP: LongWord): Boolean; overload;
234 procedure g_Net_UnbanNonPermHosts();
235 procedure g_Net_SaveBanList();
237 procedure g_Net_Penalize(C: pTNetClient; Reason: string);
239 procedure g_Net_DumpStart();
240 procedure g_Net_DumpSendBuffer();
241 procedure g_Net_DumpRecvBuffer(Buf: penet_uint8; Len: LongWord);
242 procedure g_Net_DumpEnd();
244 function g_Net_ForwardPorts(ForwardPongPort: Boolean = True): Boolean;
245 procedure g_Net_UnforwardPorts();
247 function g_Net_UserRequestExit: Boolean;
249 function g_Net_Wait_MapInfo (var tf: TNetFileTransfer; var resList: TNetMapResourceInfoArray): Integer;
250 function g_Net_RequestResFileInfo (resIndex: LongInt; out tf: TNetFileTransfer): Integer;
251 function g_Net_AbortResTransfer (var tf: TNetFileTransfer): Boolean;
252 function g_Net_ReceiveResourceFile (resIndex: LongInt; var tf: TNetFileTransfer; strm: TStream): Integer;
254 function g_Net_IsNetworkAvailable (): Boolean;
255 procedure g_Net_InitLowLevel ();
256 procedure g_Net_DeinitLowLevel ();
258 procedure NetServerCVars(P: SSArray);
261 implementation
263 // *enet_host_service()*
264 // fuck! https://www.mail-archive.com/enet-discuss@cubik.org/msg00852.html
265 // tl;dr: on shitdows, we can get -1 sometimes, and it is *NOT* a failure.
266 // thank you, enet. let's ignore failures altogether then.
268 uses
269 SysUtils,
270 e_input, e_res,
271 g_nethandler, g_netmsg, g_netmaster, g_player, g_window, g_console,
272 g_main, g_game, g_language, g_weapons, ctypes, g_system, g_map;
274 const
275 FILE_CHUNK_SIZE = 8192;
277 var
278 enet_init_success: Boolean = false;
279 g_Net_DownloadTimeout: Single;
280 trans_omsg: TMsg;
283 function g_Net_IsNetworkAvailable (): Boolean;
284 begin
285 result := enet_init_success;
286 end;
288 procedure g_Net_InitLowLevel ();
289 var v: ENetVersion;
290 begin
291 v := enet_linked_version();
292 e_LogWritefln('ENet Version: %s.%s.%s', [ENET_VERSION_GET_MAJOR(v), ENET_VERSION_GET_MINOR(v), ENET_VERSION_GET_PATCH(v)]);
293 if enet_init_success then raise Exception.Create('wuta?!');
294 enet_init_success := (enet_initialize() = 0);
295 end;
297 procedure g_Net_DeinitLowLevel ();
298 begin
299 if enet_init_success then
300 begin
301 enet_deinitialize();
302 enet_init_success := false;
303 end;
304 end;
307 //**************************************************************************
308 //
309 // SERVICE FUNCTIONS
310 //
311 //**************************************************************************
313 procedure clearNetClientTransfers (var nc: TNetClient);
314 begin
315 nc.Transfer.stream.Free;
316 nc.Transfer.diskName := ''; // just in case
317 if (nc.Transfer.diskBuffer <> nil) then FreeMem(nc.Transfer.diskBuffer);
318 nc.Transfer.stream := nil;
319 nc.Transfer.diskBuffer := nil;
320 end;
323 procedure clearNetClient (var nc: TNetClient);
324 begin
325 clearNetClientTransfers(nc);
326 end;
329 procedure clearNetClients (clearArray: Boolean);
330 var
331 f: Integer;
332 begin
333 for f := Low(NetClients) to High(NetClients) do clearNetClient(NetClients[f]);
334 if (clearArray) then SetLength(NetClients, 0);
335 end;
338 function g_Net_UserRequestExit (): Boolean;
339 begin
340 Result := {e_KeyPressed(IK_SPACE) or}
341 e_KeyPressed(IK_ESCAPE) or
342 e_KeyPressed(VK_ESCAPE) or
343 e_KeyPressed(JOY0_JUMP) or
344 e_KeyPressed(JOY1_JUMP) or
345 e_KeyPressed(JOY2_JUMP) or
346 e_KeyPressed(JOY3_JUMP)
347 end;
349 //**************************************************************************
350 //
351 // file transfer declaraions and host packet processor
352 //
353 //**************************************************************************
355 const
356 // server packet type
357 NTF_SERVER_DONE = 10; // done with this file
358 NTF_SERVER_FILE_INFO = 11; // sent after client request
359 NTF_SERVER_CHUNK = 12; // next chunk; chunk number follows
360 NTF_SERVER_ABORT = 13; // server abort
361 NTF_SERVER_MAP_INFO = 14;
363 // client packet type
364 NTF_CLIENT_MAP_REQUEST = 100; // map file request; also, returns list of additional wads to download
365 NTF_CLIENT_FILE_REQUEST = 101; // resource file request (by index)
366 NTF_CLIENT_ABORT = 102; // do not send requested file, or abort current transfer
367 NTF_CLIENT_START = 103; // start transfer; client may resume download by sending non-zero starting chunk
368 NTF_CLIENT_ACK = 104; // chunk ack; chunk number follows
371 // disconnect client due to some file transfer error
372 procedure killClientByFT (var nc: TNetClient);
373 begin
374 e_LogWritefln('disconnected client #%d due to file transfer error', [nc.ID], TMsgType.Warning);
375 enet_peer_disconnect(nc.Peer, NET_DISC_FILE_TIMEOUT);
376 clearNetClientTransfers(nc);
377 g_Net_Slist_ServerPlayerLeaves();
378 end;
381 // send file transfer message from server to client
382 function ftransSendServerMsg (var nc: TNetClient; var m: TMsg): Boolean;
383 var
384 pkt: PENetPacket;
385 begin
386 result := false;
387 if (m.CurSize < 1) then exit;
388 pkt := enet_packet_create(m.Data, m.CurSize, ENET_PACKET_FLAG_RELIABLE);
389 if not Assigned(pkt) then begin killClientByFT(nc); exit; end;
390 if (enet_peer_send(nc.Peer, NET_CHAN_DOWNLOAD_EX, pkt) <> 0) then begin killClientByFT(nc); exit; end;
391 result := true;
392 end;
395 // send file transfer message from client to server
396 function ftransSendClientMsg (var m: TMsg): Boolean;
397 var
398 pkt: PENetPacket;
399 begin
400 result := false;
401 if (m.CurSize < 1) then exit;
402 pkt := enet_packet_create(m.Data, m.CurSize, ENET_PACKET_FLAG_RELIABLE);
403 if not Assigned(pkt) then exit;
404 if (enet_peer_send(NetPeer, NET_CHAN_DOWNLOAD_EX, pkt) <> 0) then exit;
405 result := true;
406 end;
409 // file chunk sender
410 procedure ProcessChunkSend (var nc: TNetClient);
411 var
412 tf: ^TNetFileTransfer;
413 ct: Int64;
414 chunks: Integer;
415 rd: Integer;
416 begin
417 tf := @nc.Transfer;
418 if (tf.stream = nil) then exit;
419 ct := GetTimerMS();
420 // arbitrary timeout number
421 if (ct-tf.lastAckTime >= 5000) then
422 begin
423 killClientByFT(nc);
424 exit;
425 end;
426 // check if we need to send something
427 if (not tf.inProgress) then exit; // waiting for the initial ack
428 // ok, we're sending chunks
429 if (tf.lastAckChunk <> tf.lastSentChunk) then exit;
430 Inc(tf.lastSentChunk);
431 // do it one chunk at a time; client ack will advance our chunk counter
432 chunks := (tf.size+tf.chunkSize-1) div tf.chunkSize;
434 if (tf.lastSentChunk > chunks) then
435 begin
436 killClientByFT(nc);
437 exit;
438 end;
440 trans_omsg.Clear();
441 if (tf.lastSentChunk = chunks) then
442 begin
443 // we're done with this file
444 e_LogWritefln('download: client #%d, DONE sending chunks #%d/#%d', [nc.ID, tf.lastSentChunk, chunks]);
445 trans_omsg.Write(Byte(NTF_SERVER_DONE));
446 clearNetClientTransfers(nc);
447 end
448 else
449 begin
450 // packet type
451 trans_omsg.Write(Byte(NTF_SERVER_CHUNK));
452 trans_omsg.Write(LongInt(tf.lastSentChunk));
453 // read chunk
454 rd := tf.size-(tf.lastSentChunk*tf.chunkSize);
455 if (rd > tf.chunkSize) then rd := tf.chunkSize;
456 trans_omsg.Write(LongInt(rd));
457 //e_LogWritefln('download: client #%d, sending chunk #%d/#%d (%d bytes)', [nc.ID, tf.lastSentChunk, chunks, rd]);
458 //FIXME: check for errors here
459 try
460 tf.stream.Seek(tf.lastSentChunk*tf.chunkSize, soFromBeginning);
461 tf.stream.ReadBuffer(tf.diskBuffer^, rd);
462 trans_omsg.WriteData(tf.diskBuffer, rd);
463 except // sorry
464 killClientByFT(nc);
465 exit;
466 end;
467 end;
468 // send packet
469 ftransSendServerMsg(nc, trans_omsg);
470 end;
473 // server file transfer packet processor
474 // received packet is in `NetEvent`
475 procedure ProcessDownloadExPacket ();
476 var
477 f: Integer;
478 nc: ^TNetClient;
479 nid: Integer = -1;
480 msg: TMsg;
481 cmd: Byte;
482 tf: ^TNetFileTransfer;
483 fname: string;
484 chunk: Integer;
485 ridx: Integer;
486 dfn: AnsiString;
487 md5: TMD5Digest;
488 //st: TStream;
489 size: LongInt;
490 fi: TDiskFileInfo;
491 begin
492 // find client index by peer
493 for f := Low(NetClients) to High(NetClients) do
494 begin
495 if (not NetClients[f].Used) then continue;
496 if (NetClients[f].Peer = NetEvent.peer) then
497 begin
498 nid := f;
499 break;
500 end;
501 end;
502 //e_LogWritefln('RECEIVE: dlpacket; client=%d (datalen=%u)', [nid, NetEvent.packet^.dataLength]);
504 if (nid < 0) then exit; // wtf?!
505 nc := @NetClients[nid];
507 if (NetEvent.packet^.dataLength = 0) then
508 begin
509 killClientByFT(nc^);
510 exit;
511 end;
513 // don't time out clients during a file transfer
514 if (NetAuthTimeout > 0) then
515 nc^.AuthTime := gTime + NetAuthTimeout;
516 if (NetPacketTimeout > 0) then
517 nc^.MsgTime := gTime + NetPacketTimeout;
519 tf := @NetClients[nid].Transfer;
520 tf.lastAckTime := GetTimerMS();
522 cmd := Byte(NetEvent.packet^.data^);
523 //e_LogWritefln('RECEIVE: nid=%d; cmd=%u', [nid, cmd]);
524 case cmd of
525 NTF_CLIENT_FILE_REQUEST: // file request
526 begin
527 if (tf.stream <> nil) then
528 begin
529 killClientByFT(nc^);
530 exit;
531 end;
532 if (NetEvent.packet^.dataLength < 2) then
533 begin
534 killClientByFT(nc^);
535 exit;
536 end;
537 // new transfer request; build packet
538 if not msg.Init(NetEvent.packet^.data+1, NetEvent.packet^.dataLength-1, True) then
539 begin
540 killClientByFT(nc^);
541 exit;
542 end;
543 // get resource index
544 ridx := msg.ReadLongInt();
545 if (ridx < -1) or (ridx >= length(gExternalResources)) then
546 begin
547 e_LogWritefln('Invalid resource index %d', [ridx], TMsgType.Warning);
548 killClientByFT(nc^);
549 exit;
550 end;
551 if (ridx < 0) then fname := gGameSettings.WAD else fname := gExternalResources[ridx].diskName;
552 if (length(fname) = 0) then
553 begin
554 e_WriteLog('Invalid filename: '+fname, TMsgType.Warning);
555 killClientByFT(nc^);
556 exit;
557 end;
558 tf.diskName := findDiskWad(fname);
559 if (length(tf.diskName) = 0) then
560 begin
561 e_LogWritefln('NETWORK: file "%s" not found!', [fname], TMsgType.Fatal);
562 killClientByFT(nc^);
563 exit;
564 end;
565 // calculate hash
566 //tf.hash := MD5File(tf.diskName);
567 if (ridx < 0) then tf.hash := gWADHash else tf.hash := gExternalResources[ridx].hash;
568 // create file stream
569 tf.diskName := findDiskWad(fname);
570 try
571 tf.stream := openDiskFileRO(tf.diskName);
572 except
573 tf.stream := nil;
574 end;
575 if (tf.stream = nil) then
576 begin
577 e_WriteLog(Format('NETWORK: file "%s" not found!', [fname]), TMsgType.Fatal);
578 killClientByFT(nc^);
579 exit;
580 end;
581 e_LogWritefln('client #%d requested resource #%d (file is `%s` : `%s`)', [nc.ID, ridx, fname, tf.diskName]);
582 tf.size := tf.stream.size;
583 tf.chunkSize := FILE_CHUNK_SIZE; // arbitrary
584 tf.lastSentChunk := -1;
585 tf.lastAckChunk := -1;
586 tf.lastAckTime := GetTimerMS();
587 tf.inProgress := False; // waiting for the first ACK or for the cancel
588 GetMem(tf.diskBuffer, tf.chunkSize);
589 // sent file info message
590 trans_omsg.Clear();
591 trans_omsg.Write(Byte(NTF_SERVER_FILE_INFO));
592 trans_omsg.Write(tf.hash);
593 trans_omsg.Write(tf.size);
594 trans_omsg.Write(tf.chunkSize);
595 trans_omsg.Write(ExtractFileName(fname));
596 if not ftransSendServerMsg(nc^, trans_omsg) then exit;
597 end;
598 NTF_CLIENT_ABORT: // do not send requested file, or abort current transfer
599 begin
600 e_LogWritefln('client #%d aborted file transfer', [nc.ID]);
601 clearNetClientTransfers(nc^);
602 end;
603 NTF_CLIENT_START: // start transfer; client may resume download by sending non-zero starting chunk
604 begin
605 if not Assigned(tf.stream) then
606 begin
607 killClientByFT(nc^);
608 exit;
609 end;
610 if (tf.lastSentChunk <> -1) or (tf.lastAckChunk <> -1) or (tf.inProgress) then
611 begin
612 // double ack, get lost
613 killClientByFT(nc^);
614 exit;
615 end;
616 if (NetEvent.packet^.dataLength < 2) then
617 begin
618 killClientByFT(nc^);
619 exit;
620 end;
621 // build packet
622 if not msg.Init(NetEvent.packet^.data+1, NetEvent.packet^.dataLength-1, True) then
623 begin
624 killClientByFT(nc^);
625 exit;
626 end;
627 chunk := msg.ReadLongInt();
628 if (chunk < 0) or (chunk > (tf.size+tf.chunkSize-1) div tf.chunkSize) then
629 begin
630 killClientByFT(nc^);
631 exit;
632 end;
633 e_LogWritefln('client #%d started file transfer from chunk %d', [nc.ID, chunk]);
634 // start sending chunks
635 tf.inProgress := True;
636 tf.lastSentChunk := chunk-1;
637 tf.lastAckChunk := chunk-1;
638 ProcessChunkSend(nc^);
639 end;
640 NTF_CLIENT_ACK: // chunk ack; chunk number follows
641 begin
642 if not Assigned(tf.stream) then
643 begin
644 killClientByFT(nc^);
645 exit;
646 end;
647 if (tf.lastSentChunk < 0) or (not tf.inProgress) then
648 begin
649 // double ack, get lost
650 killClientByFT(nc^);
651 exit;
652 end;
653 if (NetEvent.packet^.dataLength < 2) then
654 begin
655 killClientByFT(nc^);
656 exit;
657 end;
658 // build packet
659 if not msg.Init(NetEvent.packet^.data+1, NetEvent.packet^.dataLength-1, True) then
660 begin
661 killClientByFT(nc^);
662 exit;
663 end;
664 chunk := msg.ReadLongInt();
665 if (chunk < 0) or (chunk > (tf.size+tf.chunkSize-1) div tf.chunkSize) then
666 begin
667 killClientByFT(nc^);
668 exit;
669 end;
670 // do it this way, so client may seek, or request retransfers for some reason
671 tf.lastAckChunk := chunk;
672 tf.lastSentChunk := chunk;
673 //e_LogWritefln('client #%d acked file transfer chunk %d', [nc.ID, chunk]);
674 ProcessChunkSend(nc^);
675 end;
676 NTF_CLIENT_MAP_REQUEST:
677 begin
678 e_LogWritefln('client #%d requested map info', [nc.ID]);
679 trans_omsg.Clear();
680 dfn := findDiskWad(gGameSettings.WAD);
681 if (dfn = '') then dfn := '!wad_not_found!.wad'; //FIXME
682 //md5 := MD5File(dfn);
683 md5 := gWADHash;
684 if (not GetDiskFileInfo(dfn, fi)) then
685 begin
686 e_LogWritefln('client #%d requested map info, but i cannot get file info', [nc.ID]);
687 killClientByFT(nc^);
688 exit;
689 end;
690 size := fi.size;
692 st := openDiskFileRO(dfn);
693 if not assigned(st) then exit; //wtf?!
694 size := st.size;
695 st.Free;
697 // packet type
698 trans_omsg.Write(Byte(NTF_SERVER_MAP_INFO));
699 // map wad name
700 trans_omsg.Write(ExtractFileName(gGameSettings.WAD));
701 // map wad md5
702 trans_omsg.Write(md5);
703 // map wad size
704 trans_omsg.Write(size);
705 // number of external resources for map
706 trans_omsg.Write(LongInt(length(gExternalResources)));
707 // external resource names
708 for f := 0 to High(gExternalResources) do
709 begin
710 // old style packet
711 //trans_omsg.Write(ExtractFileName(gExternalResources[f])); // GameDir+'/wads/'+ResList.Strings[i]
712 // new style packet
713 trans_omsg.Write('!');
714 trans_omsg.Write(LongInt(gExternalResources[f].size));
715 trans_omsg.Write(gExternalResources[f].hash);
716 trans_omsg.Write(ExtractFileName(gExternalResources[f].diskName));
717 end;
718 // send packet
719 if not ftransSendServerMsg(nc^, trans_omsg) then exit;
720 end;
721 else
722 begin
723 killClientByFT(nc^);
724 exit;
725 end;
726 end;
727 end;
730 //**************************************************************************
731 //
732 // file transfer crap (both client and server)
733 //
734 //**************************************************************************
736 function getNewTimeoutEnd (): Int64;
737 begin
738 result := GetTimerMS();
739 if (g_Net_DownloadTimeout <= 0) then
740 begin
741 result := result+1000*60*3; // 3 minutes
742 end
743 else
744 begin
745 result := result+trunc(g_Net_DownloadTimeout*1000);
746 end;
747 end;
750 // send map request to server, and wait for "map info" server reply
751 //
752 // returns `false` on error or user abort
753 // fills:
754 // diskName: map wad file name (without a path)
755 // hash: map wad hash
756 // size: map wad size
757 // chunkSize: set too
758 // resList: list of resource wads
759 // returns:
760 // <0 on error
761 // 0 on success
762 // 1 on user abort
763 // 2 on server abort
764 // for maps, first `tf.diskName` name will be map wad name, and `tf.hash`/`tf.size` will contain map info
765 function g_Net_Wait_MapInfo (var tf: TNetFileTransfer; var resList: TNetMapResourceInfoArray): Integer;
766 var
767 ev: ENetEvent;
768 rMsgId: Byte;
769 Ptr: Pointer;
770 msg: TMsg;
771 freePacket: Boolean = false;
772 ct, ett: Int64;
773 status: cint;
774 s: AnsiString;
775 rc, f: LongInt;
776 ri: ^TNetMapResourceInfo;
777 begin
778 SetLength(resList, 0);
780 // send request
781 trans_omsg.Clear();
782 trans_omsg.Write(Byte(NTF_CLIENT_MAP_REQUEST));
783 if not ftransSendClientMsg(trans_omsg) then begin result := -1; exit; end;
785 FillChar(ev, SizeOf(ev), 0);
786 Result := -1;
787 try
788 ett := getNewTimeoutEnd();
789 repeat
790 status := enet_host_service(NetHost, @ev, 300);
792 if (status < 0) then
793 begin
794 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' network error', True);
795 Result := -1;
796 exit;
797 end;
799 if (status <= 0) then
800 begin
801 // check for timeout
802 ct := GetTimerMS();
803 if (ct >= ett) then
804 begin
805 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' timeout reached', True);
806 Result := -1;
807 exit;
808 end;
809 end
810 else
811 begin
812 // some event
813 case ev.kind of
814 ENET_EVENT_TYPE_RECEIVE:
815 begin
816 freePacket := true;
817 if (ev.channelID <> NET_CHAN_DOWNLOAD_EX) then
818 begin
819 //e_LogWritefln('g_Net_Wait_MapInfo: skip message from non-transfer channel', []);
820 freePacket := false;
821 g_Net_Client_HandlePacket(ev.packet, g_Net_ClientLightMsgHandler);
822 if (g_Res_received_map_start < 0) then begin result := -666; exit; end;
823 end
824 else
825 begin
826 ett := getNewTimeoutEnd();
827 if (ev.packet.dataLength < 1) then
828 begin
829 e_LogWritefln('g_Net_Wait_MapInfo: invalid server packet (no data)', []);
830 Result := -1;
831 exit;
832 end;
833 Ptr := ev.packet^.data;
834 rMsgId := Byte(Ptr^);
835 e_LogWritefln('g_Net_Wait_MapInfo: got message %u from server (dataLength=%u)', [rMsgId, ev.packet^.dataLength]);
836 if (rMsgId = NTF_SERVER_FILE_INFO) then
837 begin
838 e_LogWritefln('g_Net_Wait_MapInfo: waiting for map info reply, but got file info reply', []);
839 Result := -1;
840 exit;
841 end
842 else if (rMsgId = NTF_SERVER_ABORT) then
843 begin
844 e_LogWritefln('g_Net_Wait_MapInfo: server aborted transfer', []);
845 Result := 2;
846 exit;
847 end
848 else if (rMsgId = NTF_SERVER_MAP_INFO) then
849 begin
850 e_LogWritefln('g_Net_Wait_MapInfo: creating map info packet...', []);
851 if not msg.Init(ev.packet^.data+1, ev.packet^.dataLength-1, True) then exit;
852 e_LogWritefln('g_Net_Wait_MapInfo: parsing map info packet (rd=%d; max=%d)...', [msg.ReadCount, msg.MaxSize]);
853 SetLength(resList, 0); // just in case
854 // map wad name
855 tf.diskName := msg.ReadString();
856 e_LogWritefln('g_Net_Wait_MapInfo: map wad is `%s`', [tf.diskName]);
857 // map wad md5
858 tf.hash := msg.ReadMD5();
859 // map wad size
860 tf.size := msg.ReadLongInt();
861 e_LogWritefln('g_Net_Wait_MapInfo: map wad size is %d', [tf.size]);
862 // number of external resources for map
863 rc := msg.ReadLongInt();
864 if (rc < 0) or (rc > 1024) then
865 begin
866 e_LogWritefln('g_Net_Wait_Event: invalid number of map external resources (%d)', [rc]);
867 Result := -1;
868 exit;
869 end;
870 e_LogWritefln('g_Net_Wait_MapInfo: map external resource count is %d', [rc]);
871 SetLength(resList, rc);
872 // external resource names
873 for f := 0 to rc-1 do
874 begin
875 ri := @resList[f];
876 s := msg.ReadString();
877 if (length(s) = 0) then begin result := -1; exit; end;
878 if (s = '!') then
879 begin
880 // extended packet
881 ri.size := msg.ReadLongInt();
882 ri.hash := msg.ReadMD5();
883 ri.wadName := ExtractFileName(msg.ReadString());
884 if (length(ri.wadName) = 0) or (ri.size < 0) then begin result := -1; exit; end;
885 end
886 else
887 begin
888 // old-style packet, only name
889 ri.wadName := ExtractFileName(s);
890 if (length(ri.wadName) = 0) then begin result := -1; exit; end;
891 ri.size := -1; // unknown
892 end;
893 end;
894 e_LogWritefln('g_Net_Wait_MapInfo: got map info', []);
895 Result := 0; // success
896 exit;
897 end
898 else
899 begin
900 e_LogWritefln('g_Net_Wait_Event: invalid server packet type', []);
901 Result := -1;
902 exit;
903 end;
904 end;
905 end;
906 ENET_EVENT_TYPE_DISCONNECT:
907 begin
908 if (ev.data <= NET_DISC_MAX) then
909 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' ' + _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + ev.data)], True);
910 Result := -1;
911 exit;
912 end;
913 else
914 begin
915 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' unknown ENet event ' + IntToStr(Ord(ev.kind)), True);
916 result := -1;
917 exit;
918 end;
919 end;
920 if (freePacket) then begin freePacket := false; enet_packet_destroy(ev.packet); end;
921 end;
923 ProcessLoading(False);
924 if g_Net_UserRequestExit() then
925 begin
926 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' user abort', True);
927 Result := 1;
928 exit;
929 end;
930 until false;
931 finally
932 if (freePacket) then enet_packet_destroy(ev.packet);
933 end;
934 end;
937 // send file request to server, and wait for server reply
938 //
939 // returns `false` on error or user abort
940 // fills:
941 // diskName (actually, base name)
942 // hash
943 // size
944 // chunkSize
945 // returns:
946 // <0 on error
947 // 0 on success
948 // 1 on user abort
949 // 2 on server abort
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;
952 var
953 ev: ENetEvent;
954 rMsgId: Byte;
955 Ptr: Pointer;
956 msg: TMsg;
957 freePacket: Boolean = false;
958 ct, ett: Int64;
959 status: cint;
960 begin
961 // send request
962 trans_omsg.Clear();
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);
968 Result := -1;
969 try
970 ett := getNewTimeoutEnd();
971 repeat
972 status := enet_host_service(NetHost, @ev, 300);
974 if (status < 0) then
975 begin
976 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' network error', True);
977 Result := -1;
978 exit;
979 end;
981 if (status <= 0) then
982 begin
983 // check for timeout
984 ct := GetTimerMS();
985 if (ct >= ett) then
986 begin
987 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' timeout reached', True);
988 Result := -1;
989 exit;
990 end;
991 end
992 else
993 begin
994 // some event
995 case ev.kind of
996 ENET_EVENT_TYPE_RECEIVE:
997 begin
998 freePacket := true;
999 if (ev.channelID <> NET_CHAN_DOWNLOAD_EX) then
1000 begin
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;
1005 end
1006 else
1007 begin
1008 ett := getNewTimeoutEnd();
1009 if (ev.packet.dataLength < 1) then
1010 begin
1011 e_LogWriteln('g_Net_Wait_Event: invalid server packet (no data)');
1012 Result := -1;
1013 exit;
1014 end;
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
1019 begin
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
1026 begin
1027 e_LogWritefln('g_Net_RequestResFileInfo: invalid file info packet', []);
1028 Result := -1;
1029 exit;
1030 end;
1031 e_LogWritefln('got file info for resource #%d: size=%d; name=%s', [resIndex, tf.size, tf.diskName]);
1032 Result := 0; // success
1033 exit;
1034 end
1035 else if (rMsgId = NTF_SERVER_ABORT) then
1036 begin
1037 e_LogWriteln('g_Net_RequestResFileInfo: server aborted transfer');
1038 Result := 2;
1039 exit;
1040 end
1041 else if (rMsgId = NTF_SERVER_MAP_INFO) then
1042 begin
1043 e_LogWriteln('g_Net_RequestResFileInfo: waiting for map info reply, but got file info reply');
1044 Result := -1;
1045 exit;
1046 end
1047 else
1048 begin
1049 e_LogWriteln('g_Net_RequestResFileInfo: invalid server packet type');
1050 Result := -1;
1051 exit;
1052 end;
1053 end;
1054 end;
1055 ENET_EVENT_TYPE_DISCONNECT:
1056 begin
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);
1059 Result := -1;
1060 exit;
1061 end;
1062 else
1063 begin
1064 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' unknown ENet event ' + IntToStr(Ord(ev.kind)), True);
1065 result := -1;
1066 exit;
1067 end;
1068 end;
1069 if (freePacket) then begin freePacket := false; enet_packet_destroy(ev.packet); end;
1070 end;
1072 ProcessLoading(False);
1073 if g_Net_UserRequestExit() then
1074 begin
1075 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' user abort', True);
1076 Result := 1;
1077 exit;
1078 end;
1079 until false;
1080 finally
1081 if (freePacket) then enet_packet_destroy(ev.packet);
1082 end;
1083 end;
1086 // call this to cancel file transfer requested by `g_Net_RequestResFileInfo()`
1087 function g_Net_AbortResTransfer (var tf: TNetFileTransfer): Boolean;
1088 begin
1089 result := false;
1090 e_LogWritefln('aborting file transfer...', []);
1091 // send request
1092 trans_omsg.Clear();
1093 trans_omsg.Write(Byte(NTF_CLIENT_ABORT));
1094 result := ftransSendClientMsg(trans_omsg);
1095 if result then enet_host_flush(NetHost);
1096 end;
1099 // call this to start file transfer requested by `g_Net_RequestResFileInfo()`
1100 //
1101 // returns `false` on error or user abort
1102 // fills:
1103 // hash
1104 // size
1105 // chunkSize
1106 // returns:
1107 // <0 on error
1108 // 0 on success
1109 // 1 on user abort
1110 // 2 on server abort
1111 // for maps, first `tf.diskName` name will be map wad name, and `tf.hash`/`tf.size` will contain map info
1112 function g_Net_ReceiveResourceFile (resIndex: LongInt; var tf: TNetFileTransfer; strm: TStream): Integer;
1113 var
1114 ev: ENetEvent;
1115 rMsgId: Byte;
1116 Ptr: Pointer;
1117 msg: TMsg;
1118 freePacket: Boolean = false;
1119 ct, ett: Int64;
1120 status: cint;
1121 nextChunk: Integer = 0;
1122 chunkTotal: Integer;
1123 chunk: Integer;
1124 csize: Integer;
1125 buf: PChar = nil;
1126 resumed: Boolean;
1127 //stx: Int64;
1128 begin
1129 tf.resumed := false;
1130 e_LogWritefln('file `%s`, size=%d (%d)', [tf.diskName, Integer(strm.size), tf.size], TMsgType.Notify);
1131 // check if we should resume downloading
1132 resumed := (strm.size > tf.chunkSize) and (strm.size < tf.size);
1133 // send request
1134 trans_omsg.Clear();
1135 trans_omsg.Write(Byte(NTF_CLIENT_START));
1136 if resumed then chunk := strm.size div tf.chunkSize else chunk := 0;
1137 trans_omsg.Write(LongInt(chunk));
1138 if not ftransSendClientMsg(trans_omsg) then begin result := -1; exit; end;
1140 strm.Seek(chunk*tf.chunkSize, soFromBeginning);
1141 chunkTotal := (tf.size+tf.chunkSize-1) div tf.chunkSize;
1142 e_LogWritefln('receiving file `%s` (%d chunks)', [tf.diskName, chunkTotal], TMsgType.Notify);
1143 g_Game_SetLoadingText('downloading "'+ExtractFileName(tf.diskName)+'"', chunkTotal, False);
1144 tf.resumed := resumed;
1146 if (chunk > 0) then g_Game_StepLoading(chunk);
1147 nextChunk := chunk;
1149 // wait for reply data
1150 FillChar(ev, SizeOf(ev), 0);
1151 Result := -1;
1152 GetMem(buf, tf.chunkSize);
1153 try
1154 ett := getNewTimeoutEnd();
1155 repeat
1156 //stx := -GetTimerMS();
1157 status := enet_host_service(NetHost, @ev, 300);
1159 if (status < 0) then
1160 begin
1161 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' network error', True);
1162 Result := -1;
1163 exit;
1164 end;
1166 if (status <= 0) then
1167 begin
1168 // check for timeout
1169 ct := GetTimerMS();
1170 if (ct >= ett) then
1171 begin
1172 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' timeout reached', True);
1173 Result := -1;
1174 exit;
1175 end;
1176 end
1177 else
1178 begin
1179 // some event
1180 case ev.kind of
1181 ENET_EVENT_TYPE_RECEIVE:
1182 begin
1183 freePacket := true;
1184 if (ev.channelID <> NET_CHAN_DOWNLOAD_EX) then
1185 begin
1186 //e_LogWritefln('g_Net_Wait_Event: skip message from non-transfer channel', []);
1187 freePacket := false;
1188 g_Net_Client_HandlePacket(ev.packet, g_Net_ClientLightMsgHandler);
1189 if (g_Res_received_map_start < 0) then begin result := -666; exit; end;
1190 end
1191 else
1192 begin
1193 //stx := stx+GetTimerMS();
1194 //e_LogWritefln('g_Net_ReceiveResourceFile: stx=%d', [Integer(stx)]);
1195 //stx := -GetTimerMS();
1196 ett := getNewTimeoutEnd();
1197 if (ev.packet.dataLength < 1) then
1198 begin
1199 e_LogWritefln('g_Net_ReceiveResourceFile: invalid server packet (no data)', []);
1200 Result := -1;
1201 exit;
1202 end;
1203 Ptr := ev.packet^.data;
1204 rMsgId := Byte(Ptr^);
1205 if (rMsgId = NTF_SERVER_DONE) then
1206 begin
1207 e_LogWritefln('file transfer complete.', []);
1208 result := 0;
1209 exit;
1210 end
1211 else if (rMsgId = NTF_SERVER_CHUNK) then
1212 begin
1213 if not msg.Init(ev.packet^.data+1, ev.packet^.dataLength-1, True) then exit;
1214 chunk := msg.ReadLongInt();
1215 csize := msg.ReadLongInt();
1216 if (chunk <> nextChunk) then
1217 begin
1218 e_LogWritefln('received chunk %d, but expected chunk %d', [chunk, nextChunk]);
1219 Result := -1;
1220 exit;
1221 end;
1222 if (csize < 0) or (csize > tf.chunkSize) then
1223 begin
1224 e_LogWritefln('received chunk with size %d, but expected chunk size is %d', [csize, tf.chunkSize]);
1225 Result := -1;
1226 exit;
1227 end;
1228 //e_LogWritefln('got chunk #%d of #%d (csize=%d)', [chunk, (tf.size+tf.chunkSize-1) div tf.chunkSize, csize]);
1229 msg.ReadData(buf, csize);
1230 strm.WriteBuffer(buf^, csize);
1231 nextChunk := chunk+1;
1232 g_Game_StepLoading();
1233 // send ack
1234 trans_omsg.Clear();
1235 trans_omsg.Write(Byte(NTF_CLIENT_ACK));
1236 trans_omsg.Write(LongInt(chunk));
1237 if not ftransSendClientMsg(trans_omsg) then begin result := -1; exit; end;
1238 end
1239 else if (rMsgId = NTF_SERVER_ABORT) then
1240 begin
1241 e_LogWritefln('g_Net_ReceiveResourceFile: server aborted transfer', []);
1242 Result := 2;
1243 exit;
1244 end
1245 else
1246 begin
1247 e_LogWritefln('g_Net_ReceiveResourceFile: invalid server packet type', []);
1248 Result := -1;
1249 exit;
1250 end;
1251 //stx := stx+GetTimerMS();
1252 //e_LogWritefln('g_Net_ReceiveResourceFile: process stx=%d', [Integer(stx)]);
1253 end;
1254 end;
1255 ENET_EVENT_TYPE_DISCONNECT:
1256 begin
1257 if (ev.data <= NET_DISC_MAX) then
1258 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' ' + _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + ev.data)], True);
1259 Result := -1;
1260 exit;
1261 end;
1262 else
1263 begin
1264 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' unknown ENet event ' + IntToStr(Ord(ev.kind)), True);
1265 result := -1;
1266 exit;
1267 end;
1268 end;
1269 if (freePacket) then begin freePacket := false; enet_packet_destroy(ev.packet); end;
1270 end;
1272 ProcessLoading(False);
1273 if g_Net_UserRequestExit() then
1274 begin
1275 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' user abort', True);
1276 Result := 1;
1277 exit;
1278 end;
1279 until false;
1280 finally
1281 FreeMem(buf);
1282 if (freePacket) then enet_packet_destroy(ev.packet);
1283 end;
1284 end;
1287 //**************************************************************************
1288 //
1289 // common functions
1290 //
1291 //**************************************************************************
1293 function g_Net_FindSlot(): Integer;
1294 var
1295 I: Integer;
1296 F: Boolean;
1297 N, C: Integer;
1298 begin
1299 N := -1;
1300 F := False;
1301 C := 0;
1302 for I := Low(NetClients) to High(NetClients) do
1303 begin
1304 if NetClients[I].Used then
1305 Inc(C)
1306 else
1307 if not F then
1308 begin
1309 F := True;
1310 N := I;
1311 end;
1312 end;
1313 if C >= NetMaxClients then
1314 begin
1315 Result := -1;
1316 Exit;
1317 end;
1319 if not F then
1320 begin
1321 if (Length(NetClients) >= NetMaxClients) then
1322 N := -1
1323 else
1324 begin
1325 SetLength(NetClients, Length(NetClients) + 1);
1326 N := High(NetClients);
1327 end;
1328 end;
1330 if N >= 0 then
1331 begin
1332 NetClients[N].Used := True;
1333 NetClients[N].ID := N;
1334 NetClients[N].RequestedFullUpdate := False;
1335 NetClients[N].WaitForFirstSpawn := False;
1336 NetClients[N].RCONAuth := False;
1337 NetClients[N].Voted := False;
1338 NetClients[N].Player := 0;
1339 clearNetClientTransfers(NetClients[N]); // just in case
1340 end;
1342 Result := N;
1343 end;
1346 function g_Net_Init(): Boolean;
1347 var
1348 F: TextFile;
1349 IPstr: string;
1350 IP: LongWord;
1351 path: AnsiString;
1352 begin
1353 NetIn.Clear();
1354 NetOut.Clear();
1355 NetBuf[NET_UNRELIABLE].Clear();
1356 NetBuf[NET_RELIABLE].Clear();
1357 //SetLength(NetClients, 0);
1358 clearNetClients(true); // clear array
1359 NetPeer := nil;
1360 NetHost := nil;
1361 NetMyID := -1;
1362 NetPlrUID1 := -1;
1363 NetPlrUID2 := -1;
1364 NetAddr.port := 25666;
1365 SetLength(NetBannedHosts, 0);
1366 path := BANLIST_FILENAME;
1367 if e_FindResource(DataDirs, path) = true then
1368 begin
1369 Assign(F, path);
1370 Reset(F);
1371 while not EOF(F) do
1372 begin
1373 Readln(F, IPstr);
1374 if StrToIp(IPstr, IP) then
1375 g_Net_BanHost(IP);
1376 end;
1377 CloseFile(F);
1378 g_Net_SaveBanList();
1379 end;
1381 //Result := (enet_initialize() = 0);
1382 Result := enet_init_success;
1383 end;
1385 procedure g_Net_Flush();
1386 var
1387 T: Integer;
1388 P: pENetPacket;
1389 F, Chan: enet_uint32;
1390 I: Integer;
1391 begin
1392 F := 0;
1393 Chan := NET_CHAN_GAME;
1395 if NetMode = NET_SERVER then
1396 for T := NET_UNRELIABLE to NET_RELIABLE do
1397 begin
1398 if NetBuf[T].CurSize > 0 then
1399 begin
1400 P := enet_packet_create(NetBuf[T].Data, NetBuf[T].CurSize, F);
1401 if not Assigned(P) then continue;
1402 enet_host_broadcast(NetHost, Chan, P);
1403 NetBuf[T].Clear();
1404 end;
1406 for I := Low(NetClients) to High(NetClients) do
1407 begin
1408 if not NetClients[I].Used then continue;
1409 if NetClients[I].NetOut[T].CurSize <= 0 then continue;
1410 P := enet_packet_create(NetClients[I].NetOut[T].Data, NetClients[I].NetOut[T].CurSize, F);
1411 if not Assigned(P) then continue;
1412 enet_peer_send(NetClients[I].Peer, Chan, P);
1413 NetClients[I].NetOut[T].Clear();
1414 end;
1416 // next and last iteration is always RELIABLE
1417 F := LongWord(ENET_PACKET_FLAG_RELIABLE);
1418 Chan := NET_CHAN_IMPORTANT;
1419 end
1420 else if NetMode = NET_CLIENT then
1421 for T := NET_UNRELIABLE to NET_RELIABLE do
1422 begin
1423 if NetBuf[T].CurSize > 0 then
1424 begin
1425 P := enet_packet_create(NetBuf[T].Data, NetBuf[T].CurSize, F);
1426 if not Assigned(P) then continue;
1427 enet_peer_send(NetPeer, Chan, P);
1428 NetBuf[T].Clear();
1429 end;
1430 // next and last iteration is always RELIABLE
1431 F := LongWord(ENET_PACKET_FLAG_RELIABLE);
1432 Chan := NET_CHAN_IMPORTANT;
1433 end;
1434 end;
1436 procedure g_Net_Cleanup();
1437 begin
1438 NetIn.Clear();
1439 NetOut.Clear();
1440 NetBuf[NET_UNRELIABLE].Clear();
1441 NetBuf[NET_RELIABLE].Clear();
1443 //SetLength(NetClients, 0);
1444 clearNetClients(true); // clear array
1445 NetClientCount := 0;
1447 NetPeer := nil;
1448 NetHost := nil;
1449 g_Net_Slist_ServerClosed();
1450 NetMyID := -1;
1451 NetPlrUID1 := -1;
1452 NetPlrUID2 := -1;
1453 NetState := NET_STATE_NONE;
1455 NetPongSock := ENET_SOCKET_NULL;
1457 NetTimeToMaster := 0;
1458 NetTimeToUpdate := 0;
1459 NetTimeToReliable := 0;
1461 NetMode := NET_NONE;
1463 if NetPortThread <> NilThreadId then
1464 WaitForThreadTerminate(NetPortThread, 66666);
1466 NetPortThread := NilThreadId;
1467 g_Net_UnforwardPorts();
1469 if NetDump then
1470 g_Net_DumpEnd();
1471 end;
1473 procedure g_Net_Free();
1474 begin
1475 g_Net_Cleanup();
1477 //enet_deinitialize();
1478 NetInitDone := False;
1479 end;
1482 //**************************************************************************
1483 //
1484 // SERVER FUNCTIONS
1485 //
1486 //**************************************************************************
1488 function ForwardThread(Param: Pointer): PtrInt;
1489 begin
1490 Result := 0;
1491 if not g_Net_ForwardPorts() then Result := -1;
1492 end;
1494 function g_Net_Host(IPAddr: LongWord; Port: enet_uint16; MaxClients: Cardinal = 16): Boolean;
1495 begin
1496 if NetMode <> NET_NONE then
1497 begin
1498 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_INGAME]);
1499 Result := False;
1500 Exit;
1501 end;
1503 Result := True;
1505 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST], [Port]));
1506 if not NetInitDone then
1507 begin
1508 if (not g_Net_Init()) then
1509 begin
1510 g_Console_Add(_lc[I_NET_MSG_FERROR] + _lc[I_NET_ERR_ENET]);
1511 Result := False;
1512 Exit;
1513 end
1514 else
1515 NetInitDone := True;
1516 end;
1518 NetAddr.host := IPAddr;
1519 NetAddr.port := Port;
1521 NetHost := enet_host_create(@NetAddr, NET_MAXCLIENTS, NET_CHANS, 0, 0);
1523 if (NetHost = nil) then
1524 begin
1525 g_Console_Add(_lc[I_NET_MSG_ERROR] + Format(_lc[I_NET_ERR_HOST], [Port]));
1526 Result := False;
1527 g_Net_Cleanup;
1528 Exit;
1529 end;
1531 if NetForwardPorts then NetPortThread := BeginThread(ForwardThread);
1533 NetPongSock := enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM);
1534 if NetPongSock <> ENET_SOCKET_NULL then
1535 begin
1536 NetPongAddr.host := IPAddr;
1537 NetPongAddr.port := NET_PING_PORT;
1538 if enet_socket_bind(NetPongSock, @NetPongAddr) < 0 then
1539 begin
1540 enet_socket_destroy(NetPongSock);
1541 NetPongSock := ENET_SOCKET_NULL;
1542 end
1543 else
1544 enet_socket_set_option(NetPongSock, ENET_SOCKOPT_NONBLOCK, 1);
1545 end;
1547 NetMode := NET_SERVER;
1548 NetOut.Clear();
1549 NetBuf[NET_UNRELIABLE].Clear();
1550 NetBuf[NET_RELIABLE].Clear();
1552 if NetDump then
1553 g_Net_DumpStart();
1554 end;
1556 procedure g_Net_Host_Die();
1557 var
1558 I: Integer;
1559 begin
1560 if NetMode <> NET_SERVER then Exit;
1562 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_DISCALL]);
1563 for I := 0 to High(NetClients) do
1564 if NetClients[I].Used then
1565 enet_peer_disconnect(NetClients[I].Peer, NET_DISC_DOWN);
1567 while enet_host_service(NetHost, @NetEvent, 1000) > 0 do
1568 if NetEvent.kind = ENET_EVENT_TYPE_RECEIVE then
1569 enet_packet_destroy(NetEvent.packet);
1571 for I := 0 to High(NetClients) do
1572 if NetClients[I].Used then
1573 begin
1574 FreeMemory(NetClients[I].Peer^.data);
1575 NetClients[I].Peer^.data := nil;
1576 enet_peer_reset(NetClients[I].Peer);
1577 NetClients[I].Peer := nil;
1578 NetClients[I].Used := False;
1579 NetClients[I].Player := 0;
1580 NetClients[I].Crimes := 0;
1581 NetClients[I].AuthTime := 0;
1582 NetClients[I].MsgTime := 0;
1583 NetClients[I].NetOut[NET_UNRELIABLE].Free();
1584 NetClients[I].NetOut[NET_RELIABLE].Free();
1585 end;
1587 clearNetClients(false); // don't clear array
1588 g_Net_Slist_ServerClosed();
1589 if NetPongSock <> ENET_SOCKET_NULL then
1590 enet_socket_destroy(NetPongSock);
1592 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_DIE]);
1593 enet_host_destroy(NetHost);
1595 NetMode := NET_NONE;
1597 g_Net_Cleanup;
1598 e_WriteLog('NET: Server stopped', TMsgType.Notify);
1599 end;
1602 procedure g_Net_Host_Send(ID: Integer; Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
1603 var
1604 T: Integer;
1605 begin
1606 if (Reliable) then
1607 T := NET_RELIABLE
1608 else
1609 T := NET_UNRELIABLE;
1611 if (ID >= 0) then
1612 begin
1613 if ID > High(NetClients) then Exit;
1614 if NetClients[ID].Peer = nil then Exit;
1615 // write size first
1616 NetClients[ID].NetOut[T].Write(Integer(NetOut.CurSize));
1617 NetClients[ID].NetOut[T].Write(NetOut);
1618 end
1619 else
1620 begin
1621 // write size first
1622 NetBuf[T].Write(Integer(NetOut.CurSize));
1623 NetBuf[T].Write(NetOut);
1624 end;
1626 if NetDump then g_Net_DumpSendBuffer();
1627 NetOut.Clear();
1628 end;
1630 procedure g_Net_Host_Disconnect_Client(ID: Integer; Force: Boolean = False);
1631 var
1632 TP: TPlayer;
1633 TC: pTNetClient;
1634 begin
1635 TC := @NetClients[ID];
1636 if (TC = nil) then Exit;
1637 clearNetClient(NetClients[ID]);
1638 if not (TC^.Used) then Exit;
1640 TP := g_Player_Get(TC^.Player);
1642 if TP <> nil then
1643 begin
1644 TP.Lives := 0;
1645 TP.Kill(K_SIMPLEKILL, 0, HIT_DISCON);
1646 g_Console_Add(Format(_lc[I_PLAYER_LEAVE], [TP.Name]), True);
1647 e_WriteLog('NET: Client ' + TP.Name + ' [' + IntToStr(TC^.ID) + '] disconnected.', TMsgType.Notify);
1648 g_Player_Remove(TP.UID);
1649 end;
1651 if (TC^.Peer^.data <> nil) then
1652 begin
1653 FreeMemory(TC^.Peer^.data);
1654 TC^.Peer^.data := nil;
1655 end;
1657 if (Force) then
1658 enet_peer_reset(TC^.Peer);
1660 TC^.Used := False;
1661 TC^.State := NET_STATE_NONE;
1662 TC^.Peer := nil;
1663 TC^.Player := 0;
1664 TC^.Crimes := 0;
1665 TC^.AuthTime := 0;
1666 TC^.MsgTime := 0;
1667 TC^.RequestedFullUpdate := False;
1668 TC^.FullUpdateSent := False;
1669 TC^.WaitForFirstSpawn := False;
1670 TC^.NetOut[NET_UNRELIABLE].Free();
1671 TC^.NetOut[NET_RELIABLE].Free();
1673 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST_DISC], [ID]));
1674 Dec(NetClientCount);
1676 if NetUseMaster then g_Net_Slist_ServerPlayerLeaves();
1677 end;
1679 procedure g_Net_Host_CheckPings();
1680 var
1681 ClAddr: ENetAddress;
1682 Buf: ENetBuffer;
1683 Len: Integer;
1684 ClTime: Int64;
1685 Ping: array [0..9] of Byte;
1686 NPl: Byte;
1687 begin
1688 if (NetPongSock = ENET_SOCKET_NULL) or (NetHost = nil) then Exit;
1690 Buf.data := Addr(Ping[0]);
1691 Buf.dataLength := 2+8;
1693 Ping[0] := 0;
1695 Len := enet_socket_receive(NetPongSock, @ClAddr, @Buf, 1);
1696 if Len < 0 then Exit;
1698 if (Ping[0] = Ord('D')) and (Ping[1] = Ord('F')) then
1699 begin
1700 ClTime := Int64(Addr(Ping[2])^);
1702 NetOut.Clear();
1703 NetOut.Write(Byte(Ord('D')));
1704 NetOut.Write(Byte(Ord('F')));
1705 NetOut.Write(NetHost.address.port);
1706 NetOut.Write(ClTime);
1707 TMasterHost.writeInfo(NetOut);
1708 NPl := 0;
1709 if gPlayer1 <> nil then Inc(NPl);
1710 if gPlayer2 <> nil then Inc(NPl);
1711 NetOut.Write(NPl);
1712 NetOut.Write(gNumBots);
1714 Buf.data := NetOut.Data;
1715 Buf.dataLength := NetOut.CurSize;
1716 enet_socket_send(NetPongSock, @ClAddr, @Buf, 1);
1718 NetOut.Clear();
1719 end;
1720 end;
1722 procedure g_Net_Host_CheckTimeouts();
1723 var
1724 ID: Integer;
1725 begin
1726 for ID := Low(NetClients) to High(NetClients) do
1727 begin
1728 with NetClients[ID] do
1729 begin
1730 if (Peer = nil) or (State = NET_STATE_NONE) then continue;
1731 if (State = NET_STATE_AUTH) and (AuthTime > 0) and (AuthTime <= gTime) then
1732 begin
1733 g_Net_Penalize(@NetClients[ID], 'auth taking too long');
1734 AuthTime := gTime + 1000; // do it every second to give them a chance
1735 end
1736 else if (State = NET_STATE_GAME) and (MsgTime > 0) and (MsgTime <= gTime) then
1737 begin
1738 // client hasn't sent packets in a while; either ban em or kick em
1739 if (NetAutoBanForTimeout) then
1740 begin
1741 g_Net_Penalize(@NetClients[ID], 'message timeout');
1742 MsgTime := gTime + (NetPacketTimeout div 2) + 500; // wait less for the next check
1743 end
1744 else
1745 begin
1746 e_LogWritefln('NET: client #%u (cid #%u) timed out', [ID, Player]);
1747 g_Net_Host_Disconnect_Client(ID, True);
1748 end;
1749 end;
1750 end;
1751 end;
1752 end;
1755 procedure g_Net_Host_Update();
1756 var
1757 IP: string;
1758 Port: Word;
1759 ID: Integer;
1760 TC: pTNetClient;
1761 begin
1762 IP := '';
1764 if NetUseMaster then g_Net_Slist_Pulse();
1765 g_Net_Host_CheckPings();
1766 g_Net_Host_CheckTimeouts();
1768 while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
1769 begin
1770 case (NetEvent.kind) of
1771 ENET_EVENT_TYPE_CONNECT:
1772 begin
1773 IP := IpToStr(NetEvent.Peer^.address.host);
1774 Port := NetEvent.Peer^.address.port;
1775 g_Console_Add(_lc[I_NET_MSG] +
1776 Format(_lc[I_NET_MSG_HOST_CONN], [IP, Port]));
1777 e_WriteLog('NET: Connection request from ' + IP + '.', TMsgType.Notify);
1779 if (NetEvent.data <> NET_PROTOCOL_VER) then
1780 begin
1781 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_REJECT] +
1782 _lc[I_NET_DISC_PROTOCOL]);
1783 e_WriteLog('NET: Connection request from ' + IP + ' rejected: version mismatch',
1784 TMsgType.Notify);
1785 NetEvent.peer^.data := GetMemory(SizeOf(Byte));
1786 Byte(NetEvent.peer^.data^) := 255;
1787 enet_peer_disconnect(NetEvent.peer, NET_DISC_PROTOCOL);
1788 enet_host_flush(NetHost);
1789 Exit;
1790 end;
1792 if g_Net_IsHostBanned(NetEvent.Peer^.address.host) then
1793 begin
1794 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_REJECT] +
1795 _lc[I_NET_DISC_BAN]);
1796 e_WriteLog('NET: Connection request from ' + IP + ' rejected: banned',
1797 TMsgType.Notify);
1798 NetEvent.peer^.data := GetMemory(SizeOf(Byte));
1799 Byte(NetEvent.peer^.data^) := 255;
1800 enet_peer_disconnect(NetEvent.Peer, NET_DISC_BAN);
1801 enet_host_flush(NetHost);
1802 Exit;
1803 end;
1805 ID := g_Net_FindSlot();
1807 if ID < 0 then
1808 begin
1809 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_REJECT] +
1810 _lc[I_NET_DISC_FULL]);
1811 e_WriteLog('NET: Connection request from ' + IP + ' rejected: server full',
1812 TMsgType.Notify);
1813 NetEvent.Peer^.data := GetMemory(SizeOf(Byte));
1814 Byte(NetEvent.peer^.data^) := 255;
1815 enet_peer_disconnect(NetEvent.peer, NET_DISC_FULL);
1816 enet_host_flush(NetHost);
1817 Exit;
1818 end;
1820 NetClients[ID].Peer := NetEvent.peer;
1821 NetClients[ID].Peer^.data := GetMemory(SizeOf(Byte));
1822 Byte(NetClients[ID].Peer^.data^) := ID;
1823 NetClients[ID].State := NET_STATE_AUTH;
1824 NetClients[ID].Player := 0;
1825 NetClients[ID].Crimes := 0;
1826 NetClients[ID].RCONAuth := False;
1827 NetClients[ID].NetOut[NET_UNRELIABLE].Alloc(NET_BUFSIZE*2);
1828 NetClients[ID].NetOut[NET_RELIABLE].Alloc(NET_BUFSIZE*2);
1829 if (NetAuthTimeout > 0) then
1830 NetClients[ID].AuthTime := gTime + NetAuthTimeout
1831 else
1832 NetClients[ID].AuthTime := 0;
1833 if (NetPacketTimeout > 0) then
1834 NetClients[ID].MsgTime := gTime + NetPacketTimeout
1835 else
1836 NetClients[ID].MsgTime := 0;
1837 clearNetClientTransfers(NetClients[ID]); // just in case
1839 enet_peer_timeout(NetEvent.peer, ENET_PEER_TIMEOUT_LIMIT * 2, ENET_PEER_TIMEOUT_MINIMUM * 2, ENET_PEER_TIMEOUT_MAXIMUM * 2);
1841 Inc(NetClientCount);
1842 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST_ADD], [ID]));
1843 end;
1845 ENET_EVENT_TYPE_RECEIVE:
1846 begin
1847 //e_LogWritefln('RECEIVE: chan=%u', [NetEvent.channelID]);
1848 if (NetEvent.channelID = NET_CHAN_DOWNLOAD_EX) then
1849 begin
1850 ProcessDownloadExPacket();
1851 end
1852 else
1853 begin
1854 ID := Byte(NetEvent.peer^.data^);
1855 if ID > High(NetClients) then Exit;
1856 TC := @NetClients[ID];
1858 if (NetPacketTimeout > 0) then
1859 TC^.MsgTime := gTime + NetPacketTimeout;
1861 if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
1862 g_Net_Host_HandlePacket(TC, NetEvent.packet, g_Net_HostMsgHandler);
1863 end;
1864 end;
1866 ENET_EVENT_TYPE_DISCONNECT:
1867 begin
1868 ID := Byte(NetEvent.peer^.data^);
1869 if ID > High(NetClients) then Exit;
1870 g_Net_Host_Disconnect_Client(ID);
1871 end;
1872 end;
1873 end;
1874 end;
1877 //**************************************************************************
1878 //
1879 // CLIENT FUNCTIONS
1880 //
1881 //**************************************************************************
1883 procedure g_Net_Disconnect(Forced: Boolean = False);
1884 begin
1885 if NetMode <> NET_CLIENT then Exit;
1886 if (NetHost = nil) or (NetPeer = nil) then Exit;
1888 if not Forced then
1889 begin
1890 enet_peer_disconnect(NetPeer, NET_DISC_NONE);
1892 while (enet_host_service(NetHost, @NetEvent, 1500) > 0) do
1893 begin
1894 if (NetEvent.kind = ENET_EVENT_TYPE_DISCONNECT) then
1895 begin
1896 NetPeer := nil;
1897 break;
1898 end;
1900 if (NetEvent.kind = ENET_EVENT_TYPE_RECEIVE) then
1901 enet_packet_destroy(NetEvent.packet);
1902 end;
1904 if NetPeer <> nil then
1905 begin
1906 enet_peer_reset(NetPeer);
1907 NetPeer := nil;
1908 end;
1909 end
1910 else
1911 begin
1912 e_WriteLog('NET: Kicked from server: ' + IntToStr(NetEvent.data), TMsgType.Notify);
1913 if (NetEvent.data <= NET_DISC_MAX) then
1914 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_KICK] +
1915 _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + NetEvent.data)], True);
1916 end;
1918 if NetHost <> nil then
1919 begin
1920 enet_host_destroy(NetHost);
1921 NetHost := nil;
1922 end;
1923 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_CLIENT_DISC]);
1925 g_Net_Cleanup;
1926 e_WriteLog('NET: Disconnected', TMsgType.Notify);
1927 end;
1929 procedure g_Net_Client_Send(Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
1930 var
1931 T: Integer;
1932 begin
1933 if (Reliable) then
1934 T := NET_RELIABLE
1935 else
1936 T := NET_UNRELIABLE;
1938 // write size first
1939 NetBuf[T].Write(Integer(NetOut.CurSize));
1940 NetBuf[T].Write(NetOut);
1942 if NetDump then g_Net_DumpSendBuffer();
1943 NetOut.Clear();
1944 g_Net_Flush(); // FIXME: for now, send immediately
1945 end;
1947 procedure g_Net_Client_Update();
1948 begin
1949 while (NetHost <> nil) and (enet_host_service(NetHost, @NetEvent, 0) > 0) do
1950 begin
1951 case NetEvent.kind of
1952 ENET_EVENT_TYPE_RECEIVE:
1953 begin
1954 if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
1955 g_Net_Client_HandlePacket(NetEvent.packet, g_Net_ClientMsgHandler);
1956 end;
1958 ENET_EVENT_TYPE_DISCONNECT:
1959 begin
1960 g_Net_Disconnect(True);
1961 Exit;
1962 end;
1963 end;
1964 end
1965 end;
1967 function g_Net_Connect(IP: string; Port: enet_uint16): Boolean;
1968 var
1969 OuterLoop: Boolean;
1970 TimeoutTime, T: Int64;
1971 begin
1972 if NetMode <> NET_NONE then
1973 begin
1974 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_ERR_INGAME], True);
1975 Result := False;
1976 Exit;
1977 end;
1979 Result := True;
1981 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_CLIENT_CONN],
1982 [IP, Port]));
1983 if not NetInitDone then
1984 begin
1985 if (not g_Net_Init()) then
1986 begin
1987 g_Console_Add(_lc[I_NET_MSG_FERROR] + _lc[I_NET_ERR_ENET], True);
1988 Result := False;
1989 Exit;
1990 end
1991 else
1992 NetInitDone := True;
1993 end;
1995 NetHost := enet_host_create(nil, 1, NET_CHANS, 0, 0);
1997 if (NetHost = nil) then
1998 begin
1999 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT], True);
2000 g_Net_Cleanup;
2001 Result := False;
2002 Exit;
2003 end;
2005 enet_address_set_host(@NetAddr, PChar(Addr(IP[1])));
2006 NetAddr.port := Port;
2008 NetPeer := enet_host_connect(NetHost, @NetAddr, NET_CHANS, NET_PROTOCOL_VER);
2010 if (NetPeer = nil) then
2011 begin
2012 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT], True);
2013 enet_host_destroy(NetHost);
2014 g_Net_Cleanup;
2015 Result := False;
2016 Exit;
2017 end;
2019 // предупредить что ждем слишком долго через N секунд
2020 TimeoutTime := sys_GetTicks() + NET_CONNECT_TIMEOUT;
2022 OuterLoop := True;
2023 while OuterLoop do
2024 begin
2025 while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
2026 begin
2027 if (NetEvent.kind = ENET_EVENT_TYPE_CONNECT) then
2028 begin
2029 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_CLIENT_DONE]);
2030 NetMode := NET_CLIENT;
2031 NetOut.Clear();
2032 enet_peer_timeout(NetPeer, ENET_PEER_TIMEOUT_LIMIT * 2, ENET_PEER_TIMEOUT_MINIMUM * 2, ENET_PEER_TIMEOUT_MAXIMUM * 2);
2033 NetClientIP := IP;
2034 NetClientPort := Port;
2035 if NetDump then
2036 g_Net_DumpStart();
2037 Exit;
2038 end;
2039 end;
2041 T := sys_GetTicks();
2042 if T > TimeoutTime then
2043 begin
2044 TimeoutTime := T + NET_CONNECT_TIMEOUT * 100; // одного предупреждения хватит
2045 g_Console_Add(_lc[I_NET_MSG_TIMEOUT_WARN], True);
2046 g_Console_Add(Format(_lc[I_NET_MSG_PORTS], [Integer(Port), Integer(NET_PING_PORT)]), True);
2047 end;
2049 ProcessLoading(True);
2050 if e_KeyPressed(IK_SPACE) or e_KeyPressed(IK_ESCAPE) or e_KeyPressed(VK_ESCAPE) or
2051 e_KeyPressed(JOY0_JUMP) or e_KeyPressed(JOY1_JUMP) or e_KeyPressed(JOY2_JUMP) or e_KeyPressed(JOY3_JUMP) then
2052 OuterLoop := False;
2053 end;
2055 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_TIMEOUT], True);
2056 g_Console_Add(Format(_lc[I_NET_MSG_PORTS], [Integer(Port), Integer(NET_PING_PORT)]), True);
2057 if NetPeer <> nil then enet_peer_reset(NetPeer);
2058 if NetHost <> nil then
2059 begin
2060 enet_host_destroy(NetHost);
2061 NetHost := nil;
2062 end;
2063 g_Net_Cleanup();
2064 Result := False;
2065 end;
2067 function IpToStr(IP: LongWord): string;
2068 var
2069 Ptr: Pointer;
2070 begin
2071 Ptr := Addr(IP);
2072 Result := IntToStr(PByte(Ptr + 0)^) + '.';
2073 Result := Result + IntToStr(PByte(Ptr + 1)^) + '.';
2074 Result := Result + IntToStr(PByte(Ptr + 2)^) + '.';
2075 Result := Result + IntToStr(PByte(Ptr + 3)^);
2076 end;
2078 function StrToIp(IPstr: string; var IP: LongWord): Boolean;
2079 var
2080 EAddr: ENetAddress;
2081 begin
2082 Result := enet_address_set_host(@EAddr, PChar(@IPstr[1])) = 0;
2083 IP := EAddr.host;
2084 end;
2086 function g_Net_Client_ByName(Name: string): pTNetClient;
2087 var
2088 a: Integer;
2089 pl: TPlayer;
2090 begin
2091 Result := nil;
2092 for a := Low(NetClients) to High(NetClients) do
2093 if (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
2094 begin
2095 pl := g_Player_Get(NetClients[a].Player);
2096 if pl = nil then continue;
2097 if Copy(LowerCase(pl.Name), 1, Length(Name)) <> LowerCase(Name) then continue;
2098 if NetClients[a].Peer <> nil then
2099 begin
2100 Result := @NetClients[a];
2101 Exit;
2102 end;
2103 end;
2104 end;
2106 function g_Net_Client_ByPlayer(PID: Word): pTNetClient;
2107 var
2108 a: Integer;
2109 begin
2110 Result := nil;
2111 for a := Low(NetClients) to High(NetClients) do
2112 if (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
2113 if NetClients[a].Player = PID then
2114 begin
2115 Result := @NetClients[a];
2116 Exit;
2117 end;
2118 end;
2120 function g_Net_ClientName_ByID(ID: Integer): string;
2121 var
2122 a: Integer;
2123 pl: TPlayer;
2124 begin
2125 Result := '';
2126 if ID = NET_EVERYONE then
2127 Exit;
2128 for a := Low(NetClients) to High(NetClients) do
2129 if (NetClients[a].ID = ID) and (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
2130 begin
2131 pl := g_Player_Get(NetClients[a].Player);
2132 if pl = nil then Exit;
2133 Result := pl.Name;
2134 end;
2135 end;
2137 procedure g_Net_SendData(Data: AByte; peer: pENetPeer; Reliable: Boolean; Chan: Byte = NET_CHAN_DOWNLOAD);
2138 var
2139 P: pENetPacket;
2140 F: enet_uint32;
2141 dataLength: Cardinal;
2142 begin
2143 dataLength := Length(Data);
2145 if Reliable
2146 then F := LongWord(ENET_PACKET_FLAG_RELIABLE)
2147 else F := 0;
2149 P := enet_packet_create(@Data[0], dataLength, F);
2150 if not Assigned(P) then exit;
2152 if peer <> nil
2153 then enet_peer_send(peer, Chan, P)
2154 else enet_host_broadcast(NetHost, Chan, P);
2156 enet_host_flush(NetHost);
2157 end;
2159 function g_Net_IsHostBanned(IP: LongWord; Perm: Boolean = False): Boolean;
2160 var
2161 I: Integer;
2162 begin
2163 Result := False;
2164 if NetBannedHosts = nil then
2165 Exit;
2166 for I := 0 to High(NetBannedHosts) do
2167 if (NetBannedHosts[I].IP = IP) and ((not Perm) or (NetBannedHosts[I].Perm)) then
2168 begin
2169 Result := True;
2170 break;
2171 end;
2172 end;
2174 procedure g_Net_BanHost(IP: LongWord; Perm: Boolean = True); overload;
2175 var
2176 I, P: Integer;
2177 begin
2178 if IP = 0 then
2179 Exit;
2180 if g_Net_IsHostBanned(IP, Perm) then
2181 Exit;
2183 P := -1;
2184 for I := Low(NetBannedHosts) to High(NetBannedHosts) do
2185 if NetBannedHosts[I].IP = 0 then
2186 begin
2187 P := I;
2188 break;
2189 end;
2191 if P < 0 then
2192 begin
2193 SetLength(NetBannedHosts, Length(NetBannedHosts) + 1);
2194 P := High(NetBannedHosts);
2195 end;
2197 NetBannedHosts[P].IP := IP;
2198 NetBannedHosts[P].Perm := Perm;
2199 end;
2201 procedure g_Net_BanHost(IP: string; Perm: Boolean = True); overload;
2202 var
2203 a: LongWord;
2204 b: Boolean;
2205 begin
2206 b := StrToIp(IP, a);
2207 if b then
2208 g_Net_BanHost(a, Perm);
2209 end;
2211 procedure g_Net_UnbanNonPermHosts();
2212 var
2213 I: Integer;
2214 begin
2215 if NetBannedHosts = nil then
2216 Exit;
2217 for I := Low(NetBannedHosts) to High(NetBannedHosts) do
2218 if (NetBannedHosts[I].IP > 0) and not NetBannedHosts[I].Perm then
2219 begin
2220 NetBannedHosts[I].IP := 0;
2221 NetBannedHosts[I].Perm := True;
2222 end;
2223 end;
2225 function g_Net_UnbanHost(IP: string): Boolean; overload;
2226 var
2227 a: LongWord;
2228 begin
2229 Result := StrToIp(IP, a);
2230 if Result then
2231 Result := g_Net_UnbanHost(a);
2232 end;
2234 function g_Net_UnbanHost(IP: LongWord): Boolean; overload;
2235 var
2236 I: Integer;
2237 begin
2238 Result := False;
2239 if IP = 0 then
2240 Exit;
2241 if NetBannedHosts = nil then
2242 Exit;
2243 for I := 0 to High(NetBannedHosts) do
2244 if NetBannedHosts[I].IP = IP then
2245 begin
2246 NetBannedHosts[I].IP := 0;
2247 NetBannedHosts[I].Perm := True;
2248 Result := True;
2249 // no break here to clear all bans of this host, perm and non-perm
2250 end;
2251 end;
2253 procedure g_Net_SaveBanList();
2254 var
2255 F: TextFile;
2256 I: Integer;
2257 path: AnsiString;
2258 begin
2259 path := e_GetWriteableDir(DataDirs);
2260 if path <> '' then
2261 begin
2262 path := e_CatPath(path, BANLIST_FILENAME);
2263 Assign(F, path);
2264 Rewrite(F);
2265 if NetBannedHosts <> nil then
2266 for I := 0 to High(NetBannedHosts) do
2267 if NetBannedHosts[I].Perm and (NetBannedHosts[I].IP > 0) then
2268 Writeln(F, IpToStr(NetBannedHosts[I].IP));
2269 CloseFile(F)
2270 end
2271 end;
2273 procedure g_Net_Penalize(C: pTNetClient; Reason: string);
2274 var
2275 s: string;
2276 begin
2277 e_LogWritefln('NET: client #%u (cid #%u) triggered a penalty (%d/%d): %s',
2278 [C^.ID, C^.Player, C^.Crimes + 1, NetAutoBanLimit, Reason]);
2280 if (NetAutoBanLimit <= 0) then Exit;
2282 if (C^.Crimes >= NetAutoBanLimit) then
2283 begin
2284 // we have tried asking nicely before, now it is time to die
2285 e_LogWritefln('NET: client #%u (cid #%u) force kicked',
2286 [C^.ID, C^.Player]);
2287 g_Net_Host_Disconnect_Client(C^.ID, True);
2288 Exit;
2289 end;
2291 Inc(C^.Crimes);
2293 if (NetAutoBanWarn) then
2294 MH_SEND_Chat('You have been warned by the server: ' + Reason, NET_CHAT_SYSTEM, C^.ID);
2296 if (C^.Crimes >= NetAutoBanLimit) then
2297 begin
2298 s := '#' + IntToStr(C^.ID); // can't be arsed
2299 g_Net_BanHost(C^.Peer^.address.host, NetAutoBanPerm);
2300 enet_peer_disconnect(C^.Peer, NET_DISC_BAN);
2301 g_Console_Add(Format(_lc[I_PLAYER_BAN], [s]));
2302 MH_SEND_GameEvent(NET_EV_PLAYER_BAN, 0, s);
2303 g_Net_Slist_ServerPlayerLeaves();
2304 end;
2305 end;
2307 procedure g_Net_DumpStart();
2308 begin
2309 if NetMode = NET_SERVER then
2310 NetDumpFile := e_CreateResource(LogDirs, NETDUMP_FILENAME + '_server')
2311 else
2312 NetDumpFile := e_CreateResource(LogDirs, NETDUMP_FILENAME + '_client');
2313 end;
2315 procedure g_Net_DumpSendBuffer();
2316 begin
2317 writeInt(NetDumpFile, gTime);
2318 writeInt(NetDumpFile, LongWord(NetOut.CurSize));
2319 writeInt(NetDumpFile, Byte(1));
2320 NetDumpFile.WriteBuffer(NetOut.Data^, NetOut.CurSize);
2321 end;
2323 procedure g_Net_DumpRecvBuffer(Buf: penet_uint8; Len: LongWord);
2324 begin
2325 if (Buf = nil) or (Len = 0) then Exit;
2326 writeInt(NetDumpFile, gTime);
2327 writeInt(NetDumpFile, Len);
2328 writeInt(NetDumpFile, Byte(0));
2329 NetDumpFile.WriteBuffer(Buf^, Len);
2330 end;
2332 procedure g_Net_DumpEnd();
2333 begin
2334 NetDumpFile.Free();
2335 NetDumpFile := nil;
2336 end;
2338 function g_Net_ForwardPorts(ForwardPongPort: Boolean = True): Boolean;
2339 {$IFDEF USE_MINIUPNPC}
2340 var
2341 DevList: PUPNPDev;
2342 Urls: TUPNPUrls;
2343 Data: TIGDDatas;
2344 LanAddr: array [0..255] of Char;
2345 StrPort: AnsiString;
2346 Err, I: Integer;
2347 begin
2348 Result := False;
2350 if NetHost = nil then
2351 exit;
2353 if NetPortForwarded = NetHost.address.port then
2354 begin
2355 Result := True;
2356 exit;
2357 end;
2359 NetPongForwarded := False;
2360 NetPortForwarded := 0;
2362 DevList := upnpDiscover(1000, nil, nil, 0, 0, 2, Addr(Err));
2363 if DevList = nil then
2364 begin
2365 conwritefln('port forwarding failed: upnpDiscover() failed: %d', [Err]);
2366 exit;
2367 end;
2369 I := UPNP_GetValidIGD(DevList, @Urls, @Data, Addr(LanAddr[0]), 256);
2371 if I = 0 then
2372 begin
2373 conwriteln('port forwarding failed: could not find an IGD device on this LAN');
2374 FreeUPNPDevList(DevList);
2375 FreeUPNPUrls(@Urls);
2376 exit;
2377 end;
2379 StrPort := IntToStr(NetHost.address.port);
2380 I := UPNP_AddPortMapping(
2381 Urls.controlURL, Addr(data.first.servicetype[1]),
2382 PChar(StrPort), PChar(StrPort), Addr(LanAddr[0]), PChar('D2DF'),
2383 PChar('UDP'), nil, PChar('0')
2384 );
2386 if I <> 0 then
2387 begin
2388 conwritefln('forwarding port %d failed: error %d', [NetHost.address.port, I]);
2389 FreeUPNPDevList(DevList);
2390 FreeUPNPUrls(@Urls);
2391 exit;
2392 end;
2394 if ForwardPongPort then
2395 begin
2396 StrPort := IntToStr(NET_PING_PORT);
2397 I := UPNP_AddPortMapping(
2398 Urls.controlURL, Addr(data.first.servicetype[1]),
2399 PChar(StrPort), PChar(StrPort), Addr(LanAddr[0]), PChar('D2DF'),
2400 PChar('UDP'), nil, PChar('0')
2401 );
2403 if I <> 0 then
2404 begin
2405 conwritefln('forwarding port %d failed: error %d', [NET_PING_PORT, I]);
2406 NetPongForwarded := False;
2407 end
2408 else
2409 begin
2410 conwritefln('forwarded port %d successfully', [NET_PING_PORT]);
2411 NetPongForwarded := True;
2412 end;
2413 end;
2415 conwritefln('forwarded port %d successfully', [NetHost.address.port]);
2416 NetIGDControl := AnsiString(Urls.controlURL);
2417 NetIGDService := data.first.servicetype;
2418 NetPortForwarded := NetHost.address.port;
2420 FreeUPNPDevList(DevList);
2421 FreeUPNPUrls(@Urls);
2422 Result := True;
2423 end;
2424 {$ELSE}
2425 begin
2426 Result := False;
2427 end;
2428 {$ENDIF}
2430 procedure g_Net_UnforwardPorts();
2431 {$IFDEF USE_MINIUPNPC}
2432 var
2433 I: Integer;
2434 StrPort: AnsiString;
2435 begin
2436 if NetPortForwarded = 0 then Exit;
2438 conwriteln('unforwarding ports...');
2440 StrPort := IntToStr(NetPortForwarded);
2441 I := UPNP_DeletePortMapping(
2442 PChar(NetIGDControl), Addr(NetIGDService[1]),
2443 PChar(StrPort), PChar('UDP'), nil
2444 );
2445 conwritefln(' port %d: %d', [NetPortForwarded, I]);
2447 if NetPongForwarded then
2448 begin
2449 NetPongForwarded := False;
2450 StrPort := IntToStr(NET_PING_PORT);
2451 I := UPNP_DeletePortMapping(
2452 PChar(NetIGDControl), Addr(NetIGDService[1]),
2453 PChar(StrPort), PChar('UDP'), nil
2454 );
2455 conwritefln(' port %d: %d', [NET_PING_PORT, I]);
2456 end;
2458 NetPortForwarded := 0;
2459 end;
2460 {$ELSE}
2461 begin
2462 end;
2463 {$ENDIF}
2465 procedure NetServerCVars(P: SSArray);
2466 var
2467 cmd, s: string;
2468 a, b: Integer;
2469 begin
2470 cmd := LowerCase(P[0]);
2471 case cmd of
2472 'sv_name':
2473 begin
2474 if (Length(P) > 1) and (Length(P[1]) > 0) then
2475 begin
2476 NetServerName := P[1];
2477 if Length(NetServerName) > 64 then
2478 SetLength(NetServerName, 64);
2479 g_Net_Slist_ServerRenamed();
2480 end;
2481 g_Console_Add(cmd + ' "' + NetServerName + '"');
2482 end;
2483 'sv_passwd':
2484 begin
2485 if (Length(P) > 1) and (Length(P[1]) > 0) then
2486 begin
2487 NetPassword := P[1];
2488 if Length(NetPassword) > 24 then
2489 SetLength(NetPassword, 24);
2490 g_Net_Slist_ServerRenamed();
2491 end;
2492 g_Console_Add(cmd + ' "' + AnsiLowerCase(NetPassword) + '"');
2493 end;
2494 'sv_maxplrs':
2495 begin
2496 if (Length(P) > 1) then
2497 begin
2498 NetMaxClients := nclamp(StrToIntDef(P[1], NetMaxClients), 1, NET_MAXCLIENTS);
2499 if g_Game_IsServer and g_Game_IsNet then
2500 begin
2501 b := 0;
2502 for a := 0 to High(NetClients) do
2503 begin
2504 if NetClients[a].Used then
2505 begin
2506 Inc(b);
2507 if b > NetMaxClients then
2508 begin
2509 s := g_Player_Get(NetClients[a].Player).Name;
2510 enet_peer_disconnect(NetClients[a].Peer, NET_DISC_FULL);
2511 g_Console_Add(Format(_lc[I_PLAYER_KICK], [s]));
2512 MH_SEND_GameEvent(NET_EV_PLAYER_KICK, 0, s);
2513 end;
2514 end;
2515 end;
2516 g_Net_Slist_ServerRenamed();
2517 end;
2518 end;
2519 g_Console_Add(cmd + ' ' + IntToStr(NetMaxClients));
2520 end;
2521 'sv_public':
2522 begin
2523 if (Length(P) > 1) then
2524 begin
2525 NetUseMaster := StrToIntDef(P[1], Byte(NetUseMaster)) <> 0;
2526 if NetUseMaster then g_Net_Slist_Public() else g_Net_Slist_Private();
2527 end;
2528 g_Console_Add(cmd + ' ' + IntToStr(Byte(NetUseMaster)));
2529 end;
2530 'sv_port':
2531 begin
2532 if (Length(P) > 1) then
2533 begin
2534 if not g_Game_IsNet then
2535 NetPort := nclamp(StrToIntDef(P[1], NetPort), 0, $FFFF)
2536 else
2537 g_Console_Add(_lc[I_MSG_NOT_NETGAME]);
2538 end;
2539 g_Console_Add(cmd + ' ' + IntToStr(Ord(NetUseMaster)));
2540 end;
2541 end;
2542 end;
2544 initialization
2545 conRegVar('cl_downloadtimeout', @g_Net_DownloadTimeout, 0.0, 1000000.0, '', 'timeout in seconds, 0 to disable it');
2546 conRegVar('cl_predictself', @NetPredictSelf, '', 'predict local player');
2547 conRegVar('cl_forceplayerupdate', @NetForcePlayerUpdate, '', 'update net players on NET_MSG_PLRPOS');
2548 conRegVar('cl_interp', @NetInterpLevel, '', 'net player interpolation steps');
2549 conRegVar('cl_last_ip', @NetClientIP, '', 'address of the last you have connected to');
2550 conRegVar('cl_last_port', @NetClientPort, '', 'port of the last server you have connected to');
2551 conRegVar('cl_deafen', @NetDeafLevel, '', 'filter server messages (0-3)');
2553 conRegVar('sv_forwardports', @NetForwardPorts, '', 'forward server port using miniupnpc (requires server restart)');
2554 conRegVar('sv_rcon', @NetAllowRCON, '', 'enable remote console');
2555 conRegVar('sv_rcon_password', @NetRCONPassword, '', 'remote console password');
2556 conRegVar('sv_update_interval', @NetUpdateRate, '', 'unreliable update interval');
2557 conRegVar('sv_reliable_interval', @NetRelupdRate, '', 'reliable update interval');
2558 conRegVar('sv_master_interval', @NetMasterRate, '', 'master server update interval');
2560 conRegVar('sv_autoban_threshold', @NetAutoBanLimit, '', 'max crimes before autoban (0 = no autoban)');
2561 conRegVar('sv_autoban_permanent', @NetAutoBanPerm, '', 'whether autobans are permanent');
2562 conRegVar('sv_autoban_warn', @NetAutoBanWarn, '', 'send warnings to the client when he triggers penalties');
2563 conRegVar('sv_autoban_packet_timeout', @NetAutoBanForTimeout, '', 'autoban for packet timeouts');
2565 conRegVar('sv_auth_timeout', @NetAuthTimeout, '', 'number of msec in which connecting clients must complete auth (0 = unlimited)');
2566 conRegVar('sv_packet_timeout', @NetPacketTimeout, '', 'number of msec the client must idle to be kicked (0 = unlimited)');
2568 conRegVar('net_master_list', @NetMasterList, '', 'list of master servers');
2570 SetLength(NetClients, 0);
2571 g_Net_DownloadTimeout := 60;
2572 NetIn.Alloc(NET_BUFSIZE);
2573 NetOut.Alloc(NET_BUFSIZE);
2574 NetBuf[NET_UNRELIABLE].Alloc(NET_BUFSIZE*2);
2575 NetBuf[NET_RELIABLE].Alloc(NET_BUFSIZE*2);
2576 trans_omsg.Alloc(NET_BUFSIZE);
2577 finalization
2578 NetIn.Free();
2579 NetOut.Free();
2580 NetBuf[NET_UNRELIABLE].Free();
2581 NetBuf[NET_RELIABLE].Free();
2582 end.