DEADSOFTWARE

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