DEADSOFTWARE

fpc322: fix segfault on arm
[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 = 186;
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 RCONAuth: Boolean;
107 Voted: Boolean;
108 Transfer: TNetFileTransfer; // only one transfer may be active
109 NetOut: array [0..1] of TMsg;
110 end;
111 TBanRecord = record
112 IP: LongWord;
113 Perm: Boolean;
114 end;
115 pTNetClient = ^TNetClient;
117 AByte = array of Byte;
119 var
120 NetInitDone: Boolean = False;
121 NetMode: Byte = NET_NONE;
122 NetDump: Boolean = False;
124 NetServerName: string = 'Unnamed Server';
125 NetPassword: string = '';
126 NetPort: Word = 25666;
128 NetAllowRCON: Boolean = False;
129 NetRCONPassword: string = '';
131 NetTimeToUpdate: Cardinal = 0;
132 NetTimeToReliable: Cardinal = 0;
133 NetTimeToMaster: Cardinal = 0;
135 NetHost: pENetHost = nil;
136 NetPeer: pENetPeer = nil;
137 NetEvent: ENetEvent;
138 NetAddr: ENetAddress;
140 NetPongAddr: ENetAddress;
141 NetPongSock: ENetSocket = ENET_SOCKET_NULL;
143 NetUseMaster: Boolean = True;
144 NetMasterList: string = 'mpms.doom2d.org:25665, deadsoftware.ru:25665';
146 NetClientIP: string = '127.0.0.1';
147 NetClientPort: Word = 25666;
149 NetIn, NetOut: TMsg;
150 NetBuf: array [0..1] of TMsg;
152 NetClients: array of TNetClient;
153 NetClientCount: Byte = 0;
154 NetMaxClients: Byte = 255;
155 NetBannedHosts: array of TBanRecord;
157 NetState: Integer = NET_STATE_NONE;
159 NetMyID: Integer = -1;
160 NetPlrUID1: Integer = -1;
161 NetPlrUID2: Integer = -1;
163 NetInterpLevel: Integer = 1;
164 NetUpdateRate: Cardinal = 0; // as soon as possible
165 NetRelupdRate: Cardinal = 18; // around two times a second
166 NetMasterRate: Cardinal = 60000;
168 NetForcePlayerUpdate: Boolean = False;
169 NetPredictSelf: Boolean = True;
170 NetForwardPorts: Boolean = False;
172 NetGotEverything: Boolean = False;
173 NetGotKeys: Boolean = False;
175 NetDeafLevel: Integer = 0;
177 {$IFDEF USE_MINIUPNPC}
178 NetPortForwarded: Word = 0;
179 NetPongForwarded: Boolean = False;
180 NetIGDControl: AnsiString;
181 NetIGDService: TURLStr;
182 {$ENDIF}
184 NetPortThread: TThreadID = NilThreadId;
186 NetDumpFile: TStream;
188 g_Res_received_map_start: Integer = 0; // set if we received "map change" event
191 function g_Net_Init(): Boolean;
192 procedure g_Net_Cleanup();
193 procedure g_Net_Free();
194 procedure g_Net_Flush();
196 function g_Net_Host(IPAddr: LongWord; Port: enet_uint16; MaxClients: Cardinal = 16): Boolean;
197 procedure g_Net_Host_Die();
198 procedure g_Net_Host_Send(ID: Integer; Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
199 function g_Net_Host_Update(): enet_size_t;
201 function g_Net_Connect(IP: string; Port: enet_uint16): Boolean;
202 procedure g_Net_Disconnect(Forced: Boolean = False);
203 procedure g_Net_Client_Send(Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
204 function g_Net_Client_Update(): enet_size_t;
205 function g_Net_Client_UpdateWhileLoading(): enet_size_t;
207 function g_Net_Client_ByName(Name: string): pTNetClient;
208 function g_Net_Client_ByPlayer(PID: Word): pTNetClient;
209 function g_Net_ClientName_ByID(ID: Integer): string;
211 procedure g_Net_SendData(Data: AByte; peer: pENetPeer; Reliable: Boolean; Chan: Byte = NET_CHAN_DOWNLOAD);
212 //function g_Net_Wait_Event(msgId: Word): TMemoryStream;
213 //function g_Net_Wait_FileInfo (var tf: TNetFileTransfer; asMap: Boolean; out resList: TStringList): Integer;
215 function IpToStr(IP: LongWord): string;
216 function StrToIp(IPstr: string; var IP: LongWord): Boolean;
218 function g_Net_IsHostBanned(IP: LongWord; Perm: Boolean = False): Boolean;
219 procedure g_Net_BanHost(IP: LongWord; Perm: Boolean = True); overload;
220 procedure g_Net_BanHost(IP: string; Perm: Boolean = True); overload;
221 function g_Net_UnbanHost(IP: string): Boolean; overload;
222 function g_Net_UnbanHost(IP: LongWord): Boolean; overload;
223 procedure g_Net_UnbanNonPermHosts();
224 procedure g_Net_SaveBanList();
226 procedure g_Net_DumpStart();
227 procedure g_Net_DumpSendBuffer();
228 procedure g_Net_DumpRecvBuffer(Buf: penet_uint8; Len: LongWord);
229 procedure g_Net_DumpEnd();
231 function g_Net_ForwardPorts(ForwardPongPort: Boolean = True): Boolean;
232 procedure g_Net_UnforwardPorts();
234 function g_Net_UserRequestExit: Boolean;
236 function g_Net_Wait_MapInfo (var tf: TNetFileTransfer; var resList: TNetMapResourceInfoArray): Integer;
237 function g_Net_RequestResFileInfo (resIndex: LongInt; out tf: TNetFileTransfer): Integer;
238 function g_Net_AbortResTransfer (var tf: TNetFileTransfer): Boolean;
239 function g_Net_ReceiveResourceFile (resIndex: LongInt; var tf: TNetFileTransfer; strm: TStream): Integer;
241 function g_Net_IsNetworkAvailable (): Boolean;
242 procedure g_Net_InitLowLevel ();
243 procedure g_Net_DeinitLowLevel ();
245 procedure NetServerCVars(P: SSArray);
248 implementation
250 // *enet_host_service()*
251 // fuck! https://www.mail-archive.com/enet-discuss@cubik.org/msg00852.html
252 // tl;dr: on shitdows, we can get -1 sometimes, and it is *NOT* a failure.
253 // thank you, enet. let's ignore failures altogether then.
255 uses
256 SysUtils,
257 e_input, e_res,
258 g_nethandler, g_netmsg, g_netmaster, g_player, g_window, g_console,
259 g_main, g_game, g_language, g_weapons, ctypes, g_system, g_map;
261 const
262 FILE_CHUNK_SIZE = 8192;
264 var
265 enet_init_success: Boolean = false;
266 g_Net_DownloadTimeout: Single;
267 trans_omsg: TMsg;
270 function g_Net_IsNetworkAvailable (): Boolean;
271 begin
272 result := enet_init_success;
273 end;
275 procedure g_Net_InitLowLevel ();
276 var v: ENetVersion;
277 begin
278 v := enet_linked_version();
279 e_LogWritefln('ENet Version: %s.%s.%s', [ENET_VERSION_GET_MAJOR(v), ENET_VERSION_GET_MINOR(v), ENET_VERSION_GET_PATCH(v)]);
280 if enet_init_success then raise Exception.Create('wuta?!');
281 enet_init_success := (enet_initialize() = 0);
282 end;
284 procedure g_Net_DeinitLowLevel ();
285 begin
286 if enet_init_success then
287 begin
288 enet_deinitialize();
289 enet_init_success := false;
290 end;
291 end;
294 //**************************************************************************
295 //
296 // SERVICE FUNCTIONS
297 //
298 //**************************************************************************
300 procedure clearNetClientTransfers (var nc: TNetClient);
301 begin
302 nc.Transfer.stream.Free;
303 nc.Transfer.diskName := ''; // just in case
304 if (nc.Transfer.diskBuffer <> nil) then FreeMem(nc.Transfer.diskBuffer);
305 nc.Transfer.stream := nil;
306 nc.Transfer.diskBuffer := nil;
307 end;
310 procedure clearNetClient (var nc: TNetClient);
311 begin
312 clearNetClientTransfers(nc);
313 end;
316 procedure clearNetClients (clearArray: Boolean);
317 var
318 f: Integer;
319 begin
320 for f := Low(NetClients) to High(NetClients) do clearNetClient(NetClients[f]);
321 if (clearArray) then SetLength(NetClients, 0);
322 end;
325 function g_Net_UserRequestExit (): Boolean;
326 begin
327 Result := {e_KeyPressed(IK_SPACE) or}
328 e_KeyPressed(IK_ESCAPE) or
329 e_KeyPressed(VK_ESCAPE) or
330 e_KeyPressed(JOY0_JUMP) or
331 e_KeyPressed(JOY1_JUMP) or
332 e_KeyPressed(JOY2_JUMP) or
333 e_KeyPressed(JOY3_JUMP)
334 end;
337 //**************************************************************************
338 //
339 // file transfer declaraions and host packet processor
340 //
341 //**************************************************************************
343 const
344 // server packet type
345 NTF_SERVER_DONE = 10; // done with this file
346 NTF_SERVER_FILE_INFO = 11; // sent after client request
347 NTF_SERVER_CHUNK = 12; // next chunk; chunk number follows
348 NTF_SERVER_ABORT = 13; // server abort
349 NTF_SERVER_MAP_INFO = 14;
351 // client packet type
352 NTF_CLIENT_MAP_REQUEST = 100; // map file request; also, returns list of additional wads to download
353 NTF_CLIENT_FILE_REQUEST = 101; // resource file request (by index)
354 NTF_CLIENT_ABORT = 102; // do not send requested file, or abort current transfer
355 NTF_CLIENT_START = 103; // start transfer; client may resume download by sending non-zero starting chunk
356 NTF_CLIENT_ACK = 104; // chunk ack; chunk number follows
359 // disconnect client due to some file transfer error
360 procedure killClientByFT (var nc: TNetClient);
361 begin
362 e_LogWritefln('disconnected client #%d due to file transfer error', [nc.ID], TMsgType.Warning);
363 enet_peer_disconnect(nc.Peer, NET_DISC_FILE_TIMEOUT);
364 clearNetClientTransfers(nc);
365 g_Net_Slist_ServerPlayerLeaves();
366 end;
369 // send file transfer message from server to client
370 function ftransSendServerMsg (var nc: TNetClient; var m: TMsg): Boolean;
371 var
372 pkt: PENetPacket;
373 begin
374 result := false;
375 if (m.CurSize < 1) then exit;
376 pkt := enet_packet_create(m.Data, m.CurSize, ENET_PACKET_FLAG_RELIABLE);
377 if not Assigned(pkt) then begin killClientByFT(nc); exit; end;
378 if (enet_peer_send(nc.Peer, NET_CHAN_DOWNLOAD_EX, pkt) <> 0) then begin killClientByFT(nc); exit; end;
379 result := true;
380 end;
383 // send file transfer message from client to server
384 function ftransSendClientMsg (var m: TMsg): Boolean;
385 var
386 pkt: PENetPacket;
387 begin
388 result := false;
389 if (m.CurSize < 1) then exit;
390 pkt := enet_packet_create(m.Data, m.CurSize, ENET_PACKET_FLAG_RELIABLE);
391 if not Assigned(pkt) then exit;
392 if (enet_peer_send(NetPeer, NET_CHAN_DOWNLOAD_EX, pkt) <> 0) then exit;
393 result := true;
394 end;
397 // file chunk sender
398 procedure ProcessChunkSend (var nc: TNetClient);
399 var
400 tf: ^TNetFileTransfer;
401 ct: Int64;
402 chunks: Integer;
403 rd: Integer;
404 begin
405 tf := @nc.Transfer;
406 if (tf.stream = nil) then exit;
407 ct := GetTimerMS();
408 // arbitrary timeout number
409 if (ct-tf.lastAckTime >= 5000) then
410 begin
411 killClientByFT(nc);
412 exit;
413 end;
414 // check if we need to send something
415 if (not tf.inProgress) then exit; // waiting for the initial ack
416 // ok, we're sending chunks
417 if (tf.lastAckChunk <> tf.lastSentChunk) then exit;
418 Inc(tf.lastSentChunk);
419 // do it one chunk at a time; client ack will advance our chunk counter
420 chunks := (tf.size+tf.chunkSize-1) div tf.chunkSize;
422 if (tf.lastSentChunk > chunks) then
423 begin
424 killClientByFT(nc);
425 exit;
426 end;
428 trans_omsg.Clear();
429 if (tf.lastSentChunk = chunks) then
430 begin
431 // we're done with this file
432 e_LogWritefln('download: client #%d, DONE sending chunks #%d/#%d', [nc.ID, tf.lastSentChunk, chunks]);
433 trans_omsg.Write(Byte(NTF_SERVER_DONE));
434 clearNetClientTransfers(nc);
435 end
436 else
437 begin
438 // packet type
439 trans_omsg.Write(Byte(NTF_SERVER_CHUNK));
440 trans_omsg.Write(LongInt(tf.lastSentChunk));
441 // read chunk
442 rd := tf.size-(tf.lastSentChunk*tf.chunkSize);
443 if (rd > tf.chunkSize) then rd := tf.chunkSize;
444 trans_omsg.Write(LongInt(rd));
445 //e_LogWritefln('download: client #%d, sending chunk #%d/#%d (%d bytes)', [nc.ID, tf.lastSentChunk, chunks, rd]);
446 //FIXME: check for errors here
447 try
448 tf.stream.Seek(tf.lastSentChunk*tf.chunkSize, soFromBeginning);
449 tf.stream.ReadBuffer(tf.diskBuffer^, rd);
450 trans_omsg.WriteData(tf.diskBuffer, rd);
451 except // sorry
452 killClientByFT(nc);
453 exit;
454 end;
455 end;
456 // send packet
457 ftransSendServerMsg(nc, trans_omsg);
458 end;
461 // server file transfer packet processor
462 // received packet is in `NetEvent`
463 procedure ProcessDownloadExPacket ();
464 var
465 f: Integer;
466 nc: ^TNetClient;
467 nid: Integer = -1;
468 msg: TMsg;
469 cmd: Byte;
470 tf: ^TNetFileTransfer;
471 fname: string;
472 chunk: Integer;
473 ridx: Integer;
474 dfn: AnsiString;
475 md5: TMD5Digest;
476 //st: TStream;
477 size: LongInt;
478 fi: TDiskFileInfo;
479 begin
480 // find client index by peer
481 for f := Low(NetClients) to High(NetClients) do
482 begin
483 if (not NetClients[f].Used) then continue;
484 if (NetClients[f].Peer = NetEvent.peer) then
485 begin
486 nid := f;
487 break;
488 end;
489 end;
490 //e_LogWritefln('RECEIVE: dlpacket; client=%d (datalen=%u)', [nid, NetEvent.packet^.dataLength]);
492 if (nid < 0) then exit; // wtf?!
493 nc := @NetClients[nid];
495 if (NetEvent.packet^.dataLength = 0) then
496 begin
497 killClientByFT(nc^);
498 exit;
499 end;
501 tf := @NetClients[nid].Transfer;
502 tf.lastAckTime := GetTimerMS();
504 cmd := Byte(NetEvent.packet^.data^);
505 //e_LogWritefln('RECEIVE: nid=%d; cmd=%u', [nid, cmd]);
506 case cmd of
507 NTF_CLIENT_FILE_REQUEST: // file request
508 begin
509 if (tf.stream <> nil) then
510 begin
511 killClientByFT(nc^);
512 exit;
513 end;
514 if (NetEvent.packet^.dataLength < 2) then
515 begin
516 killClientByFT(nc^);
517 exit;
518 end;
519 // new transfer request; build packet
520 if not msg.Init(NetEvent.packet^.data+1, NetEvent.packet^.dataLength-1, True) then
521 begin
522 killClientByFT(nc^);
523 exit;
524 end;
525 // get resource index
526 ridx := msg.ReadLongInt();
527 if (ridx < -1) or (ridx >= length(gExternalResources)) then
528 begin
529 e_LogWritefln('Invalid resource index %d', [ridx], TMsgType.Warning);
530 killClientByFT(nc^);
531 exit;
532 end;
533 if (ridx < 0) then fname := gGameSettings.WAD else fname := gExternalResources[ridx].diskName;
534 if (length(fname) = 0) then
535 begin
536 e_WriteLog('Invalid filename: '+fname, TMsgType.Warning);
537 killClientByFT(nc^);
538 exit;
539 end;
540 tf.diskName := findDiskWad(fname);
541 if (length(tf.diskName) = 0) then
542 begin
543 e_LogWritefln('NETWORK: file "%s" not found!', [fname], TMsgType.Fatal);
544 killClientByFT(nc^);
545 exit;
546 end;
547 // calculate hash
548 //tf.hash := MD5File(tf.diskName);
549 if (ridx < 0) then tf.hash := gWADHash else tf.hash := gExternalResources[ridx].hash;
550 // create file stream
551 tf.diskName := findDiskWad(fname);
552 try
553 tf.stream := openDiskFileRO(tf.diskName);
554 except
555 tf.stream := nil;
556 end;
557 if (tf.stream = nil) then
558 begin
559 e_WriteLog(Format('NETWORK: file "%s" not found!', [fname]), TMsgType.Fatal);
560 killClientByFT(nc^);
561 exit;
562 end;
563 e_LogWritefln('client #%d requested resource #%d (file is `%s` : `%s`)', [nc.ID, ridx, fname, tf.diskName]);
564 tf.size := tf.stream.size;
565 tf.chunkSize := FILE_CHUNK_SIZE; // arbitrary
566 tf.lastSentChunk := -1;
567 tf.lastAckChunk := -1;
568 tf.lastAckTime := GetTimerMS();
569 tf.inProgress := False; // waiting for the first ACK or for the cancel
570 GetMem(tf.diskBuffer, tf.chunkSize);
571 // sent file info message
572 trans_omsg.Clear();
573 trans_omsg.Write(Byte(NTF_SERVER_FILE_INFO));
574 trans_omsg.Write(tf.hash);
575 trans_omsg.Write(tf.size);
576 trans_omsg.Write(tf.chunkSize);
577 trans_omsg.Write(ExtractFileName(fname));
578 if not ftransSendServerMsg(nc^, trans_omsg) then exit;
579 end;
580 NTF_CLIENT_ABORT: // do not send requested file, or abort current transfer
581 begin
582 e_LogWritefln('client #%d aborted file transfer', [nc.ID]);
583 clearNetClientTransfers(nc^);
584 end;
585 NTF_CLIENT_START: // start transfer; client may resume download by sending non-zero starting chunk
586 begin
587 if not Assigned(tf.stream) then
588 begin
589 killClientByFT(nc^);
590 exit;
591 end;
592 if (tf.lastSentChunk <> -1) or (tf.lastAckChunk <> -1) or (tf.inProgress) then
593 begin
594 // double ack, get lost
595 killClientByFT(nc^);
596 exit;
597 end;
598 if (NetEvent.packet^.dataLength < 2) then
599 begin
600 killClientByFT(nc^);
601 exit;
602 end;
603 // build packet
604 if not msg.Init(NetEvent.packet^.data+1, NetEvent.packet^.dataLength-1, True) then
605 begin
606 killClientByFT(nc^);
607 exit;
608 end;
609 chunk := msg.ReadLongInt();
610 if (chunk < 0) or (chunk > (tf.size+tf.chunkSize-1) div tf.chunkSize) then
611 begin
612 killClientByFT(nc^);
613 exit;
614 end;
615 e_LogWritefln('client #%d started file transfer from chunk %d', [nc.ID, chunk]);
616 // start sending chunks
617 tf.inProgress := True;
618 tf.lastSentChunk := chunk-1;
619 tf.lastAckChunk := chunk-1;
620 ProcessChunkSend(nc^);
621 end;
622 NTF_CLIENT_ACK: // chunk ack; chunk number follows
623 begin
624 if not Assigned(tf.stream) then
625 begin
626 killClientByFT(nc^);
627 exit;
628 end;
629 if (tf.lastSentChunk < 0) or (not tf.inProgress) then
630 begin
631 // double ack, get lost
632 killClientByFT(nc^);
633 exit;
634 end;
635 if (NetEvent.packet^.dataLength < 2) then
636 begin
637 killClientByFT(nc^);
638 exit;
639 end;
640 // build packet
641 if not msg.Init(NetEvent.packet^.data+1, NetEvent.packet^.dataLength-1, True) then
642 begin
643 killClientByFT(nc^);
644 exit;
645 end;
646 chunk := msg.ReadLongInt();
647 if (chunk < 0) or (chunk > (tf.size+tf.chunkSize-1) div tf.chunkSize) then
648 begin
649 killClientByFT(nc^);
650 exit;
651 end;
652 // do it this way, so client may seek, or request retransfers for some reason
653 tf.lastAckChunk := chunk;
654 tf.lastSentChunk := chunk;
655 //e_LogWritefln('client #%d acked file transfer chunk %d', [nc.ID, chunk]);
656 ProcessChunkSend(nc^);
657 end;
658 NTF_CLIENT_MAP_REQUEST:
659 begin
660 e_LogWritefln('client #%d requested map info', [nc.ID]);
661 trans_omsg.Clear();
662 dfn := findDiskWad(gGameSettings.WAD);
663 if (dfn = '') then dfn := '!wad_not_found!.wad'; //FIXME
664 //md5 := MD5File(dfn);
665 md5 := gWADHash;
666 if (not GetDiskFileInfo(dfn, fi)) then
667 begin
668 e_LogWritefln('client #%d requested map info, but i cannot get file info', [nc.ID]);
669 killClientByFT(nc^);
670 exit;
671 end;
672 size := fi.size;
674 st := openDiskFileRO(dfn);
675 if not assigned(st) then exit; //wtf?!
676 size := st.size;
677 st.Free;
679 // packet type
680 trans_omsg.Write(Byte(NTF_SERVER_MAP_INFO));
681 // map wad name
682 trans_omsg.Write(ExtractFileName(gGameSettings.WAD));
683 // map wad md5
684 trans_omsg.Write(md5);
685 // map wad size
686 trans_omsg.Write(size);
687 // number of external resources for map
688 trans_omsg.Write(LongInt(length(gExternalResources)));
689 // external resource names
690 for f := 0 to High(gExternalResources) do
691 begin
692 // old style packet
693 //trans_omsg.Write(ExtractFileName(gExternalResources[f])); // GameDir+'/wads/'+ResList.Strings[i]
694 // new style packet
695 trans_omsg.Write('!');
696 trans_omsg.Write(LongInt(gExternalResources[f].size));
697 trans_omsg.Write(gExternalResources[f].hash);
698 trans_omsg.Write(ExtractFileName(gExternalResources[f].diskName));
699 end;
700 // send packet
701 if not ftransSendServerMsg(nc^, trans_omsg) then exit;
702 end;
703 else
704 begin
705 killClientByFT(nc^);
706 exit;
707 end;
708 end;
709 end;
712 //**************************************************************************
713 //
714 // file transfer crap (both client and server)
715 //
716 //**************************************************************************
718 function getNewTimeoutEnd (): Int64;
719 begin
720 result := GetTimerMS();
721 if (g_Net_DownloadTimeout <= 0) then
722 begin
723 result := result+1000*60*3; // 3 minutes
724 end
725 else
726 begin
727 result := result+trunc(g_Net_DownloadTimeout*1000);
728 end;
729 end;
732 // send map request to server, and wait for "map info" server reply
733 //
734 // returns `false` on error or user abort
735 // fills:
736 // diskName: map wad file name (without a path)
737 // hash: map wad hash
738 // size: map wad size
739 // chunkSize: set too
740 // resList: list of resource wads
741 // returns:
742 // <0 on error
743 // 0 on success
744 // 1 on user abort
745 // 2 on server abort
746 // for maps, first `tf.diskName` name will be map wad name, and `tf.hash`/`tf.size` will contain map info
747 function g_Net_Wait_MapInfo (var tf: TNetFileTransfer; var resList: TNetMapResourceInfoArray): Integer;
748 var
749 ev: ENetEvent;
750 rMsgId: Byte;
751 Ptr: Pointer;
752 msg: TMsg;
753 freePacket: Boolean = false;
754 ct, ett: Int64;
755 status: cint;
756 s: AnsiString;
757 rc, f: LongInt;
758 ri: ^TNetMapResourceInfo;
759 begin
760 SetLength(resList, 0);
762 // send request
763 trans_omsg.Clear();
764 trans_omsg.Write(Byte(NTF_CLIENT_MAP_REQUEST));
765 if not ftransSendClientMsg(trans_omsg) then begin result := -1; exit; end;
767 FillChar(ev, SizeOf(ev), 0);
768 Result := -1;
769 try
770 ett := getNewTimeoutEnd();
771 repeat
772 status := enet_host_service(NetHost, @ev, 300);
774 if (status < 0) then
775 begin
776 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' network error', True);
777 Result := -1;
778 exit;
779 end;
781 if (status <= 0) then
782 begin
783 // check for timeout
784 ct := GetTimerMS();
785 if (ct >= ett) then
786 begin
787 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' timeout reached', True);
788 Result := -1;
789 exit;
790 end;
791 end
792 else
793 begin
794 // some event
795 case ev.kind of
796 ENET_EVENT_TYPE_RECEIVE:
797 begin
798 freePacket := true;
799 if (ev.channelID <> NET_CHAN_DOWNLOAD_EX) then
800 begin
801 //e_LogWritefln('g_Net_Wait_MapInfo: skip message from non-transfer channel', []);
802 freePacket := false;
803 g_Net_Client_HandlePacket(ev.packet, g_Net_ClientLightMsgHandler);
804 if (g_Res_received_map_start < 0) then begin result := -666; exit; end;
805 end
806 else
807 begin
808 ett := getNewTimeoutEnd();
809 if (ev.packet.dataLength < 1) then
810 begin
811 e_LogWritefln('g_Net_Wait_MapInfo: invalid server packet (no data)', []);
812 Result := -1;
813 exit;
814 end;
815 Ptr := ev.packet^.data;
816 rMsgId := Byte(Ptr^);
817 e_LogWritefln('g_Net_Wait_MapInfo: got message %u from server (dataLength=%u)', [rMsgId, ev.packet^.dataLength]);
818 if (rMsgId = NTF_SERVER_FILE_INFO) then
819 begin
820 e_LogWritefln('g_Net_Wait_MapInfo: waiting for map info reply, but got file info reply', []);
821 Result := -1;
822 exit;
823 end
824 else if (rMsgId = NTF_SERVER_ABORT) then
825 begin
826 e_LogWritefln('g_Net_Wait_MapInfo: server aborted transfer', []);
827 Result := 2;
828 exit;
829 end
830 else if (rMsgId = NTF_SERVER_MAP_INFO) then
831 begin
832 e_LogWritefln('g_Net_Wait_MapInfo: creating map info packet...', []);
833 if not msg.Init(ev.packet^.data+1, ev.packet^.dataLength-1, True) then exit;
834 e_LogWritefln('g_Net_Wait_MapInfo: parsing map info packet (rd=%d; max=%d)...', [msg.ReadCount, msg.MaxSize]);
835 SetLength(resList, 0); // just in case
836 // map wad name
837 tf.diskName := msg.ReadString();
838 e_LogWritefln('g_Net_Wait_MapInfo: map wad is `%s`', [tf.diskName]);
839 // map wad md5
840 tf.hash := msg.ReadMD5();
841 // map wad size
842 tf.size := msg.ReadLongInt();
843 e_LogWritefln('g_Net_Wait_MapInfo: map wad size is %d', [tf.size]);
844 // number of external resources for map
845 rc := msg.ReadLongInt();
846 if (rc < 0) or (rc > 1024) then
847 begin
848 e_LogWritefln('g_Net_Wait_Event: invalid number of map external resources (%d)', [rc]);
849 Result := -1;
850 exit;
851 end;
852 e_LogWritefln('g_Net_Wait_MapInfo: map external resource count is %d', [rc]);
853 SetLength(resList, rc);
854 // external resource names
855 for f := 0 to rc-1 do
856 begin
857 ri := @resList[f];
858 s := msg.ReadString();
859 if (length(s) = 0) then begin result := -1; exit; end;
860 if (s = '!') then
861 begin
862 // extended packet
863 ri.size := msg.ReadLongInt();
864 ri.hash := msg.ReadMD5();
865 ri.wadName := ExtractFileName(msg.ReadString());
866 if (length(ri.wadName) = 0) or (ri.size < 0) then begin result := -1; exit; end;
867 end
868 else
869 begin
870 // old-style packet, only name
871 ri.wadName := ExtractFileName(s);
872 if (length(ri.wadName) = 0) then begin result := -1; exit; end;
873 ri.size := -1; // unknown
874 end;
875 end;
876 e_LogWritefln('g_Net_Wait_MapInfo: got map info', []);
877 Result := 0; // success
878 exit;
879 end
880 else
881 begin
882 e_LogWritefln('g_Net_Wait_Event: invalid server packet type', []);
883 Result := -1;
884 exit;
885 end;
886 end;
887 end;
888 ENET_EVENT_TYPE_DISCONNECT:
889 begin
890 if (ev.data <= NET_DISC_MAX) then
891 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' ' + _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + ev.data)], True);
892 Result := -1;
893 exit;
894 end;
895 else
896 begin
897 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' unknown ENet event ' + IntToStr(Ord(ev.kind)), True);
898 result := -1;
899 exit;
900 end;
901 end;
902 if (freePacket) then begin freePacket := false; enet_packet_destroy(ev.packet); end;
903 end;
904 ProcessLoading();
905 if g_Net_UserRequestExit() then
906 begin
907 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' user abort', True);
908 Result := 1;
909 exit;
910 end;
911 until false;
912 finally
913 if (freePacket) then enet_packet_destroy(ev.packet);
914 end;
915 end;
918 // send file request to server, and wait for server reply
919 //
920 // returns `false` on error or user abort
921 // fills:
922 // diskName (actually, base name)
923 // hash
924 // size
925 // chunkSize
926 // returns:
927 // <0 on error
928 // 0 on success
929 // 1 on user abort
930 // 2 on server abort
931 // for maps, first `tf.diskName` name will be map wad name, and `tf.hash`/`tf.size` will contain map info
932 function g_Net_RequestResFileInfo (resIndex: LongInt; out tf: TNetFileTransfer): Integer;
933 var
934 ev: ENetEvent;
935 rMsgId: Byte;
936 Ptr: Pointer;
937 msg: TMsg;
938 freePacket: Boolean = false;
939 ct, ett: Int64;
940 status: cint;
941 begin
942 // send request
943 trans_omsg.Clear();
944 trans_omsg.Write(Byte(NTF_CLIENT_FILE_REQUEST));
945 trans_omsg.Write(resIndex);
946 if not ftransSendClientMsg(trans_omsg) then begin result := -1; exit; end;
948 FillChar(ev, SizeOf(ev), 0);
949 Result := -1;
950 try
951 ett := getNewTimeoutEnd();
952 repeat
953 status := enet_host_service(NetHost, @ev, 300);
955 if (status < 0) then
956 begin
957 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' network error', True);
958 Result := -1;
959 exit;
960 end;
962 if (status <= 0) then
963 begin
964 // check for timeout
965 ct := GetTimerMS();
966 if (ct >= ett) then
967 begin
968 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' timeout reached', True);
969 Result := -1;
970 exit;
971 end;
972 end
973 else
974 begin
975 // some event
976 case ev.kind of
977 ENET_EVENT_TYPE_RECEIVE:
978 begin
979 freePacket := true;
980 if (ev.channelID <> NET_CHAN_DOWNLOAD_EX) then
981 begin
982 //e_LogWriteln('g_Net_Wait_Event: skip message from non-transfer channel');
983 freePacket := false;
984 g_Net_Client_HandlePacket(ev.packet, g_Net_ClientLightMsgHandler);
985 if (g_Res_received_map_start < 0) then begin result := -666; exit; end;
986 end
987 else
988 begin
989 ett := getNewTimeoutEnd();
990 if (ev.packet.dataLength < 1) then
991 begin
992 e_LogWriteln('g_Net_Wait_Event: invalid server packet (no data)');
993 Result := -1;
994 exit;
995 end;
996 Ptr := ev.packet^.data;
997 rMsgId := Byte(Ptr^);
998 e_LogWritefln('received transfer packet with id %d (%u bytes)', [rMsgId, ev.packet^.dataLength]);
999 if (rMsgId = NTF_SERVER_FILE_INFO) then
1000 begin
1001 if not msg.Init(ev.packet^.data+1, ev.packet^.dataLength-1, True) then exit;
1002 tf.hash := msg.ReadMD5();
1003 tf.size := msg.ReadLongInt();
1004 tf.chunkSize := msg.ReadLongInt();
1005 tf.diskName := ExtractFileName(msg.readString());
1006 if (tf.size < 0) or (tf.chunkSize <> FILE_CHUNK_SIZE) or (length(tf.diskName) = 0) then
1007 begin
1008 e_LogWritefln('g_Net_RequestResFileInfo: invalid file info packet', []);
1009 Result := -1;
1010 exit;
1011 end;
1012 e_LogWritefln('got file info for resource #%d: size=%d; name=%s', [resIndex, tf.size, tf.diskName]);
1013 Result := 0; // success
1014 exit;
1015 end
1016 else if (rMsgId = NTF_SERVER_ABORT) then
1017 begin
1018 e_LogWriteln('g_Net_RequestResFileInfo: server aborted transfer');
1019 Result := 2;
1020 exit;
1021 end
1022 else if (rMsgId = NTF_SERVER_MAP_INFO) then
1023 begin
1024 e_LogWriteln('g_Net_RequestResFileInfo: waiting for map info reply, but got file info reply');
1025 Result := -1;
1026 exit;
1027 end
1028 else
1029 begin
1030 e_LogWriteln('g_Net_RequestResFileInfo: invalid server packet type');
1031 Result := -1;
1032 exit;
1033 end;
1034 end;
1035 end;
1036 ENET_EVENT_TYPE_DISCONNECT:
1037 begin
1038 if (ev.data <= NET_DISC_MAX) then
1039 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' ' + _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + ev.data)], True);
1040 Result := -1;
1041 exit;
1042 end;
1043 else
1044 begin
1045 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' unknown ENet event ' + IntToStr(Ord(ev.kind)), True);
1046 result := -1;
1047 exit;
1048 end;
1049 end;
1050 if (freePacket) then begin freePacket := false; enet_packet_destroy(ev.packet); end;
1051 end;
1052 ProcessLoading();
1053 if g_Net_UserRequestExit() then
1054 begin
1055 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' user abort', True);
1056 Result := 1;
1057 exit;
1058 end;
1059 until false;
1060 finally
1061 if (freePacket) then enet_packet_destroy(ev.packet);
1062 end;
1063 end;
1066 // call this to cancel file transfer requested by `g_Net_RequestResFileInfo()`
1067 function g_Net_AbortResTransfer (var tf: TNetFileTransfer): Boolean;
1068 begin
1069 result := false;
1070 e_LogWritefln('aborting file transfer...', []);
1071 // send request
1072 trans_omsg.Clear();
1073 trans_omsg.Write(Byte(NTF_CLIENT_ABORT));
1074 result := ftransSendClientMsg(trans_omsg);
1075 if result then enet_host_flush(NetHost);
1076 end;
1079 // call this to start file transfer requested by `g_Net_RequestResFileInfo()`
1080 //
1081 // returns `false` on error or user abort
1082 // fills:
1083 // hash
1084 // size
1085 // chunkSize
1086 // returns:
1087 // <0 on error
1088 // 0 on success
1089 // 1 on user abort
1090 // 2 on server abort
1091 // for maps, first `tf.diskName` name will be map wad name, and `tf.hash`/`tf.size` will contain map info
1092 function g_Net_ReceiveResourceFile (resIndex: LongInt; var tf: TNetFileTransfer; strm: TStream): Integer;
1093 var
1094 ev: ENetEvent;
1095 rMsgId: Byte;
1096 Ptr: Pointer;
1097 msg: TMsg;
1098 freePacket: Boolean = false;
1099 ct, ett: Int64;
1100 status: cint;
1101 nextChunk: Integer = 0;
1102 chunkTotal: Integer;
1103 chunk: Integer;
1104 csize: Integer;
1105 buf: PChar = nil;
1106 resumed: Boolean;
1107 //stx: Int64;
1108 begin
1109 tf.resumed := false;
1110 e_LogWritefln('file `%s`, size=%d (%d)', [tf.diskName, Integer(strm.size), tf.size], TMsgType.Notify);
1111 // check if we should resume downloading
1112 resumed := (strm.size > tf.chunkSize) and (strm.size < tf.size);
1113 // send request
1114 trans_omsg.Clear();
1115 trans_omsg.Write(Byte(NTF_CLIENT_START));
1116 if resumed then chunk := strm.size div tf.chunkSize else chunk := 0;
1117 trans_omsg.Write(LongInt(chunk));
1118 if not ftransSendClientMsg(trans_omsg) then begin result := -1; exit; end;
1120 strm.Seek(chunk*tf.chunkSize, soFromBeginning);
1121 chunkTotal := (tf.size+tf.chunkSize-1) div tf.chunkSize;
1122 e_LogWritefln('receiving file `%s` (%d chunks)', [tf.diskName, chunkTotal], TMsgType.Notify);
1123 g_Game_SetLoadingText('downloading "'+ExtractFileName(tf.diskName)+'"', chunkTotal, False);
1124 tf.resumed := resumed;
1126 if (chunk > 0) then g_Game_StepLoading(chunk);
1127 nextChunk := chunk;
1129 // wait for reply data
1130 FillChar(ev, SizeOf(ev), 0);
1131 Result := -1;
1132 GetMem(buf, tf.chunkSize);
1133 try
1134 ett := getNewTimeoutEnd();
1135 repeat
1136 //stx := -GetTimerMS();
1137 status := enet_host_service(NetHost, @ev, 300);
1139 if (status < 0) then
1140 begin
1141 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' network error', True);
1142 Result := -1;
1143 exit;
1144 end;
1146 if (status <= 0) then
1147 begin
1148 // check for timeout
1149 ct := GetTimerMS();
1150 if (ct >= ett) then
1151 begin
1152 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' timeout reached', True);
1153 Result := -1;
1154 exit;
1155 end;
1156 end
1157 else
1158 begin
1159 // some event
1160 case ev.kind of
1161 ENET_EVENT_TYPE_RECEIVE:
1162 begin
1163 freePacket := true;
1164 if (ev.channelID <> NET_CHAN_DOWNLOAD_EX) then
1165 begin
1166 //e_LogWritefln('g_Net_Wait_Event: skip message from non-transfer channel', []);
1167 freePacket := false;
1168 g_Net_Client_HandlePacket(ev.packet, g_Net_ClientLightMsgHandler);
1169 if (g_Res_received_map_start < 0) then begin result := -666; exit; end;
1170 end
1171 else
1172 begin
1173 //stx := stx+GetTimerMS();
1174 //e_LogWritefln('g_Net_ReceiveResourceFile: stx=%d', [Integer(stx)]);
1175 //stx := -GetTimerMS();
1176 ett := getNewTimeoutEnd();
1177 if (ev.packet.dataLength < 1) then
1178 begin
1179 e_LogWritefln('g_Net_ReceiveResourceFile: invalid server packet (no data)', []);
1180 Result := -1;
1181 exit;
1182 end;
1183 Ptr := ev.packet^.data;
1184 rMsgId := Byte(Ptr^);
1185 if (rMsgId = NTF_SERVER_DONE) then
1186 begin
1187 e_LogWritefln('file transfer complete.', []);
1188 result := 0;
1189 exit;
1190 end
1191 else if (rMsgId = NTF_SERVER_CHUNK) then
1192 begin
1193 if not msg.Init(ev.packet^.data+1, ev.packet^.dataLength-1, True) then exit;
1194 chunk := msg.ReadLongInt();
1195 csize := msg.ReadLongInt();
1196 if (chunk <> nextChunk) then
1197 begin
1198 e_LogWritefln('received chunk %d, but expected chunk %d', [chunk, nextChunk]);
1199 Result := -1;
1200 exit;
1201 end;
1202 if (csize < 0) or (csize > tf.chunkSize) then
1203 begin
1204 e_LogWritefln('received chunk with size %d, but expected chunk size is %d', [csize, tf.chunkSize]);
1205 Result := -1;
1206 exit;
1207 end;
1208 //e_LogWritefln('got chunk #%d of #%d (csize=%d)', [chunk, (tf.size+tf.chunkSize-1) div tf.chunkSize, csize]);
1209 msg.ReadData(buf, csize);
1210 strm.WriteBuffer(buf^, csize);
1211 nextChunk := chunk+1;
1212 g_Game_StepLoading();
1213 // send ack
1214 trans_omsg.Clear();
1215 trans_omsg.Write(Byte(NTF_CLIENT_ACK));
1216 trans_omsg.Write(LongInt(chunk));
1217 if not ftransSendClientMsg(trans_omsg) then begin result := -1; exit; end;
1218 end
1219 else if (rMsgId = NTF_SERVER_ABORT) then
1220 begin
1221 e_LogWritefln('g_Net_ReceiveResourceFile: server aborted transfer', []);
1222 Result := 2;
1223 exit;
1224 end
1225 else
1226 begin
1227 e_LogWritefln('g_Net_ReceiveResourceFile: invalid server packet type', []);
1228 Result := -1;
1229 exit;
1230 end;
1231 //stx := stx+GetTimerMS();
1232 //e_LogWritefln('g_Net_ReceiveResourceFile: process stx=%d', [Integer(stx)]);
1233 end;
1234 end;
1235 ENET_EVENT_TYPE_DISCONNECT:
1236 begin
1237 if (ev.data <= NET_DISC_MAX) then
1238 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' ' + _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + ev.data)], True);
1239 Result := -1;
1240 exit;
1241 end;
1242 else
1243 begin
1244 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' unknown ENet event ' + IntToStr(Ord(ev.kind)), True);
1245 result := -1;
1246 exit;
1247 end;
1248 end;
1249 if (freePacket) then begin freePacket := false; enet_packet_destroy(ev.packet); end;
1250 end;
1251 ProcessLoading();
1252 if g_Net_UserRequestExit() then
1253 begin
1254 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' user abort', True);
1255 Result := 1;
1256 exit;
1257 end;
1258 until false;
1259 finally
1260 FreeMem(buf);
1261 if (freePacket) then enet_packet_destroy(ev.packet);
1262 end;
1263 end;
1266 //**************************************************************************
1267 //
1268 // common functions
1269 //
1270 //**************************************************************************
1272 function g_Net_FindSlot(): Integer;
1273 var
1274 I: Integer;
1275 F: Boolean;
1276 N, C: Integer;
1277 begin
1278 N := -1;
1279 F := False;
1280 C := 0;
1281 for I := Low(NetClients) to High(NetClients) do
1282 begin
1283 if NetClients[I].Used then
1284 Inc(C)
1285 else
1286 if not F then
1287 begin
1288 F := True;
1289 N := I;
1290 end;
1291 end;
1292 if C >= NetMaxClients then
1293 begin
1294 Result := -1;
1295 Exit;
1296 end;
1298 if not F then
1299 begin
1300 if (Length(NetClients) >= NetMaxClients) then
1301 N := -1
1302 else
1303 begin
1304 SetLength(NetClients, Length(NetClients) + 1);
1305 N := High(NetClients);
1306 end;
1307 end;
1309 if N >= 0 then
1310 begin
1311 NetClients[N].Used := True;
1312 NetClients[N].ID := N;
1313 NetClients[N].RequestedFullUpdate := False;
1314 NetClients[N].WaitForFirstSpawn := False;
1315 NetClients[N].RCONAuth := False;
1316 NetClients[N].Voted := False;
1317 NetClients[N].Player := 0;
1318 clearNetClientTransfers(NetClients[N]); // just in case
1319 end;
1321 Result := N;
1322 end;
1325 function g_Net_Init(): Boolean;
1326 var
1327 F: TextFile;
1328 IPstr: string;
1329 IP: LongWord;
1330 path: AnsiString;
1331 begin
1332 NetIn.Clear();
1333 NetOut.Clear();
1334 NetBuf[NET_UNRELIABLE].Clear();
1335 NetBuf[NET_RELIABLE].Clear();
1336 //SetLength(NetClients, 0);
1337 clearNetClients(true); // clear array
1338 NetPeer := nil;
1339 NetHost := nil;
1340 NetMyID := -1;
1341 NetPlrUID1 := -1;
1342 NetPlrUID2 := -1;
1343 NetAddr.port := 25666;
1344 SetLength(NetBannedHosts, 0);
1345 path := BANLIST_FILENAME;
1346 if e_FindResource(DataDirs, path) = true then
1347 begin
1348 Assign(F, path);
1349 Reset(F);
1350 while not EOF(F) do
1351 begin
1352 Readln(F, IPstr);
1353 if StrToIp(IPstr, IP) then
1354 g_Net_BanHost(IP);
1355 end;
1356 CloseFile(F);
1357 g_Net_SaveBanList();
1358 end;
1360 //Result := (enet_initialize() = 0);
1361 Result := enet_init_success;
1362 end;
1364 procedure g_Net_Flush();
1365 var
1366 T: Integer;
1367 P: pENetPacket;
1368 F, Chan: enet_uint32;
1369 I: Integer;
1370 begin
1371 F := 0;
1372 Chan := NET_CHAN_GAME;
1374 if NetMode = NET_SERVER then
1375 for T := NET_UNRELIABLE to NET_RELIABLE do
1376 begin
1377 if NetBuf[T].CurSize > 0 then
1378 begin
1379 P := enet_packet_create(NetBuf[T].Data, NetBuf[T].CurSize, F);
1380 if not Assigned(P) then continue;
1381 enet_host_broadcast(NetHost, Chan, P);
1382 NetBuf[T].Clear();
1383 end;
1385 for I := Low(NetClients) to High(NetClients) do
1386 begin
1387 if not NetClients[I].Used then continue;
1388 if NetClients[I].NetOut[T].CurSize <= 0 then continue;
1389 P := enet_packet_create(NetClients[I].NetOut[T].Data, NetClients[I].NetOut[T].CurSize, F);
1390 if not Assigned(P) then continue;
1391 enet_peer_send(NetClients[I].Peer, Chan, P);
1392 NetClients[I].NetOut[T].Clear();
1393 end;
1395 // next and last iteration is always RELIABLE
1396 F := LongWord(ENET_PACKET_FLAG_RELIABLE);
1397 Chan := NET_CHAN_IMPORTANT;
1398 end
1399 else if NetMode = NET_CLIENT then
1400 for T := NET_UNRELIABLE to NET_RELIABLE do
1401 begin
1402 if NetBuf[T].CurSize > 0 then
1403 begin
1404 P := enet_packet_create(NetBuf[T].Data, NetBuf[T].CurSize, F);
1405 if not Assigned(P) then continue;
1406 enet_peer_send(NetPeer, Chan, P);
1407 NetBuf[T].Clear();
1408 end;
1409 // next and last iteration is always RELIABLE
1410 F := LongWord(ENET_PACKET_FLAG_RELIABLE);
1411 Chan := NET_CHAN_IMPORTANT;
1412 end;
1413 end;
1415 procedure g_Net_Cleanup();
1416 begin
1417 NetIn.Clear();
1418 NetOut.Clear();
1419 NetBuf[NET_UNRELIABLE].Clear();
1420 NetBuf[NET_RELIABLE].Clear();
1422 //SetLength(NetClients, 0);
1423 clearNetClients(true); // clear array
1424 NetClientCount := 0;
1426 NetPeer := nil;
1427 NetHost := nil;
1428 g_Net_Slist_ServerClosed();
1429 NetMyID := -1;
1430 NetPlrUID1 := -1;
1431 NetPlrUID2 := -1;
1432 NetState := NET_STATE_NONE;
1434 NetPongSock := ENET_SOCKET_NULL;
1436 NetTimeToMaster := 0;
1437 NetTimeToUpdate := 0;
1438 NetTimeToReliable := 0;
1440 NetMode := NET_NONE;
1442 if NetPortThread <> NilThreadId then
1443 WaitForThreadTerminate(NetPortThread, 66666);
1445 NetPortThread := NilThreadId;
1446 g_Net_UnforwardPorts();
1448 if NetDump then
1449 g_Net_DumpEnd();
1450 end;
1452 procedure g_Net_Free();
1453 begin
1454 g_Net_Cleanup();
1456 //enet_deinitialize();
1457 NetInitDone := False;
1458 end;
1461 //**************************************************************************
1462 //
1463 // SERVER FUNCTIONS
1464 //
1465 //**************************************************************************
1467 function ForwardThread(Param: Pointer): PtrInt;
1468 begin
1469 Result := 0;
1470 if not g_Net_ForwardPorts() then Result := -1;
1471 end;
1473 function g_Net_Host(IPAddr: LongWord; Port: enet_uint16; MaxClients: Cardinal = 16): Boolean;
1474 begin
1475 if NetMode <> NET_NONE then
1476 begin
1477 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_INGAME]);
1478 Result := False;
1479 Exit;
1480 end;
1482 Result := True;
1484 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST], [Port]));
1485 if not NetInitDone then
1486 begin
1487 if (not g_Net_Init()) then
1488 begin
1489 g_Console_Add(_lc[I_NET_MSG_FERROR] + _lc[I_NET_ERR_ENET]);
1490 Result := False;
1491 Exit;
1492 end
1493 else
1494 NetInitDone := True;
1495 end;
1497 NetAddr.host := IPAddr;
1498 NetAddr.port := Port;
1500 NetHost := enet_host_create(@NetAddr, NET_MAXCLIENTS, NET_CHANS, 0, 0);
1502 if (NetHost = nil) then
1503 begin
1504 g_Console_Add(_lc[I_NET_MSG_ERROR] + Format(_lc[I_NET_ERR_HOST], [Port]));
1505 Result := False;
1506 g_Net_Cleanup;
1507 Exit;
1508 end;
1510 if NetForwardPorts then NetPortThread := BeginThread(ForwardThread);
1512 NetPongSock := enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM);
1513 if NetPongSock <> ENET_SOCKET_NULL then
1514 begin
1515 NetPongAddr.host := IPAddr;
1516 NetPongAddr.port := NET_PING_PORT;
1517 if enet_socket_bind(NetPongSock, @NetPongAddr) < 0 then
1518 begin
1519 enet_socket_destroy(NetPongSock);
1520 NetPongSock := ENET_SOCKET_NULL;
1521 end
1522 else
1523 enet_socket_set_option(NetPongSock, ENET_SOCKOPT_NONBLOCK, 1);
1524 end;
1526 NetMode := NET_SERVER;
1527 NetOut.Clear();
1528 NetBuf[NET_UNRELIABLE].Clear();
1529 NetBuf[NET_RELIABLE].Clear();
1531 if NetDump then
1532 g_Net_DumpStart();
1533 end;
1535 procedure g_Net_Host_Die();
1536 var
1537 I: Integer;
1538 begin
1539 if NetMode <> NET_SERVER then Exit;
1541 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_DISCALL]);
1542 for I := 0 to High(NetClients) do
1543 if NetClients[I].Used then
1544 enet_peer_disconnect(NetClients[I].Peer, NET_DISC_DOWN);
1546 while enet_host_service(NetHost, @NetEvent, 1000) > 0 do
1547 if NetEvent.kind = ENET_EVENT_TYPE_RECEIVE then
1548 enet_packet_destroy(NetEvent.packet);
1550 for I := 0 to High(NetClients) do
1551 if NetClients[I].Used then
1552 begin
1553 FreeMemory(NetClients[I].Peer^.data);
1554 NetClients[I].Peer^.data := nil;
1555 enet_peer_reset(NetClients[I].Peer);
1556 NetClients[I].Peer := nil;
1557 NetClients[I].Used := False;
1558 NetClients[I].NetOut[NET_UNRELIABLE].Free();
1559 NetClients[I].NetOut[NET_RELIABLE].Free();
1560 end;
1562 clearNetClients(false); // don't clear array
1563 g_Net_Slist_ServerClosed();
1564 if NetPongSock <> ENET_SOCKET_NULL then
1565 enet_socket_destroy(NetPongSock);
1567 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_DIE]);
1568 enet_host_destroy(NetHost);
1570 NetMode := NET_NONE;
1572 g_Net_Cleanup;
1573 e_WriteLog('NET: Server stopped', TMsgType.Notify);
1574 end;
1577 procedure g_Net_Host_Send(ID: Integer; Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
1578 var
1579 T: Integer;
1580 begin
1581 if (Reliable) then
1582 T := NET_RELIABLE
1583 else
1584 T := NET_UNRELIABLE;
1586 if (ID >= 0) then
1587 begin
1588 if ID > High(NetClients) then Exit;
1589 if NetClients[ID].Peer = nil then Exit;
1590 // write size first
1591 NetClients[ID].NetOut[T].Write(Integer(NetOut.CurSize));
1592 NetClients[ID].NetOut[T].Write(NetOut);
1593 end
1594 else
1595 begin
1596 // write size first
1597 NetBuf[T].Write(Integer(NetOut.CurSize));
1598 NetBuf[T].Write(NetOut);
1599 end;
1601 if NetDump then g_Net_DumpSendBuffer();
1602 NetOut.Clear();
1603 end;
1605 procedure g_Net_Host_CheckPings();
1606 var
1607 ClAddr: ENetAddress;
1608 Buf: ENetBuffer;
1609 Len: Integer;
1610 ClTime: Int64;
1611 Ping: array [0..9] of Byte;
1612 NPl: Byte;
1613 begin
1614 if (NetPongSock = ENET_SOCKET_NULL) or (NetHost = nil) then Exit;
1616 Buf.data := Addr(Ping[0]);
1617 Buf.dataLength := 2+8;
1619 Ping[0] := 0;
1621 Len := enet_socket_receive(NetPongSock, @ClAddr, @Buf, 1);
1622 if Len < 0 then Exit;
1624 if (Ping[0] = Ord('D')) and (Ping[1] = Ord('F')) then
1625 begin
1626 ClTime := Int64(Addr(Ping[2])^);
1628 NetOut.Clear();
1629 NetOut.Write(Byte(Ord('D')));
1630 NetOut.Write(Byte(Ord('F')));
1631 NetOut.Write(NetHost.address.port);
1632 NetOut.Write(ClTime);
1633 TMasterHost.writeInfo(NetOut);
1634 NPl := 0;
1635 if gPlayer1 <> nil then Inc(NPl);
1636 if gPlayer2 <> nil then Inc(NPl);
1637 NetOut.Write(NPl);
1638 NetOut.Write(gNumBots);
1640 Buf.data := NetOut.Data;
1641 Buf.dataLength := NetOut.CurSize;
1642 enet_socket_send(NetPongSock, @ClAddr, @Buf, 1);
1644 NetOut.Clear();
1645 end;
1646 end;
1649 function g_Net_Host_Update(): enet_size_t;
1650 var
1651 IP: string;
1652 Port: Word;
1653 ID: Integer;
1654 TC: pTNetClient;
1655 TP: TPlayer;
1656 begin
1657 IP := '';
1658 Result := 0;
1660 if NetUseMaster then g_Net_Slist_Pulse();
1661 g_Net_Host_CheckPings();
1663 while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
1664 begin
1665 case (NetEvent.kind) of
1666 ENET_EVENT_TYPE_CONNECT:
1667 begin
1668 IP := IpToStr(NetEvent.Peer^.address.host);
1669 Port := NetEvent.Peer^.address.port;
1670 g_Console_Add(_lc[I_NET_MSG] +
1671 Format(_lc[I_NET_MSG_HOST_CONN], [IP, Port]));
1673 if (NetEvent.data <> NET_PROTOCOL_VER) then
1674 begin
1675 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_REJECT] +
1676 _lc[I_NET_DISC_PROTOCOL]);
1677 NetEvent.peer^.data := GetMemory(SizeOf(Byte));
1678 Byte(NetEvent.peer^.data^) := 255;
1679 enet_peer_disconnect(NetEvent.peer, NET_DISC_PROTOCOL);
1680 enet_host_flush(NetHost);
1681 Exit;
1682 end;
1684 ID := g_Net_FindSlot();
1686 if ID < 0 then
1687 begin
1688 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_REJECT] +
1689 _lc[I_NET_DISC_FULL]);
1690 NetEvent.Peer^.data := GetMemory(SizeOf(Byte));
1691 Byte(NetEvent.peer^.data^) := 255;
1692 enet_peer_disconnect(NetEvent.peer, NET_DISC_FULL);
1693 enet_host_flush(NetHost);
1694 Exit;
1695 end;
1697 NetClients[ID].Peer := NetEvent.peer;
1698 NetClients[ID].Peer^.data := GetMemory(SizeOf(Byte));
1699 Byte(NetClients[ID].Peer^.data^) := ID;
1700 NetClients[ID].State := NET_STATE_AUTH;
1701 NetClients[ID].RCONAuth := False;
1702 NetClients[ID].NetOut[NET_UNRELIABLE].Alloc(NET_BUFSIZE*2);
1703 NetClients[ID].NetOut[NET_RELIABLE].Alloc(NET_BUFSIZE*2);
1704 clearNetClientTransfers(NetClients[ID]); // just in case
1706 enet_peer_timeout(NetEvent.peer, ENET_PEER_TIMEOUT_LIMIT * 2, ENET_PEER_TIMEOUT_MINIMUM * 2, ENET_PEER_TIMEOUT_MAXIMUM * 2);
1708 Inc(NetClientCount);
1709 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST_ADD], [ID]));
1710 end;
1712 ENET_EVENT_TYPE_RECEIVE:
1713 begin
1714 //e_LogWritefln('RECEIVE: chan=%u', [NetEvent.channelID]);
1715 if (NetEvent.channelID = NET_CHAN_DOWNLOAD_EX) then
1716 begin
1717 ProcessDownloadExPacket();
1718 end
1719 else
1720 begin
1721 ID := Byte(NetEvent.peer^.data^);
1722 if ID > High(NetClients) then Exit;
1723 TC := @NetClients[ID];
1725 if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
1726 g_Net_Host_HandlePacket(TC, NetEvent.packet, g_Net_HostMsgHandler);
1727 end;
1728 end;
1730 ENET_EVENT_TYPE_DISCONNECT:
1731 begin
1732 ID := Byte(NetEvent.peer^.data^);
1733 if ID > High(NetClients) then Exit;
1734 clearNetClient(NetClients[ID]);
1735 TC := @NetClients[ID];
1736 if TC = nil then Exit;
1738 if not (TC^.Used) then Exit;
1740 TP := g_Player_Get(TC^.Player);
1742 if TP <> nil then
1743 begin
1744 TP.Lives := 0;
1745 TP.Kill(K_SIMPLEKILL, 0, HIT_DISCON);
1746 g_Console_Add(Format(_lc[I_PLAYER_LEAVE], [TP.Name]), True);
1747 e_WriteLog('NET: Client ' + TP.Name + ' [' + IntToStr(ID) + '] disconnected.', TMsgType.Notify);
1748 g_Player_Remove(TP.UID);
1749 end;
1751 TC^.Used := False;
1752 TC^.State := NET_STATE_NONE;
1753 TC^.Peer := nil;
1754 TC^.Player := 0;
1755 TC^.RequestedFullUpdate := False;
1756 TC^.WaitForFirstSpawn := False;
1757 TC^.NetOut[NET_UNRELIABLE].Free();
1758 TC^.NetOut[NET_RELIABLE].Free();
1760 FreeMemory(NetEvent.peer^.data);
1761 NetEvent.peer^.data := nil;
1762 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST_DISC], [ID]));
1763 Dec(NetClientCount);
1765 if NetUseMaster then g_Net_Slist_ServerPlayerLeaves();
1766 end;
1767 end;
1768 end;
1769 end;
1772 //**************************************************************************
1773 //
1774 // CLIENT FUNCTIONS
1775 //
1776 //**************************************************************************
1778 procedure g_Net_Disconnect(Forced: Boolean = False);
1779 begin
1780 if NetMode <> NET_CLIENT then Exit;
1781 if (NetHost = nil) or (NetPeer = nil) then Exit;
1783 if not Forced then
1784 begin
1785 enet_peer_disconnect(NetPeer, NET_DISC_NONE);
1787 while (enet_host_service(NetHost, @NetEvent, 1500) > 0) do
1788 begin
1789 if (NetEvent.kind = ENET_EVENT_TYPE_DISCONNECT) then
1790 begin
1791 NetPeer := nil;
1792 break;
1793 end;
1795 if (NetEvent.kind = ENET_EVENT_TYPE_RECEIVE) then
1796 enet_packet_destroy(NetEvent.packet);
1797 end;
1799 if NetPeer <> nil then
1800 begin
1801 enet_peer_reset(NetPeer);
1802 NetPeer := nil;
1803 end;
1804 end
1805 else
1806 begin
1807 e_WriteLog('NET: Kicked from server: ' + IntToStr(NetEvent.data), TMsgType.Notify);
1808 if (NetEvent.data <= NET_DISC_MAX) then
1809 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_KICK] +
1810 _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + NetEvent.data)], True);
1811 end;
1813 if NetHost <> nil then
1814 begin
1815 enet_host_destroy(NetHost);
1816 NetHost := nil;
1817 end;
1818 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_CLIENT_DISC]);
1820 g_Net_Cleanup;
1821 e_WriteLog('NET: Disconnected', TMsgType.Notify);
1822 end;
1824 procedure g_Net_Client_Send(Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
1825 var
1826 T: Integer;
1827 begin
1828 if (Reliable) then
1829 T := NET_RELIABLE
1830 else
1831 T := NET_UNRELIABLE;
1833 // write size first
1834 NetBuf[T].Write(Integer(NetOut.CurSize));
1835 NetBuf[T].Write(NetOut);
1837 if NetDump then g_Net_DumpSendBuffer();
1838 NetOut.Clear();
1839 g_Net_Flush(); // FIXME: for now, send immediately
1840 end;
1842 function g_Net_Client_Update(): enet_size_t;
1843 begin
1844 Result := 0;
1845 while (NetHost <> nil) and (enet_host_service(NetHost, @NetEvent, 0) > 0) do
1846 begin
1847 case NetEvent.kind of
1848 ENET_EVENT_TYPE_RECEIVE:
1849 begin
1850 if (NetEvent.channelID = NET_CHAN_DOWNLOAD_EX) then continue; // ignore all download packets, they're processed by separate code
1851 if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
1852 g_Net_Client_HandlePacket(NetEvent.packet, g_Net_ClientMsgHandler);
1853 end;
1855 ENET_EVENT_TYPE_DISCONNECT:
1856 begin
1857 g_Net_Disconnect(True);
1858 Result := 1;
1859 Exit;
1860 end;
1861 end;
1862 end
1863 end;
1865 function g_Net_Client_UpdateWhileLoading(): enet_size_t;
1866 begin
1867 Result := 0;
1868 while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
1869 begin
1870 case NetEvent.kind of
1871 ENET_EVENT_TYPE_RECEIVE:
1872 begin
1873 if (NetEvent.channelID = NET_CHAN_DOWNLOAD_EX) then continue; // ignore all download packets, they're processed by separate code
1874 if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
1875 g_Net_Client_HandlePacket(NetEvent.packet, g_Net_ClientLightMsgHandler);
1876 end;
1878 ENET_EVENT_TYPE_DISCONNECT:
1879 begin
1880 g_Net_Disconnect(True);
1881 Result := 1;
1882 Exit;
1883 end;
1884 end;
1885 end;
1886 g_Net_Flush();
1887 end;
1889 function g_Net_Connect(IP: string; Port: enet_uint16): Boolean;
1890 var
1891 OuterLoop: Boolean;
1892 TimeoutTime, T: Int64;
1893 begin
1894 if NetMode <> NET_NONE then
1895 begin
1896 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_ERR_INGAME], True);
1897 Result := False;
1898 Exit;
1899 end;
1901 Result := True;
1903 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_CLIENT_CONN],
1904 [IP, Port]));
1905 if not NetInitDone then
1906 begin
1907 if (not g_Net_Init()) then
1908 begin
1909 g_Console_Add(_lc[I_NET_MSG_FERROR] + _lc[I_NET_ERR_ENET], True);
1910 Result := False;
1911 Exit;
1912 end
1913 else
1914 NetInitDone := True;
1915 end;
1917 NetHost := enet_host_create(nil, 1, NET_CHANS, 0, 0);
1919 if (NetHost = nil) then
1920 begin
1921 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT], True);
1922 g_Net_Cleanup;
1923 Result := False;
1924 Exit;
1925 end;
1927 enet_address_set_host(@NetAddr, PChar(Addr(IP[1])));
1928 NetAddr.port := Port;
1930 NetPeer := enet_host_connect(NetHost, @NetAddr, NET_CHANS, NET_PROTOCOL_VER);
1932 if (NetPeer = nil) then
1933 begin
1934 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT], True);
1935 enet_host_destroy(NetHost);
1936 g_Net_Cleanup;
1937 Result := False;
1938 Exit;
1939 end;
1941 // предупредить что ждем слишком долго через N секунд
1942 TimeoutTime := sys_GetTicks() + NET_CONNECT_TIMEOUT;
1944 OuterLoop := True;
1945 while OuterLoop do
1946 begin
1947 while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
1948 begin
1949 if (NetEvent.kind = ENET_EVENT_TYPE_CONNECT) then
1950 begin
1951 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_CLIENT_DONE]);
1952 NetMode := NET_CLIENT;
1953 NetOut.Clear();
1954 enet_peer_timeout(NetPeer, ENET_PEER_TIMEOUT_LIMIT * 2, ENET_PEER_TIMEOUT_MINIMUM * 2, ENET_PEER_TIMEOUT_MAXIMUM * 2);
1955 NetClientIP := IP;
1956 NetClientPort := Port;
1957 if NetDump then
1958 g_Net_DumpStart();
1959 Exit;
1960 end;
1961 end;
1963 T := sys_GetTicks();
1964 if T > TimeoutTime then
1965 begin
1966 TimeoutTime := T + NET_CONNECT_TIMEOUT * 100; // одного предупреждения хватит
1967 g_Console_Add(_lc[I_NET_MSG_TIMEOUT_WARN], True);
1968 g_Console_Add(Format(_lc[I_NET_MSG_PORTS], [Integer(Port), Integer(NET_PING_PORT)]), True);
1969 end;
1971 ProcessLoading(true);
1973 if e_KeyPressed(IK_SPACE) or e_KeyPressed(IK_ESCAPE) or e_KeyPressed(VK_ESCAPE) or
1974 e_KeyPressed(JOY0_JUMP) or e_KeyPressed(JOY1_JUMP) or e_KeyPressed(JOY2_JUMP) or e_KeyPressed(JOY3_JUMP) then
1975 OuterLoop := False;
1976 end;
1978 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_TIMEOUT], True);
1979 g_Console_Add(Format(_lc[I_NET_MSG_PORTS], [Integer(Port), Integer(NET_PING_PORT)]), True);
1980 if NetPeer <> nil then enet_peer_reset(NetPeer);
1981 if NetHost <> nil then
1982 begin
1983 enet_host_destroy(NetHost);
1984 NetHost := nil;
1985 end;
1986 g_Net_Cleanup();
1987 Result := False;
1988 end;
1990 function IpToStr(IP: LongWord): string;
1991 var
1992 Ptr: Pointer;
1993 begin
1994 Ptr := Addr(IP);
1995 Result := IntToStr(PByte(Ptr + 0)^) + '.';
1996 Result := Result + IntToStr(PByte(Ptr + 1)^) + '.';
1997 Result := Result + IntToStr(PByte(Ptr + 2)^) + '.';
1998 Result := Result + IntToStr(PByte(Ptr + 3)^);
1999 end;
2001 function StrToIp(IPstr: string; var IP: LongWord): Boolean;
2002 var
2003 EAddr: ENetAddress;
2004 begin
2005 Result := enet_address_set_host(@EAddr, PChar(@IPstr[1])) = 0;
2006 IP := EAddr.host;
2007 end;
2009 function g_Net_Client_ByName(Name: string): pTNetClient;
2010 var
2011 a: Integer;
2012 pl: TPlayer;
2013 begin
2014 Result := nil;
2015 for a := Low(NetClients) to High(NetClients) do
2016 if (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
2017 begin
2018 pl := g_Player_Get(NetClients[a].Player);
2019 if pl = nil then continue;
2020 if Copy(LowerCase(pl.Name), 1, Length(Name)) <> LowerCase(Name) then continue;
2021 if NetClients[a].Peer <> nil then
2022 begin
2023 Result := @NetClients[a];
2024 Exit;
2025 end;
2026 end;
2027 end;
2029 function g_Net_Client_ByPlayer(PID: Word): pTNetClient;
2030 var
2031 a: Integer;
2032 begin
2033 Result := nil;
2034 for a := Low(NetClients) to High(NetClients) do
2035 if (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
2036 if NetClients[a].Player = PID then
2037 begin
2038 Result := @NetClients[a];
2039 Exit;
2040 end;
2041 end;
2043 function g_Net_ClientName_ByID(ID: Integer): string;
2044 var
2045 a: Integer;
2046 pl: TPlayer;
2047 begin
2048 Result := '';
2049 if ID = NET_EVERYONE then
2050 Exit;
2051 for a := Low(NetClients) to High(NetClients) do
2052 if (NetClients[a].ID = ID) and (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
2053 begin
2054 pl := g_Player_Get(NetClients[a].Player);
2055 if pl = nil then Exit;
2056 Result := pl.Name;
2057 end;
2058 end;
2060 procedure g_Net_SendData(Data: AByte; peer: pENetPeer; Reliable: Boolean; Chan: Byte = NET_CHAN_DOWNLOAD);
2061 var
2062 P: pENetPacket;
2063 F: enet_uint32;
2064 dataLength: Cardinal;
2065 begin
2066 dataLength := Length(Data);
2068 if (Reliable) then
2069 F := LongWord(ENET_PACKET_FLAG_RELIABLE)
2070 else
2071 F := 0;
2073 if (peer <> nil) then
2074 begin
2075 P := enet_packet_create(@Data[0], dataLength, F);
2076 if not Assigned(P) then Exit;
2077 enet_peer_send(peer, Chan, P);
2078 end
2079 else
2080 begin
2081 P := enet_packet_create(@Data[0], dataLength, F);
2082 if not Assigned(P) then Exit;
2083 enet_host_broadcast(NetHost, Chan, P);
2084 end;
2086 enet_host_flush(NetHost);
2087 end;
2089 function g_Net_IsHostBanned(IP: LongWord; Perm: Boolean = False): Boolean;
2090 var
2091 I: Integer;
2092 begin
2093 Result := False;
2094 if NetBannedHosts = nil then
2095 Exit;
2096 for I := 0 to High(NetBannedHosts) do
2097 if (NetBannedHosts[I].IP = IP) and ((not Perm) or (NetBannedHosts[I].Perm)) then
2098 begin
2099 Result := True;
2100 break;
2101 end;
2102 end;
2104 procedure g_Net_BanHost(IP: LongWord; Perm: Boolean = True); overload;
2105 var
2106 I, P: Integer;
2107 begin
2108 if IP = 0 then
2109 Exit;
2110 if g_Net_IsHostBanned(IP, Perm) then
2111 Exit;
2113 P := -1;
2114 for I := Low(NetBannedHosts) to High(NetBannedHosts) do
2115 if NetBannedHosts[I].IP = 0 then
2116 begin
2117 P := I;
2118 break;
2119 end;
2121 if P < 0 then
2122 begin
2123 SetLength(NetBannedHosts, Length(NetBannedHosts) + 1);
2124 P := High(NetBannedHosts);
2125 end;
2127 NetBannedHosts[P].IP := IP;
2128 NetBannedHosts[P].Perm := Perm;
2129 end;
2131 procedure g_Net_BanHost(IP: string; Perm: Boolean = True); overload;
2132 var
2133 a: LongWord;
2134 b: Boolean;
2135 begin
2136 b := StrToIp(IP, a);
2137 if b then
2138 g_Net_BanHost(a, Perm);
2139 end;
2141 procedure g_Net_UnbanNonPermHosts();
2142 var
2143 I: Integer;
2144 begin
2145 if NetBannedHosts = nil then
2146 Exit;
2147 for I := Low(NetBannedHosts) to High(NetBannedHosts) do
2148 if (NetBannedHosts[I].IP > 0) and not NetBannedHosts[I].Perm then
2149 begin
2150 NetBannedHosts[I].IP := 0;
2151 NetBannedHosts[I].Perm := True;
2152 end;
2153 end;
2155 function g_Net_UnbanHost(IP: string): Boolean; overload;
2156 var
2157 a: LongWord;
2158 begin
2159 Result := StrToIp(IP, a);
2160 if Result then
2161 Result := g_Net_UnbanHost(a);
2162 end;
2164 function g_Net_UnbanHost(IP: LongWord): Boolean; overload;
2165 var
2166 I: Integer;
2167 begin
2168 Result := False;
2169 if IP = 0 then
2170 Exit;
2171 if NetBannedHosts = nil then
2172 Exit;
2173 for I := 0 to High(NetBannedHosts) do
2174 if NetBannedHosts[I].IP = IP then
2175 begin
2176 NetBannedHosts[I].IP := 0;
2177 NetBannedHosts[I].Perm := True;
2178 Result := True;
2179 // no break here to clear all bans of this host, perm and non-perm
2180 end;
2181 end;
2183 procedure g_Net_SaveBanList();
2184 var
2185 F: TextFile;
2186 I: Integer;
2187 path: AnsiString;
2188 begin
2189 path := e_GetWriteableDir(DataDirs);
2190 if path <> '' then
2191 begin
2192 path := e_CatPath(path, BANLIST_FILENAME);
2193 Assign(F, path);
2194 Rewrite(F);
2195 if NetBannedHosts <> nil then
2196 for I := 0 to High(NetBannedHosts) do
2197 if NetBannedHosts[I].Perm and (NetBannedHosts[I].IP > 0) then
2198 Writeln(F, IpToStr(NetBannedHosts[I].IP));
2199 CloseFile(F)
2200 end
2201 end;
2203 procedure g_Net_DumpStart();
2204 begin
2205 if NetMode = NET_SERVER then
2206 NetDumpFile := e_CreateResource(LogDirs, NETDUMP_FILENAME + '_server')
2207 else
2208 NetDumpFile := e_CreateResource(LogDirs, NETDUMP_FILENAME + '_client');
2209 end;
2211 procedure g_Net_DumpSendBuffer();
2212 begin
2213 writeInt(NetDumpFile, gTime);
2214 writeInt(NetDumpFile, LongWord(NetOut.CurSize));
2215 writeInt(NetDumpFile, Byte(1));
2216 NetDumpFile.WriteBuffer(NetOut.Data^, NetOut.CurSize);
2217 end;
2219 procedure g_Net_DumpRecvBuffer(Buf: penet_uint8; Len: LongWord);
2220 begin
2221 if (Buf = nil) or (Len = 0) then Exit;
2222 writeInt(NetDumpFile, gTime);
2223 writeInt(NetDumpFile, Len);
2224 writeInt(NetDumpFile, Byte(0));
2225 NetDumpFile.WriteBuffer(Buf^, Len);
2226 end;
2228 procedure g_Net_DumpEnd();
2229 begin
2230 NetDumpFile.Free();
2231 NetDumpFile := nil;
2232 end;
2234 function g_Net_ForwardPorts(ForwardPongPort: Boolean = True): Boolean;
2235 {$IFDEF USE_MINIUPNPC}
2236 var
2237 DevList: PUPNPDev;
2238 Urls: TUPNPUrls;
2239 Data: TIGDDatas;
2240 LanAddr: array [0..255] of Char;
2241 StrPort: AnsiString;
2242 Err, I: Integer;
2243 begin
2244 Result := False;
2246 if NetHost = nil then
2247 exit;
2249 if NetPortForwarded = NetHost.address.port then
2250 begin
2251 Result := True;
2252 exit;
2253 end;
2255 NetPongForwarded := False;
2256 NetPortForwarded := 0;
2258 DevList := upnpDiscover(1000, nil, nil, 0, 0, 2, Addr(Err));
2259 if DevList = nil then
2260 begin
2261 conwritefln('port forwarding failed: upnpDiscover() failed: %d', [Err]);
2262 exit;
2263 end;
2265 I := UPNP_GetValidIGD(DevList, @Urls, @Data, Addr(LanAddr[0]), 256);
2267 if I = 0 then
2268 begin
2269 conwriteln('port forwarding failed: could not find an IGD device on this LAN');
2270 FreeUPNPDevList(DevList);
2271 FreeUPNPUrls(@Urls);
2272 exit;
2273 end;
2275 StrPort := IntToStr(NetHost.address.port);
2276 I := UPNP_AddPortMapping(
2277 Urls.controlURL, Addr(data.first.servicetype[1]),
2278 PChar(StrPort), PChar(StrPort), Addr(LanAddr[0]), PChar('D2DF'),
2279 PChar('UDP'), nil, PChar('0')
2280 );
2282 if I <> 0 then
2283 begin
2284 conwritefln('forwarding port %d failed: error %d', [NetHost.address.port, I]);
2285 FreeUPNPDevList(DevList);
2286 FreeUPNPUrls(@Urls);
2287 exit;
2288 end;
2290 if ForwardPongPort then
2291 begin
2292 StrPort := IntToStr(NET_PING_PORT);
2293 I := UPNP_AddPortMapping(
2294 Urls.controlURL, Addr(data.first.servicetype[1]),
2295 PChar(StrPort), PChar(StrPort), Addr(LanAddr[0]), PChar('D2DF'),
2296 PChar('UDP'), nil, PChar('0')
2297 );
2299 if I <> 0 then
2300 begin
2301 conwritefln('forwarding port %d failed: error %d', [NET_PING_PORT, I]);
2302 NetPongForwarded := False;
2303 end
2304 else
2305 begin
2306 conwritefln('forwarded port %d successfully', [NET_PING_PORT]);
2307 NetPongForwarded := True;
2308 end;
2309 end;
2311 conwritefln('forwarded port %d successfully', [NetHost.address.port]);
2312 NetIGDControl := AnsiString(Urls.controlURL);
2313 NetIGDService := data.first.servicetype;
2314 NetPortForwarded := NetHost.address.port;
2316 FreeUPNPDevList(DevList);
2317 FreeUPNPUrls(@Urls);
2318 Result := True;
2319 end;
2320 {$ELSE}
2321 begin
2322 Result := False;
2323 end;
2324 {$ENDIF}
2326 procedure g_Net_UnforwardPorts();
2327 {$IFDEF USE_MINIUPNPC}
2328 var
2329 I: Integer;
2330 StrPort: AnsiString;
2331 begin
2332 if NetPortForwarded = 0 then Exit;
2334 conwriteln('unforwarding ports...');
2336 StrPort := IntToStr(NetPortForwarded);
2337 I := UPNP_DeletePortMapping(
2338 PChar(NetIGDControl), Addr(NetIGDService[1]),
2339 PChar(StrPort), PChar('UDP'), nil
2340 );
2341 conwritefln(' port %d: %d', [NetPortForwarded, I]);
2343 if NetPongForwarded then
2344 begin
2345 NetPongForwarded := False;
2346 StrPort := IntToStr(NET_PING_PORT);
2347 I := UPNP_DeletePortMapping(
2348 PChar(NetIGDControl), Addr(NetIGDService[1]),
2349 PChar(StrPort), PChar('UDP'), nil
2350 );
2351 conwritefln(' port %d: %d', [NET_PING_PORT, I]);
2352 end;
2354 NetPortForwarded := 0;
2355 end;
2356 {$ELSE}
2357 begin
2358 end;
2359 {$ENDIF}
2361 procedure NetServerCVars(P: SSArray);
2362 var
2363 cmd, s: string;
2364 a, b: Integer;
2365 begin
2366 cmd := LowerCase(P[0]);
2367 case cmd of
2368 'sv_name':
2369 begin
2370 if (Length(P) > 1) and (Length(P[1]) > 0) then
2371 begin
2372 NetServerName := P[1];
2373 if Length(NetServerName) > 64 then
2374 SetLength(NetServerName, 64);
2375 g_Net_Slist_ServerRenamed();
2376 end;
2377 g_Console_Add(cmd + ' "' + NetServerName + '"');
2378 end;
2379 'sv_passwd':
2380 begin
2381 if (Length(P) > 1) and (Length(P[1]) > 0) then
2382 begin
2383 NetPassword := P[1];
2384 if Length(NetPassword) > 24 then
2385 SetLength(NetPassword, 24);
2386 g_Net_Slist_ServerRenamed();
2387 end;
2388 g_Console_Add(cmd + ' "' + AnsiLowerCase(NetPassword) + '"');
2389 end;
2390 'sv_maxplrs':
2391 begin
2392 if (Length(P) > 1) then
2393 begin
2394 NetMaxClients := nclamp(StrToIntDef(P[1], NetMaxClients), 1, NET_MAXCLIENTS);
2395 if g_Game_IsServer and g_Game_IsNet then
2396 begin
2397 b := 0;
2398 for a := 0 to High(NetClients) do
2399 begin
2400 if NetClients[a].Used then
2401 begin
2402 Inc(b);
2403 if b > NetMaxClients then
2404 begin
2405 s := g_Player_Get(NetClients[a].Player).Name;
2406 enet_peer_disconnect(NetClients[a].Peer, NET_DISC_FULL);
2407 g_Console_Add(Format(_lc[I_PLAYER_KICK], [s]));
2408 MH_SEND_GameEvent(NET_EV_PLAYER_KICK, 0, s);
2409 end;
2410 end;
2411 end;
2412 g_Net_Slist_ServerRenamed();
2413 end;
2414 end;
2415 g_Console_Add(cmd + ' ' + IntToStr(NetMaxClients));
2416 end;
2417 'sv_public':
2418 begin
2419 if (Length(P) > 1) then
2420 begin
2421 NetUseMaster := StrToIntDef(P[1], Byte(NetUseMaster)) <> 0;
2422 if NetUseMaster then g_Net_Slist_Public() else g_Net_Slist_Private();
2423 end;
2424 g_Console_Add(cmd + ' ' + IntToStr(Byte(NetUseMaster)));
2425 end;
2426 'sv_port':
2427 begin
2428 if (Length(P) > 1) then
2429 begin
2430 if not g_Game_IsNet then
2431 NetPort := nclamp(StrToIntDef(P[1], NetPort), 0, $FFFF)
2432 else
2433 g_Console_Add(_lc[I_MSG_NOT_NETGAME]);
2434 end;
2435 g_Console_Add(cmd + ' ' + IntToStr(Ord(NetUseMaster)));
2436 end;
2437 end;
2438 end;
2440 initialization
2441 conRegVar('cl_downloadtimeout', @g_Net_DownloadTimeout, 0.0, 1000000.0, '', 'timeout in seconds, 0 to disable it');
2442 conRegVar('cl_predictself', @NetPredictSelf, '', 'predict local player');
2443 conRegVar('cl_forceplayerupdate', @NetForcePlayerUpdate, '', 'update net players on NET_MSG_PLRPOS');
2444 conRegVar('cl_interp', @NetInterpLevel, '', 'net player interpolation steps');
2445 conRegVar('cl_last_ip', @NetClientIP, '', 'address of the last you have connected to');
2446 conRegVar('cl_last_port', @NetClientPort, '', 'port of the last server you have connected to');
2447 conRegVar('cl_deafen', @NetDeafLevel, '', 'filter server messages (0-3)');
2449 conRegVar('sv_forwardports', @NetForwardPorts, '', 'forward server port using miniupnpc (requires server restart)');
2450 conRegVar('sv_rcon', @NetAllowRCON, '', 'enable remote console');
2451 conRegVar('sv_rcon_password', @NetRCONPassword, '', 'remote console password');
2452 conRegVar('sv_update_interval', @NetUpdateRate, '', 'unreliable update interval');
2453 conRegVar('sv_reliable_interval', @NetRelupdRate, '', 'reliable update interval');
2454 conRegVar('sv_master_interval', @NetMasterRate, '', 'master server update interval');
2456 conRegVar('net_master_list', @NetMasterList, '', 'list of master servers');
2458 SetLength(NetClients, 0);
2459 g_Net_DownloadTimeout := 60;
2460 NetIn.Alloc(NET_BUFSIZE);
2461 NetOut.Alloc(NET_BUFSIZE);
2462 NetBuf[NET_UNRELIABLE].Alloc(NET_BUFSIZE*2);
2463 NetBuf[NET_RELIABLE].Alloc(NET_BUFSIZE*2);
2464 trans_omsg.Alloc(NET_BUFSIZE);
2465 finalization
2466 NetIn.Free();
2467 NetOut.Free();
2468 NetBuf[NET_UNRELIABLE].Free();
2469 NetBuf[NET_RELIABLE].Free();
2470 end.