DEADSOFTWARE

net: started master-server communication rewrite (phase 1: master i/o moved to separa...
[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, ENet, Classes, md5, MAPDEF{$IFDEF USE_MINIUPNPC}, miniupnpc;{$ELSE};{$ENDIF}
23 const
24 NET_PROTOCOL_VER = 182;
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 {$IF DEFINED(FREEBSD) OR DEFINED(DARWIN)}
76 NilThreadId = nil;
77 {$ELSE}
78 NilThreadId = 0;
79 {$ENDIF}
81 type
82 TNetMapResourceInfo = record
83 wadName: AnsiString; // wad file name, without a path
84 size: Integer; // wad file size (-1: size and hash are not known)
85 hash: TMD5Digest; // wad hash
86 end;
88 TNetMapResourceInfoArray = array of TNetMapResourceInfo;
90 TNetFileTransfer = record
91 diskName: string;
92 hash: TMD5Digest;
93 stream: TStream;
94 size: Integer; // file size in bytes
95 chunkSize: Integer;
96 lastSentChunk: Integer;
97 lastAckChunk: Integer;
98 lastAckTime: Int64; // msecs; if not "in progress", we're waiting for the first ack
99 inProgress: Boolean;
100 diskBuffer: PChar; // of `chunkSize` bytes
101 resumed: Boolean;
102 end;
104 TNetClient = record
105 ID: Byte;
106 Used: Boolean;
107 State: Byte;
108 Peer: pENetPeer;
109 Player: Word;
110 RequestedFullUpdate: Boolean;
111 WaitForFirstSpawn: Boolean; // set to `true` in server, used to spawn a player on first full state request
112 RCONAuth: Boolean;
113 Voted: Boolean;
114 Transfer: TNetFileTransfer; // only one transfer may be active
115 NetOut: array [0..1] of TMsg;
116 end;
117 TBanRecord = record
118 IP: LongWord;
119 Perm: Boolean;
120 end;
121 pTNetClient = ^TNetClient;
123 AByte = array of Byte;
125 var
126 NetInitDone: Boolean = False;
127 NetMode: Byte = NET_NONE;
128 NetDump: Boolean = False;
130 NetServerName: string = 'Unnamed Server';
131 NetPassword: string = '';
132 NetPort: Word = 25666;
134 NetAllowRCON: Boolean = False;
135 NetRCONPassword: string = '';
137 NetTimeToUpdate: Cardinal = 0;
138 NetTimeToReliable: Cardinal = 0;
139 NetTimeToMaster: Cardinal = 0;
141 NetHost: pENetHost = nil;
142 NetPeer: pENetPeer = nil;
143 NetEvent: ENetEvent;
144 NetAddr: ENetAddress;
146 NetPongAddr: ENetAddress;
147 NetPongSock: ENetSocket = ENET_SOCKET_NULL;
149 NetUseMaster: Boolean = True;
150 NetSlistAddr: ENetAddress;
151 NetSlistIP: string = 'mpms.doom2d.org';
152 NetSlistPort: Word = 25665;
154 NetClientIP: string = '127.0.0.1';
155 NetClientPort: Word = 25666;
157 NetIn, NetOut: TMsg;
158 NetBuf: array [0..1] of TMsg;
160 NetClients: array of TNetClient;
161 NetClientCount: Byte = 0;
162 NetMaxClients: Byte = 255;
163 NetBannedHosts: array of TBanRecord;
165 NetState: Integer = NET_STATE_NONE;
167 NetMyID: Integer = -1;
168 NetPlrUID1: Integer = -1;
169 NetPlrUID2: Integer = -1;
171 NetInterpLevel: Integer = 1;
172 NetUpdateRate: Cardinal = 0; // as soon as possible
173 NetRelupdRate: Cardinal = 18; // around two times a second
174 NetMasterRate: Cardinal = 60000;
176 NetForcePlayerUpdate: Boolean = False;
177 NetPredictSelf: Boolean = True;
178 NetForwardPorts: Boolean = False;
180 NetGotEverything: Boolean = False;
181 NetGotKeys: Boolean = False;
183 {$IFDEF USE_MINIUPNPC}
184 NetPortForwarded: Word = 0;
185 NetPongForwarded: Boolean = False;
186 NetIGDControl: AnsiString;
187 NetIGDService: TURLStr;
188 {$ENDIF}
190 NetPortThread: TThreadID = NilThreadId;
192 NetDumpFile: TStream;
194 g_Res_received_map_start: Integer = 0; // set if we received "map change" event
197 function g_Net_Init(): Boolean;
198 procedure g_Net_Cleanup();
199 procedure g_Net_Free();
200 procedure g_Net_Flush();
202 function g_Net_Host(IPAddr: LongWord; Port: enet_uint16; MaxClients: Cardinal = 16): Boolean;
203 procedure g_Net_Host_Die();
204 procedure g_Net_Host_Send(ID: Integer; Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
205 function g_Net_Host_Update(): enet_size_t;
207 function g_Net_Connect(IP: string; Port: enet_uint16): Boolean;
208 procedure g_Net_Disconnect(Forced: Boolean = False);
209 procedure g_Net_Client_Send(Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
210 function g_Net_Client_Update(): enet_size_t;
211 function g_Net_Client_UpdateWhileLoading(): enet_size_t;
213 function g_Net_Client_ByName(Name: string): pTNetClient;
214 function g_Net_Client_ByPlayer(PID: Word): pTNetClient;
215 function g_Net_ClientName_ByID(ID: Integer): string;
217 procedure g_Net_SendData(Data: AByte; peer: pENetPeer; Reliable: Boolean; Chan: Byte = NET_CHAN_DOWNLOAD);
218 //function g_Net_Wait_Event(msgId: Word): TMemoryStream;
219 //function g_Net_Wait_FileInfo (var tf: TNetFileTransfer; asMap: Boolean; out resList: TStringList): Integer;
221 function IpToStr(IP: LongWord): string;
222 function StrToIp(IPstr: string; var IP: LongWord): Boolean;
224 function g_Net_IsHostBanned(IP: LongWord; Perm: Boolean = False): Boolean;
225 procedure g_Net_BanHost(IP: LongWord; Perm: Boolean = True); overload;
226 procedure g_Net_BanHost(IP: string; Perm: Boolean = True); overload;
227 function g_Net_UnbanHost(IP: string): Boolean; overload;
228 function g_Net_UnbanHost(IP: LongWord): Boolean; overload;
229 procedure g_Net_UnbanNonPermHosts();
230 procedure g_Net_SaveBanList();
232 procedure g_Net_DumpStart();
233 procedure g_Net_DumpSendBuffer();
234 procedure g_Net_DumpRecvBuffer(Buf: penet_uint8; Len: LongWord);
235 procedure g_Net_DumpEnd();
237 function g_Net_ForwardPorts(ForwardPongPort: Boolean = True): Boolean;
238 procedure g_Net_UnforwardPorts();
240 function g_Net_UserRequestExit: Boolean;
242 function g_Net_Wait_MapInfo (var tf: TNetFileTransfer; var resList: TNetMapResourceInfoArray): Integer;
243 function g_Net_RequestResFileInfo (resIndex: LongInt; out tf: TNetFileTransfer): Integer;
244 function g_Net_AbortResTransfer (var tf: TNetFileTransfer): Boolean;
245 function g_Net_ReceiveResourceFile (resIndex: LongInt; var tf: TNetFileTransfer; strm: TStream): Integer;
248 implementation
250 uses
251 SysUtils,
252 e_input, g_nethandler, g_netmsg, g_netmaster, g_player, g_window, g_console,
253 g_main, g_game, g_language, g_weapons, utils, ctypes, g_system,
254 g_map;
256 const
257 FILE_CHUNK_SIZE = 8192;
259 var
260 g_Net_DownloadTimeout: Single;
261 trans_omsg: TMsg;
264 //**************************************************************************
265 //
266 // SERVICE FUNCTIONS
267 //
268 //**************************************************************************
270 procedure clearNetClientTransfers (var nc: TNetClient);
271 begin
272 nc.Transfer.stream.Free;
273 nc.Transfer.diskName := ''; // just in case
274 if (nc.Transfer.diskBuffer <> nil) then FreeMem(nc.Transfer.diskBuffer);
275 nc.Transfer.stream := nil;
276 nc.Transfer.diskBuffer := nil;
277 end;
280 procedure clearNetClient (var nc: TNetClient);
281 begin
282 clearNetClientTransfers(nc);
283 end;
286 procedure clearNetClients (clearArray: Boolean);
287 var
288 f: Integer;
289 begin
290 for f := Low(NetClients) to High(NetClients) do clearNetClient(NetClients[f]);
291 if (clearArray) then SetLength(NetClients, 0);
292 end;
295 function g_Net_UserRequestExit (): Boolean;
296 begin
297 Result := {e_KeyPressed(IK_SPACE) or}
298 e_KeyPressed(IK_ESCAPE) or
299 e_KeyPressed(VK_ESCAPE) or
300 e_KeyPressed(JOY0_JUMP) or
301 e_KeyPressed(JOY1_JUMP) or
302 e_KeyPressed(JOY2_JUMP) or
303 e_KeyPressed(JOY3_JUMP)
304 end;
307 //**************************************************************************
308 //
309 // file transfer declaraions and host packet processor
310 //
311 //**************************************************************************
313 const
314 // server packet type
315 NTF_SERVER_DONE = 10; // done with this file
316 NTF_SERVER_FILE_INFO = 11; // sent after client request
317 NTF_SERVER_CHUNK = 12; // next chunk; chunk number follows
318 NTF_SERVER_ABORT = 13; // server abort
319 NTF_SERVER_MAP_INFO = 14;
321 // client packet type
322 NTF_CLIENT_MAP_REQUEST = 100; // map file request; also, returns list of additional wads to download
323 NTF_CLIENT_FILE_REQUEST = 101; // resource file request (by index)
324 NTF_CLIENT_ABORT = 102; // do not send requested file, or abort current transfer
325 NTF_CLIENT_START = 103; // start transfer; client may resume download by sending non-zero starting chunk
326 NTF_CLIENT_ACK = 104; // chunk ack; chunk number follows
329 // disconnect client due to some file transfer error
330 procedure killClientByFT (var nc: TNetClient);
331 begin
332 e_LogWritefln('disconnected client #%d due to file transfer error', [nc.ID], TMsgType.Warning);
333 enet_peer_disconnect(nc.Peer, NET_DISC_FILE_TIMEOUT);
334 clearNetClientTransfers(nc);
335 end;
338 // send file transfer message from server to client
339 function ftransSendServerMsg (var nc: TNetClient; var m: TMsg): Boolean;
340 var
341 pkt: PENetPacket;
342 begin
343 result := false;
344 if (m.CurSize < 1) then exit;
345 pkt := enet_packet_create(m.Data, m.CurSize, ENET_PACKET_FLAG_RELIABLE);
346 if not Assigned(pkt) then begin killClientByFT(nc); exit; end;
347 if (enet_peer_send(nc.Peer, NET_CHAN_DOWNLOAD_EX, pkt) <> 0) then begin killClientByFT(nc); exit; end;
348 result := true;
349 end;
352 // send file transfer message from client to server
353 function ftransSendClientMsg (var m: TMsg): Boolean;
354 var
355 pkt: PENetPacket;
356 begin
357 result := false;
358 if (m.CurSize < 1) then exit;
359 pkt := enet_packet_create(m.Data, m.CurSize, ENET_PACKET_FLAG_RELIABLE);
360 if not Assigned(pkt) then exit;
361 if (enet_peer_send(NetPeer, NET_CHAN_DOWNLOAD_EX, pkt) <> 0) then exit;
362 result := true;
363 end;
366 // file chunk sender
367 procedure ProcessChunkSend (var nc: TNetClient);
368 var
369 tf: ^TNetFileTransfer;
370 ct: Int64;
371 chunks: Integer;
372 rd: Integer;
373 begin
374 tf := @nc.Transfer;
375 if (tf.stream = nil) then exit;
376 ct := GetTimerMS();
377 // arbitrary timeout number
378 if (ct-tf.lastAckTime >= 5000) then
379 begin
380 killClientByFT(nc);
381 exit;
382 end;
383 // check if we need to send something
384 if (not tf.inProgress) then exit; // waiting for the initial ack
385 // ok, we're sending chunks
386 if (tf.lastAckChunk <> tf.lastSentChunk) then exit;
387 Inc(tf.lastSentChunk);
388 // do it one chunk at a time; client ack will advance our chunk counter
389 chunks := (tf.size+tf.chunkSize-1) div tf.chunkSize;
391 if (tf.lastSentChunk > chunks) then
392 begin
393 killClientByFT(nc);
394 exit;
395 end;
397 trans_omsg.Clear();
398 if (tf.lastSentChunk = chunks) then
399 begin
400 // we're done with this file
401 e_LogWritefln('download: client #%d, DONE sending chunks #%d/#%d', [nc.ID, tf.lastSentChunk, chunks]);
402 trans_omsg.Write(Byte(NTF_SERVER_DONE));
403 clearNetClientTransfers(nc);
404 end
405 else
406 begin
407 // packet type
408 trans_omsg.Write(Byte(NTF_SERVER_CHUNK));
409 trans_omsg.Write(LongInt(tf.lastSentChunk));
410 // read chunk
411 rd := tf.size-(tf.lastSentChunk*tf.chunkSize);
412 if (rd > tf.chunkSize) then rd := tf.chunkSize;
413 trans_omsg.Write(LongInt(rd));
414 //e_LogWritefln('download: client #%d, sending chunk #%d/#%d (%d bytes)', [nc.ID, tf.lastSentChunk, chunks, rd]);
415 //FIXME: check for errors here
416 try
417 tf.stream.Seek(tf.lastSentChunk*tf.chunkSize, soFromBeginning);
418 tf.stream.ReadBuffer(tf.diskBuffer^, rd);
419 trans_omsg.WriteData(tf.diskBuffer, rd);
420 except // sorry
421 killClientByFT(nc);
422 exit;
423 end;
424 end;
425 // send packet
426 ftransSendServerMsg(nc, trans_omsg);
427 end;
430 // server file transfer packet processor
431 // received packet is in `NetEvent`
432 procedure ProcessDownloadExPacket ();
433 var
434 f: Integer;
435 nc: ^TNetClient;
436 nid: Integer = -1;
437 msg: TMsg;
438 cmd: Byte;
439 tf: ^TNetFileTransfer;
440 fname: string;
441 chunk: Integer;
442 ridx: Integer;
443 dfn: AnsiString;
444 md5: TMD5Digest;
445 //st: TStream;
446 size: LongInt;
447 fi: TDiskFileInfo;
448 begin
449 // find client index by peer
450 for f := Low(NetClients) to High(NetClients) do
451 begin
452 if (not NetClients[f].Used) then continue;
453 if (NetClients[f].Peer = NetEvent.peer) then
454 begin
455 nid := f;
456 break;
457 end;
458 end;
459 //e_LogWritefln('RECEIVE: dlpacket; client=%d (datalen=%u)', [nid, NetEvent.packet^.dataLength]);
461 if (nid < 0) then exit; // wtf?!
462 nc := @NetClients[nid];
464 if (NetEvent.packet^.dataLength = 0) then
465 begin
466 killClientByFT(nc^);
467 exit;
468 end;
470 tf := @NetClients[nid].Transfer;
471 tf.lastAckTime := GetTimerMS();
473 cmd := Byte(NetEvent.packet^.data^);
474 //e_LogWritefln('RECEIVE: nid=%d; cmd=%u', [nid, cmd]);
475 case cmd of
476 NTF_CLIENT_FILE_REQUEST: // file request
477 begin
478 if (tf.stream <> nil) then
479 begin
480 killClientByFT(nc^);
481 exit;
482 end;
483 if (NetEvent.packet^.dataLength < 2) then
484 begin
485 killClientByFT(nc^);
486 exit;
487 end;
488 // new transfer request; build packet
489 if not msg.Init(NetEvent.packet^.data+1, NetEvent.packet^.dataLength-1, True) then
490 begin
491 killClientByFT(nc^);
492 exit;
493 end;
494 // get resource index
495 ridx := msg.ReadLongInt();
496 if (ridx < -1) or (ridx >= length(gExternalResources)) then
497 begin
498 e_LogWritefln('Invalid resource index %d', [ridx], TMsgType.Warning);
499 killClientByFT(nc^);
500 exit;
501 end;
502 if (ridx < 0) then fname := MapsDir+gGameSettings.WAD else fname := {GameDir+'/wads/'+}gExternalResources[ridx].diskName;
503 if (length(fname) = 0) then
504 begin
505 e_WriteLog('Invalid filename: '+fname, TMsgType.Warning);
506 killClientByFT(nc^);
507 exit;
508 end;
509 tf.diskName := findDiskWad(fname);
510 //if (length(tf.diskName) = 0) then tf.diskName := findDiskWad(GameDir+'/wads/'+fname);
511 if (length(tf.diskName) = 0) then
512 begin
513 e_LogWritefln('NETWORK: file "%s" not found!', [fname], TMsgType.Fatal);
514 killClientByFT(nc^);
515 exit;
516 end;
517 // calculate hash
518 //tf.hash := MD5File(tf.diskName);
519 if (ridx < 0) then tf.hash := gWADHash else tf.hash := gExternalResources[ridx].hash;
520 // create file stream
521 tf.diskName := findDiskWad(fname);
522 try
523 tf.stream := openDiskFileRO(tf.diskName);
524 except
525 tf.stream := nil;
526 end;
527 if (tf.stream = nil) then
528 begin
529 e_WriteLog(Format('NETWORK: file "%s" not found!', [fname]), TMsgType.Fatal);
530 killClientByFT(nc^);
531 exit;
532 end;
533 e_LogWritefln('client #%d requested resource #%d (file is `%s` : `%s`)', [nc.ID, ridx, fname, tf.diskName]);
534 tf.size := tf.stream.size;
535 tf.chunkSize := FILE_CHUNK_SIZE; // arbitrary
536 tf.lastSentChunk := -1;
537 tf.lastAckChunk := -1;
538 tf.lastAckTime := GetTimerMS();
539 tf.inProgress := False; // waiting for the first ACK or for the cancel
540 GetMem(tf.diskBuffer, tf.chunkSize);
541 // sent file info message
542 trans_omsg.Clear();
543 trans_omsg.Write(Byte(NTF_SERVER_FILE_INFO));
544 trans_omsg.Write(tf.hash);
545 trans_omsg.Write(tf.size);
546 trans_omsg.Write(tf.chunkSize);
547 trans_omsg.Write(ExtractFileName(fname));
548 if not ftransSendServerMsg(nc^, trans_omsg) then exit;
549 end;
550 NTF_CLIENT_ABORT: // do not send requested file, or abort current transfer
551 begin
552 e_LogWritefln('client #%d aborted file transfer', [nc.ID]);
553 clearNetClientTransfers(nc^);
554 end;
555 NTF_CLIENT_START: // start transfer; client may resume download by sending non-zero starting chunk
556 begin
557 if not Assigned(tf.stream) then
558 begin
559 killClientByFT(nc^);
560 exit;
561 end;
562 if (tf.lastSentChunk <> -1) or (tf.lastAckChunk <> -1) or (tf.inProgress) then
563 begin
564 // double ack, get lost
565 killClientByFT(nc^);
566 exit;
567 end;
568 if (NetEvent.packet^.dataLength < 2) then
569 begin
570 killClientByFT(nc^);
571 exit;
572 end;
573 // build packet
574 if not msg.Init(NetEvent.packet^.data+1, NetEvent.packet^.dataLength-1, True) then
575 begin
576 killClientByFT(nc^);
577 exit;
578 end;
579 chunk := msg.ReadLongInt();
580 if (chunk < 0) or (chunk > (tf.size+tf.chunkSize-1) div tf.chunkSize) then
581 begin
582 killClientByFT(nc^);
583 exit;
584 end;
585 e_LogWritefln('client #%d started file transfer from chunk %d', [nc.ID, chunk]);
586 // start sending chunks
587 tf.inProgress := True;
588 tf.lastSentChunk := chunk-1;
589 tf.lastAckChunk := chunk-1;
590 ProcessChunkSend(nc^);
591 end;
592 NTF_CLIENT_ACK: // chunk ack; chunk number follows
593 begin
594 if not Assigned(tf.stream) then
595 begin
596 killClientByFT(nc^);
597 exit;
598 end;
599 if (tf.lastSentChunk < 0) or (not tf.inProgress) then
600 begin
601 // double ack, get lost
602 killClientByFT(nc^);
603 exit;
604 end;
605 if (NetEvent.packet^.dataLength < 2) then
606 begin
607 killClientByFT(nc^);
608 exit;
609 end;
610 // build packet
611 if not msg.Init(NetEvent.packet^.data+1, NetEvent.packet^.dataLength-1, True) then
612 begin
613 killClientByFT(nc^);
614 exit;
615 end;
616 chunk := msg.ReadLongInt();
617 if (chunk < 0) or (chunk > (tf.size+tf.chunkSize-1) div tf.chunkSize) then
618 begin
619 killClientByFT(nc^);
620 exit;
621 end;
622 // do it this way, so client may seek, or request retransfers for some reason
623 tf.lastAckChunk := chunk;
624 tf.lastSentChunk := chunk;
625 //e_LogWritefln('client #%d acked file transfer chunk %d', [nc.ID, chunk]);
626 ProcessChunkSend(nc^);
627 end;
628 NTF_CLIENT_MAP_REQUEST:
629 begin
630 e_LogWritefln('client #%d requested map info', [nc.ID]);
631 trans_omsg.Clear();
632 dfn := findDiskWad(MapsDir+gGameSettings.WAD);
633 if (dfn = '') then dfn := '!wad_not_found!.wad'; //FIXME
634 //md5 := MD5File(dfn);
635 md5 := gWADHash;
636 if (not GetDiskFileInfo(dfn, fi)) then
637 begin
638 e_LogWritefln('client #%d requested map info, but i cannot get file info', [nc.ID]);
639 killClientByFT(nc^);
640 exit;
641 end;
642 size := fi.size;
644 st := openDiskFileRO(dfn);
645 if not assigned(st) then exit; //wtf?!
646 size := st.size;
647 st.Free;
649 // packet type
650 trans_omsg.Write(Byte(NTF_SERVER_MAP_INFO));
651 // map wad name
652 trans_omsg.Write(gGameSettings.WAD);
653 // map wad md5
654 trans_omsg.Write(md5);
655 // map wad size
656 trans_omsg.Write(size);
657 // number of external resources for map
658 trans_omsg.Write(LongInt(length(gExternalResources)));
659 // external resource names
660 for f := 0 to High(gExternalResources) do
661 begin
662 // old style packet
663 //trans_omsg.Write(ExtractFileName(gExternalResources[f])); // GameDir+'/wads/'+ResList.Strings[i]
664 // new style packet
665 trans_omsg.Write('!');
666 trans_omsg.Write(LongInt(gExternalResources[f].size));
667 trans_omsg.Write(gExternalResources[f].hash);
668 trans_omsg.Write(ExtractFileName(gExternalResources[f].diskName));
669 end;
670 // send packet
671 if not ftransSendServerMsg(nc^, trans_omsg) then exit;
672 end;
673 else
674 begin
675 killClientByFT(nc^);
676 exit;
677 end;
678 end;
679 end;
682 //**************************************************************************
683 //
684 // file transfer crap (both client and server)
685 //
686 //**************************************************************************
688 function getNewTimeoutEnd (): Int64;
689 begin
690 result := GetTimerMS();
691 if (g_Net_DownloadTimeout <= 0) then
692 begin
693 result := result+1000*60*3; // 3 minutes
694 end
695 else
696 begin
697 result := result+trunc(g_Net_DownloadTimeout*1000);
698 end;
699 end;
702 // send map request to server, and wait for "map info" server reply
703 //
704 // returns `false` on error or user abort
705 // fills:
706 // diskName: map wad file name (without a path)
707 // hash: map wad hash
708 // size: map wad size
709 // chunkSize: set too
710 // resList: list of resource wads
711 // returns:
712 // <0 on error
713 // 0 on success
714 // 1 on user abort
715 // 2 on server abort
716 // for maps, first `tf.diskName` name will be map wad name, and `tf.hash`/`tf.size` will contain map info
717 function g_Net_Wait_MapInfo (var tf: TNetFileTransfer; var resList: TNetMapResourceInfoArray): Integer;
718 var
719 ev: ENetEvent;
720 rMsgId: Byte;
721 Ptr: Pointer;
722 msg: TMsg;
723 freePacket: Boolean = false;
724 ct, ett: Int64;
725 status: cint;
726 s: AnsiString;
727 rc, f: LongInt;
728 ri: ^TNetMapResourceInfo;
729 begin
730 SetLength(resList, 0);
732 // send request
733 trans_omsg.Clear();
734 trans_omsg.Write(Byte(NTF_CLIENT_MAP_REQUEST));
735 if not ftransSendClientMsg(trans_omsg) then begin result := -1; exit; end;
737 FillChar(ev, SizeOf(ev), 0);
738 Result := -1;
739 try
740 ett := getNewTimeoutEnd();
741 repeat
742 status := enet_host_service(NetHost, @ev, 300);
743 if (status < 0) then
744 begin
745 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' network error', True);
746 Result := -1;
747 exit;
748 end;
749 if (status = 0) then
750 begin
751 // check for timeout
752 ct := GetTimerMS();
753 if (ct >= ett) then
754 begin
755 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' timeout reached', True);
756 Result := -1;
757 exit;
758 end;
759 end
760 else
761 begin
762 // some event
763 case ev.kind of
764 ENET_EVENT_TYPE_RECEIVE:
765 begin
766 freePacket := true;
767 if (ev.channelID <> NET_CHAN_DOWNLOAD_EX) then
768 begin
769 //e_LogWritefln('g_Net_Wait_MapInfo: skip message from non-transfer channel', []);
770 freePacket := false;
771 g_Net_Client_HandlePacket(ev.packet, g_Net_ClientLightMsgHandler);
772 if (g_Res_received_map_start < 0) then begin result := -666; exit; end;
773 end
774 else
775 begin
776 ett := getNewTimeoutEnd();
777 if (ev.packet.dataLength < 1) then
778 begin
779 e_LogWritefln('g_Net_Wait_MapInfo: invalid server packet (no data)', []);
780 Result := -1;
781 exit;
782 end;
783 Ptr := ev.packet^.data;
784 rMsgId := Byte(Ptr^);
785 e_LogWritefln('g_Net_Wait_MapInfo: got message %u from server (dataLength=%u)', [rMsgId, ev.packet^.dataLength]);
786 if (rMsgId = NTF_SERVER_FILE_INFO) then
787 begin
788 e_LogWritefln('g_Net_Wait_MapInfo: waiting for map info reply, but got file info reply', []);
789 Result := -1;
790 exit;
791 end
792 else if (rMsgId = NTF_SERVER_ABORT) then
793 begin
794 e_LogWritefln('g_Net_Wait_MapInfo: server aborted transfer', []);
795 Result := 2;
796 exit;
797 end
798 else if (rMsgId = NTF_SERVER_MAP_INFO) then
799 begin
800 e_LogWritefln('g_Net_Wait_MapInfo: creating map info packet...', []);
801 if not msg.Init(ev.packet^.data+1, ev.packet^.dataLength-1, True) then exit;
802 e_LogWritefln('g_Net_Wait_MapInfo: parsing map info packet (rd=%d; max=%d)...', [msg.ReadCount, msg.MaxSize]);
803 SetLength(resList, 0); // just in case
804 // map wad name
805 tf.diskName := msg.ReadString();
806 e_LogWritefln('g_Net_Wait_MapInfo: map wad is `%s`', [tf.diskName]);
807 // map wad md5
808 tf.hash := msg.ReadMD5();
809 // map wad size
810 tf.size := msg.ReadLongInt();
811 e_LogWritefln('g_Net_Wait_MapInfo: map wad size is %d', [tf.size]);
812 // number of external resources for map
813 rc := msg.ReadLongInt();
814 if (rc < 0) or (rc > 1024) then
815 begin
816 e_LogWritefln('g_Net_Wait_Event: invalid number of map external resources (%d)', [rc]);
817 Result := -1;
818 exit;
819 end;
820 e_LogWritefln('g_Net_Wait_MapInfo: map external resource count is %d', [rc]);
821 SetLength(resList, rc);
822 // external resource names
823 for f := 0 to rc-1 do
824 begin
825 ri := @resList[f];
826 s := msg.ReadString();
827 if (length(s) = 0) then begin result := -1; exit; end;
828 if (s = '!') then
829 begin
830 // extended packet
831 ri.size := msg.ReadLongInt();
832 ri.hash := msg.ReadMD5();
833 ri.wadName := ExtractFileName(msg.ReadString());
834 if (length(ri.wadName) = 0) or (ri.size < 0) then begin result := -1; exit; end;
835 end
836 else
837 begin
838 // old-style packet, only name
839 ri.wadName := ExtractFileName(s);
840 if (length(ri.wadName) = 0) then begin result := -1; exit; end;
841 ri.size := -1; // unknown
842 end;
843 end;
844 e_LogWritefln('g_Net_Wait_MapInfo: got map info', []);
845 Result := 0; // success
846 exit;
847 end
848 else
849 begin
850 e_LogWritefln('g_Net_Wait_Event: invalid server packet type', []);
851 Result := -1;
852 exit;
853 end;
854 end;
855 end;
856 ENET_EVENT_TYPE_DISCONNECT:
857 begin
858 if (ev.data <= NET_DISC_MAX) then
859 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' ' + _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + ev.data)], True);
860 Result := -1;
861 exit;
862 end;
863 else
864 begin
865 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' unknown ENet event ' + IntToStr(Ord(ev.kind)), True);
866 result := -1;
867 exit;
868 end;
869 end;
870 if (freePacket) then begin freePacket := false; enet_packet_destroy(ev.packet); end;
871 end;
872 ProcessLoading();
873 if g_Net_UserRequestExit() then
874 begin
875 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' user abort', True);
876 Result := 1;
877 exit;
878 end;
879 until false;
880 finally
881 if (freePacket) then enet_packet_destroy(ev.packet);
882 end;
883 end;
886 // send file request to server, and wait for server reply
887 //
888 // returns `false` on error or user abort
889 // fills:
890 // diskName (actually, base name)
891 // hash
892 // size
893 // chunkSize
894 // returns:
895 // <0 on error
896 // 0 on success
897 // 1 on user abort
898 // 2 on server abort
899 // for maps, first `tf.diskName` name will be map wad name, and `tf.hash`/`tf.size` will contain map info
900 function g_Net_RequestResFileInfo (resIndex: LongInt; out tf: TNetFileTransfer): Integer;
901 var
902 ev: ENetEvent;
903 rMsgId: Byte;
904 Ptr: Pointer;
905 msg: TMsg;
906 freePacket: Boolean = false;
907 ct, ett: Int64;
908 status: cint;
909 begin
910 // send request
911 trans_omsg.Clear();
912 trans_omsg.Write(Byte(NTF_CLIENT_FILE_REQUEST));
913 trans_omsg.Write(resIndex);
914 if not ftransSendClientMsg(trans_omsg) then begin result := -1; exit; end;
916 FillChar(ev, SizeOf(ev), 0);
917 Result := -1;
918 try
919 ett := getNewTimeoutEnd();
920 repeat
921 status := enet_host_service(NetHost, @ev, 300);
922 if (status < 0) then
923 begin
924 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' network error', True);
925 Result := -1;
926 exit;
927 end;
928 if (status = 0) then
929 begin
930 // check for timeout
931 ct := GetTimerMS();
932 if (ct >= ett) then
933 begin
934 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' timeout reached', True);
935 Result := -1;
936 exit;
937 end;
938 end
939 else
940 begin
941 // some event
942 case ev.kind of
943 ENET_EVENT_TYPE_RECEIVE:
944 begin
945 freePacket := true;
946 if (ev.channelID <> NET_CHAN_DOWNLOAD_EX) then
947 begin
948 //e_LogWriteln('g_Net_Wait_Event: skip message from non-transfer channel');
949 freePacket := false;
950 g_Net_Client_HandlePacket(ev.packet, g_Net_ClientLightMsgHandler);
951 if (g_Res_received_map_start < 0) then begin result := -666; exit; end;
952 end
953 else
954 begin
955 ett := getNewTimeoutEnd();
956 if (ev.packet.dataLength < 1) then
957 begin
958 e_LogWriteln('g_Net_Wait_Event: invalid server packet (no data)');
959 Result := -1;
960 exit;
961 end;
962 Ptr := ev.packet^.data;
963 rMsgId := Byte(Ptr^);
964 e_LogWritefln('received transfer packet with id %d (%u bytes)', [rMsgId, ev.packet^.dataLength]);
965 if (rMsgId = NTF_SERVER_FILE_INFO) then
966 begin
967 if not msg.Init(ev.packet^.data+1, ev.packet^.dataLength-1, True) then exit;
968 tf.hash := msg.ReadMD5();
969 tf.size := msg.ReadLongInt();
970 tf.chunkSize := msg.ReadLongInt();
971 tf.diskName := ExtractFileName(msg.readString());
972 if (tf.size < 0) or (tf.chunkSize <> FILE_CHUNK_SIZE) or (length(tf.diskName) = 0) then
973 begin
974 e_LogWritefln('g_Net_RequestResFileInfo: invalid file info packet', []);
975 Result := -1;
976 exit;
977 end;
978 e_LogWritefln('got file info for resource #%d: size=%d; name=%s', [resIndex, tf.size, tf.diskName]);
979 Result := 0; // success
980 exit;
981 end
982 else if (rMsgId = NTF_SERVER_ABORT) then
983 begin
984 e_LogWriteln('g_Net_RequestResFileInfo: server aborted transfer');
985 Result := 2;
986 exit;
987 end
988 else if (rMsgId = NTF_SERVER_MAP_INFO) then
989 begin
990 e_LogWriteln('g_Net_RequestResFileInfo: waiting for map info reply, but got file info reply');
991 Result := -1;
992 exit;
993 end
994 else
995 begin
996 e_LogWriteln('g_Net_RequestResFileInfo: invalid server packet type');
997 Result := -1;
998 exit;
999 end;
1000 end;
1001 end;
1002 ENET_EVENT_TYPE_DISCONNECT:
1003 begin
1004 if (ev.data <= NET_DISC_MAX) then
1005 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' ' + _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + ev.data)], True);
1006 Result := -1;
1007 exit;
1008 end;
1009 else
1010 begin
1011 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' unknown ENet event ' + IntToStr(Ord(ev.kind)), True);
1012 result := -1;
1013 exit;
1014 end;
1015 end;
1016 if (freePacket) then begin freePacket := false; enet_packet_destroy(ev.packet); end;
1017 end;
1018 ProcessLoading();
1019 if g_Net_UserRequestExit() then
1020 begin
1021 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' user abort', True);
1022 Result := 1;
1023 exit;
1024 end;
1025 until false;
1026 finally
1027 if (freePacket) then enet_packet_destroy(ev.packet);
1028 end;
1029 end;
1032 // call this to cancel file transfer requested by `g_Net_RequestResFileInfo()`
1033 function g_Net_AbortResTransfer (var tf: TNetFileTransfer): Boolean;
1034 begin
1035 result := false;
1036 e_LogWritefln('aborting file transfer...', []);
1037 // send request
1038 trans_omsg.Clear();
1039 trans_omsg.Write(Byte(NTF_CLIENT_ABORT));
1040 result := ftransSendClientMsg(trans_omsg);
1041 if result then enet_host_flush(NetHost);
1042 end;
1045 // call this to start file transfer requested by `g_Net_RequestResFileInfo()`
1046 //
1047 // returns `false` on error or user abort
1048 // fills:
1049 // hash
1050 // size
1051 // chunkSize
1052 // returns:
1053 // <0 on error
1054 // 0 on success
1055 // 1 on user abort
1056 // 2 on server abort
1057 // for maps, first `tf.diskName` name will be map wad name, and `tf.hash`/`tf.size` will contain map info
1058 function g_Net_ReceiveResourceFile (resIndex: LongInt; var tf: TNetFileTransfer; strm: TStream): Integer;
1059 var
1060 ev: ENetEvent;
1061 rMsgId: Byte;
1062 Ptr: Pointer;
1063 msg: TMsg;
1064 freePacket: Boolean = false;
1065 ct, ett: Int64;
1066 status: cint;
1067 nextChunk: Integer = 0;
1068 chunkTotal: Integer;
1069 chunk: Integer;
1070 csize: Integer;
1071 buf: PChar = nil;
1072 resumed: Boolean;
1073 //stx: Int64;
1074 begin
1075 tf.resumed := false;
1076 e_LogWritefln('file `%s`, size=%d (%d)', [tf.diskName, Integer(strm.size), tf.size], TMsgType.Notify);
1077 // check if we should resume downloading
1078 resumed := (strm.size > tf.chunkSize) and (strm.size < tf.size);
1079 // send request
1080 trans_omsg.Clear();
1081 trans_omsg.Write(Byte(NTF_CLIENT_START));
1082 if resumed then chunk := strm.size div tf.chunkSize else chunk := 0;
1083 trans_omsg.Write(LongInt(chunk));
1084 if not ftransSendClientMsg(trans_omsg) then begin result := -1; exit; end;
1086 strm.Seek(chunk*tf.chunkSize, soFromBeginning);
1087 chunkTotal := (tf.size+tf.chunkSize-1) div tf.chunkSize;
1088 e_LogWritefln('receiving file `%s` (%d chunks)', [tf.diskName, chunkTotal], TMsgType.Notify);
1089 g_Game_SetLoadingText('downloading "'+ExtractFileName(tf.diskName)+'"', chunkTotal, False);
1090 tf.resumed := resumed;
1092 if (chunk > 0) then g_Game_StepLoading(chunk);
1093 nextChunk := chunk;
1095 // wait for reply data
1096 FillChar(ev, SizeOf(ev), 0);
1097 Result := -1;
1098 GetMem(buf, tf.chunkSize);
1099 try
1100 ett := getNewTimeoutEnd();
1101 repeat
1102 //stx := -GetTimerMS();
1103 status := enet_host_service(NetHost, @ev, 300);
1104 if (status < 0) then
1105 begin
1106 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' network error', True);
1107 Result := -1;
1108 exit;
1109 end;
1110 if (status = 0) then
1111 begin
1112 // check for timeout
1113 ct := GetTimerMS();
1114 if (ct >= ett) then
1115 begin
1116 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' timeout reached', True);
1117 Result := -1;
1118 exit;
1119 end;
1120 end
1121 else
1122 begin
1123 // some event
1124 case ev.kind of
1125 ENET_EVENT_TYPE_RECEIVE:
1126 begin
1127 freePacket := true;
1128 if (ev.channelID <> NET_CHAN_DOWNLOAD_EX) then
1129 begin
1130 //e_LogWritefln('g_Net_Wait_Event: skip message from non-transfer channel', []);
1131 freePacket := false;
1132 g_Net_Client_HandlePacket(ev.packet, g_Net_ClientLightMsgHandler);
1133 if (g_Res_received_map_start < 0) then begin result := -666; exit; end;
1134 end
1135 else
1136 begin
1137 //stx := stx+GetTimerMS();
1138 //e_LogWritefln('g_Net_ReceiveResourceFile: stx=%d', [Integer(stx)]);
1139 //stx := -GetTimerMS();
1140 ett := getNewTimeoutEnd();
1141 if (ev.packet.dataLength < 1) then
1142 begin
1143 e_LogWritefln('g_Net_ReceiveResourceFile: invalid server packet (no data)', []);
1144 Result := -1;
1145 exit;
1146 end;
1147 Ptr := ev.packet^.data;
1148 rMsgId := Byte(Ptr^);
1149 if (rMsgId = NTF_SERVER_DONE) then
1150 begin
1151 e_LogWritefln('file transfer complete.', []);
1152 result := 0;
1153 exit;
1154 end
1155 else if (rMsgId = NTF_SERVER_CHUNK) then
1156 begin
1157 if not msg.Init(ev.packet^.data+1, ev.packet^.dataLength-1, True) then exit;
1158 chunk := msg.ReadLongInt();
1159 csize := msg.ReadLongInt();
1160 if (chunk <> nextChunk) then
1161 begin
1162 e_LogWritefln('received chunk %d, but expected chunk %d', [chunk, nextChunk]);
1163 Result := -1;
1164 exit;
1165 end;
1166 if (csize < 0) or (csize > tf.chunkSize) then
1167 begin
1168 e_LogWritefln('received chunk with size %d, but expected chunk size is %d', [csize, tf.chunkSize]);
1169 Result := -1;
1170 exit;
1171 end;
1172 //e_LogWritefln('got chunk #%d of #%d (csize=%d)', [chunk, (tf.size+tf.chunkSize-1) div tf.chunkSize, csize]);
1173 msg.ReadData(buf, csize);
1174 strm.WriteBuffer(buf^, csize);
1175 nextChunk := chunk+1;
1176 g_Game_StepLoading();
1177 // send ack
1178 trans_omsg.Clear();
1179 trans_omsg.Write(Byte(NTF_CLIENT_ACK));
1180 trans_omsg.Write(LongInt(chunk));
1181 if not ftransSendClientMsg(trans_omsg) then begin result := -1; exit; end;
1182 end
1183 else if (rMsgId = NTF_SERVER_ABORT) then
1184 begin
1185 e_LogWritefln('g_Net_ReceiveResourceFile: server aborted transfer', []);
1186 Result := 2;
1187 exit;
1188 end
1189 else
1190 begin
1191 e_LogWritefln('g_Net_ReceiveResourceFile: invalid server packet type', []);
1192 Result := -1;
1193 exit;
1194 end;
1195 //stx := stx+GetTimerMS();
1196 //e_LogWritefln('g_Net_ReceiveResourceFile: process stx=%d', [Integer(stx)]);
1197 end;
1198 end;
1199 ENET_EVENT_TYPE_DISCONNECT:
1200 begin
1201 if (ev.data <= NET_DISC_MAX) then
1202 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' ' + _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + ev.data)], True);
1203 Result := -1;
1204 exit;
1205 end;
1206 else
1207 begin
1208 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' unknown ENet event ' + IntToStr(Ord(ev.kind)), True);
1209 result := -1;
1210 exit;
1211 end;
1212 end;
1213 if (freePacket) then begin freePacket := false; enet_packet_destroy(ev.packet); end;
1214 end;
1215 ProcessLoading();
1216 if g_Net_UserRequestExit() then
1217 begin
1218 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' user abort', True);
1219 Result := 1;
1220 exit;
1221 end;
1222 until false;
1223 finally
1224 FreeMem(buf);
1225 if (freePacket) then enet_packet_destroy(ev.packet);
1226 end;
1227 end;
1230 //**************************************************************************
1231 //
1232 // common functions
1233 //
1234 //**************************************************************************
1236 function g_Net_FindSlot(): Integer;
1237 var
1238 I: Integer;
1239 F: Boolean;
1240 N, C: Integer;
1241 begin
1242 N := -1;
1243 F := False;
1244 C := 0;
1245 for I := Low(NetClients) to High(NetClients) do
1246 begin
1247 if NetClients[I].Used then
1248 Inc(C)
1249 else
1250 if not F then
1251 begin
1252 F := True;
1253 N := I;
1254 end;
1255 end;
1256 if C >= NetMaxClients then
1257 begin
1258 Result := -1;
1259 Exit;
1260 end;
1262 if not F then
1263 begin
1264 if (Length(NetClients) >= NetMaxClients) then
1265 N := -1
1266 else
1267 begin
1268 SetLength(NetClients, Length(NetClients) + 1);
1269 N := High(NetClients);
1270 end;
1271 end;
1273 if N >= 0 then
1274 begin
1275 NetClients[N].Used := True;
1276 NetClients[N].ID := N;
1277 NetClients[N].RequestedFullUpdate := False;
1278 NetClients[N].WaitForFirstSpawn := False;
1279 NetClients[N].RCONAuth := False;
1280 NetClients[N].Voted := False;
1281 NetClients[N].Player := 0;
1282 clearNetClientTransfers(NetClients[N]); // just in case
1283 end;
1285 Result := N;
1286 end;
1288 function g_Net_Init(): Boolean;
1289 var
1290 F: TextFile;
1291 IPstr: string;
1292 IP: LongWord;
1293 begin
1294 NetIn.Clear();
1295 NetOut.Clear();
1296 NetBuf[NET_UNRELIABLE].Clear();
1297 NetBuf[NET_RELIABLE].Clear();
1298 //SetLength(NetClients, 0);
1299 clearNetClients(true); // clear array
1300 NetPeer := nil;
1301 NetHost := nil;
1302 NetMyID := -1;
1303 NetPlrUID1 := -1;
1304 NetPlrUID2 := -1;
1305 NetAddr.port := 25666;
1306 SetLength(NetBannedHosts, 0);
1307 if FileExists(DataDir + BANLIST_FILENAME) then
1308 begin
1309 Assign(F, DataDir + BANLIST_FILENAME);
1310 Reset(F);
1311 while not EOF(F) do
1312 begin
1313 Readln(F, IPstr);
1314 if StrToIp(IPstr, IP) then
1315 g_Net_BanHost(IP);
1316 end;
1317 CloseFile(F);
1318 g_Net_SaveBanList();
1319 end;
1321 Result := (enet_initialize() = 0);
1322 end;
1324 procedure g_Net_Flush();
1325 var
1326 T: Integer;
1327 P: pENetPacket;
1328 F, Chan: enet_uint32;
1329 I: Integer;
1330 begin
1331 F := 0;
1332 Chan := NET_CHAN_GAME;
1334 if NetMode = NET_SERVER then
1335 for T := NET_UNRELIABLE to NET_RELIABLE do
1336 begin
1337 if NetBuf[T].CurSize > 0 then
1338 begin
1339 P := enet_packet_create(NetBuf[T].Data, NetBuf[T].CurSize, F);
1340 if not Assigned(P) then continue;
1341 enet_host_broadcast(NetHost, Chan, P);
1342 NetBuf[T].Clear();
1343 end;
1345 for I := Low(NetClients) to High(NetClients) do
1346 begin
1347 if not NetClients[I].Used then continue;
1348 if NetClients[I].NetOut[T].CurSize <= 0 then continue;
1349 P := enet_packet_create(NetClients[I].NetOut[T].Data, NetClients[I].NetOut[T].CurSize, F);
1350 if not Assigned(P) then continue;
1351 enet_peer_send(NetClients[I].Peer, Chan, P);
1352 NetClients[I].NetOut[T].Clear();
1353 end;
1355 // next and last iteration is always RELIABLE
1356 F := LongWord(ENET_PACKET_FLAG_RELIABLE);
1357 Chan := NET_CHAN_IMPORTANT;
1358 end
1359 else if NetMode = NET_CLIENT then
1360 for T := NET_UNRELIABLE to NET_RELIABLE do
1361 begin
1362 if NetBuf[T].CurSize > 0 then
1363 begin
1364 P := enet_packet_create(NetBuf[T].Data, NetBuf[T].CurSize, F);
1365 if not Assigned(P) then continue;
1366 enet_peer_send(NetPeer, Chan, P);
1367 NetBuf[T].Clear();
1368 end;
1369 // next and last iteration is always RELIABLE
1370 F := LongWord(ENET_PACKET_FLAG_RELIABLE);
1371 Chan := NET_CHAN_IMPORTANT;
1372 end;
1373 end;
1375 procedure g_Net_Cleanup();
1376 begin
1377 NetIn.Clear();
1378 NetOut.Clear();
1379 NetBuf[NET_UNRELIABLE].Clear();
1380 NetBuf[NET_RELIABLE].Clear();
1382 //SetLength(NetClients, 0);
1383 clearNetClients(true); // clear array
1384 NetClientCount := 0;
1386 NetPeer := nil;
1387 NetHost := nil;
1388 g_Net_Slist_NetworkStopped();
1389 //g_Net_Slist_Disconnect(false); // do not spam console
1390 NetMyID := -1;
1391 NetPlrUID1 := -1;
1392 NetPlrUID2 := -1;
1393 NetState := NET_STATE_NONE;
1395 NetPongSock := ENET_SOCKET_NULL;
1397 NetTimeToMaster := 0;
1398 NetTimeToUpdate := 0;
1399 NetTimeToReliable := 0;
1401 NetMode := NET_NONE;
1403 if NetPortThread <> NilThreadId then
1404 WaitForThreadTerminate(NetPortThread, 66666);
1406 NetPortThread := NilThreadId;
1407 g_Net_UnforwardPorts();
1409 if NetDump then
1410 g_Net_DumpEnd();
1411 end;
1413 procedure g_Net_Free();
1414 begin
1415 g_Net_Cleanup();
1417 enet_deinitialize();
1418 NetInitDone := False;
1419 end;
1422 //**************************************************************************
1423 //
1424 // SERVER FUNCTIONS
1425 //
1426 //**************************************************************************
1428 function ForwardThread(Param: Pointer): PtrInt;
1429 begin
1430 Result := 0;
1431 if not g_Net_ForwardPorts() then Result := -1;
1432 end;
1434 function g_Net_Host(IPAddr: LongWord; Port: enet_uint16; MaxClients: Cardinal = 16): Boolean;
1435 begin
1436 if NetMode <> NET_NONE then
1437 begin
1438 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_INGAME]);
1439 Result := False;
1440 Exit;
1441 end;
1443 Result := True;
1445 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST], [Port]));
1446 if not NetInitDone then
1447 begin
1448 if (not g_Net_Init()) then
1449 begin
1450 g_Console_Add(_lc[I_NET_MSG_FERROR] + _lc[I_NET_ERR_ENET]);
1451 Result := False;
1452 Exit;
1453 end
1454 else
1455 NetInitDone := True;
1456 end;
1458 NetAddr.host := IPAddr;
1459 NetAddr.port := Port;
1461 if NetForwardPorts then NetPortThread := BeginThread(ForwardThread);
1463 NetHost := enet_host_create(@NetAddr, NET_MAXCLIENTS, NET_CHANS, 0, 0);
1465 if (NetHost = nil) then
1466 begin
1467 g_Console_Add(_lc[I_NET_MSG_ERROR] + Format(_lc[I_NET_ERR_HOST], [Port]));
1468 Result := False;
1469 g_Net_Cleanup;
1470 Exit;
1471 end;
1473 NetPongSock := enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM);
1474 if NetPongSock <> ENET_SOCKET_NULL then
1475 begin
1476 NetPongAddr.host := IPAddr;
1477 NetPongAddr.port := NET_PING_PORT;
1478 if enet_socket_bind(NetPongSock, @NetPongAddr) < 0 then
1479 begin
1480 enet_socket_destroy(NetPongSock);
1481 NetPongSock := ENET_SOCKET_NULL;
1482 end
1483 else
1484 enet_socket_set_option(NetPongSock, ENET_SOCKOPT_NONBLOCK, 1);
1485 end;
1487 NetMode := NET_SERVER;
1488 NetOut.Clear();
1489 NetBuf[NET_UNRELIABLE].Clear();
1490 NetBuf[NET_RELIABLE].Clear();
1492 if NetDump then
1493 g_Net_DumpStart();
1494 end;
1496 procedure g_Net_Host_Die();
1497 var
1498 I: Integer;
1499 begin
1500 if NetMode <> NET_SERVER then Exit;
1502 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_DISCALL]);
1503 for I := 0 to High(NetClients) do
1504 if NetClients[I].Used then
1505 enet_peer_disconnect(NetClients[I].Peer, NET_DISC_DOWN);
1507 while enet_host_service(NetHost, @NetEvent, 1000) > 0 do
1508 if NetEvent.kind = ENET_EVENT_TYPE_RECEIVE then
1509 enet_packet_destroy(NetEvent.packet);
1511 for I := 0 to High(NetClients) do
1512 if NetClients[I].Used then
1513 begin
1514 FreeMemory(NetClients[I].Peer^.data);
1515 NetClients[I].Peer^.data := nil;
1516 enet_peer_reset(NetClients[I].Peer);
1517 NetClients[I].Peer := nil;
1518 NetClients[I].Used := False;
1519 NetClients[I].NetOut[NET_UNRELIABLE].Free();
1520 NetClients[I].NetOut[NET_RELIABLE].Free();
1521 end;
1523 clearNetClients(false); // don't clear array
1524 //if (g_Net_Slist_IsConnectionActive) then g_Net_Slist_Disconnect;
1525 g_Net_Slist_NetworkStopped();
1526 if NetPongSock <> ENET_SOCKET_NULL then
1527 enet_socket_destroy(NetPongSock);
1529 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_DIE]);
1530 enet_host_destroy(NetHost);
1532 NetMode := NET_NONE;
1534 g_Net_Cleanup;
1535 e_WriteLog('NET: Server stopped', TMsgType.Notify);
1536 end;
1539 procedure g_Net_Host_Send(ID: Integer; Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
1540 var
1541 T: Integer;
1542 begin
1543 if (Reliable) then
1544 T := NET_RELIABLE
1545 else
1546 T := NET_UNRELIABLE;
1548 if (ID >= 0) then
1549 begin
1550 if ID > High(NetClients) then Exit;
1551 if NetClients[ID].Peer = nil then Exit;
1552 // write size first
1553 NetClients[ID].NetOut[T].Write(Integer(NetOut.CurSize));
1554 NetClients[ID].NetOut[T].Write(NetOut);
1555 end
1556 else
1557 begin
1558 // write size first
1559 NetBuf[T].Write(Integer(NetOut.CurSize));
1560 NetBuf[T].Write(NetOut);
1561 end;
1563 if NetDump then g_Net_DumpSendBuffer();
1564 NetOut.Clear();
1565 end;
1567 procedure g_Net_Host_CheckPings();
1568 var
1569 ClAddr: ENetAddress;
1570 Buf: ENetBuffer;
1571 Len: Integer;
1572 ClTime: Int64;
1573 Ping: array [0..9] of Byte;
1574 NPl: Byte;
1575 begin
1576 if NetPongSock = ENET_SOCKET_NULL then Exit;
1578 Buf.data := Addr(Ping[0]);
1579 Buf.dataLength := 2+8;
1581 Ping[0] := 0;
1583 Len := enet_socket_receive(NetPongSock, @ClAddr, @Buf, 1);
1584 if Len < 0 then Exit;
1586 if (Ping[0] = Ord('D')) and (Ping[1] = Ord('F')) then
1587 begin
1588 ClTime := Int64(Addr(Ping[2])^);
1590 NetOut.Clear();
1591 NetOut.Write(Byte(Ord('D')));
1592 NetOut.Write(Byte(Ord('F')));
1593 NetOut.Write(NetPort);
1594 NetOut.Write(ClTime);
1595 //g_Net_Slist_WriteInfo();
1596 TMasterHost.writeInfo(NetOut);
1597 NPl := 0;
1598 if gPlayer1 <> nil then Inc(NPl);
1599 if gPlayer2 <> nil then Inc(NPl);
1600 NetOut.Write(NPl);
1601 NetOut.Write(gNumBots);
1603 Buf.data := NetOut.Data;
1604 Buf.dataLength := NetOut.CurSize;
1605 enet_socket_send(NetPongSock, @ClAddr, @Buf, 1);
1607 NetOut.Clear();
1608 end;
1609 end;
1612 function g_Net_Host_Update(): enet_size_t;
1613 var
1614 IP: string;
1615 Port: Word;
1616 ID: Integer;
1617 TC: pTNetClient;
1618 TP: TPlayer;
1619 begin
1620 IP := '';
1621 Result := 0;
1623 if NetUseMaster then
1624 begin
1625 //g_Net_Slist_Check;
1626 g_Net_Slist_Pulse();
1627 end;
1628 g_Net_Host_CheckPings;
1630 while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
1631 begin
1632 case (NetEvent.kind) of
1633 ENET_EVENT_TYPE_CONNECT:
1634 begin
1635 IP := IpToStr(NetEvent.Peer^.address.host);
1636 Port := NetEvent.Peer^.address.port;
1637 g_Console_Add(_lc[I_NET_MSG] +
1638 Format(_lc[I_NET_MSG_HOST_CONN], [IP, Port]));
1640 if (NetEvent.data <> NET_PROTOCOL_VER) then
1641 begin
1642 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_REJECT] +
1643 _lc[I_NET_DISC_PROTOCOL]);
1644 NetEvent.peer^.data := GetMemory(SizeOf(Byte));
1645 Byte(NetEvent.peer^.data^) := 255;
1646 enet_peer_disconnect(NetEvent.peer, NET_DISC_PROTOCOL);
1647 enet_host_flush(NetHost);
1648 Exit;
1649 end;
1651 ID := g_Net_FindSlot();
1653 if ID < 0 then
1654 begin
1655 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_REJECT] +
1656 _lc[I_NET_DISC_FULL]);
1657 NetEvent.Peer^.data := GetMemory(SizeOf(Byte));
1658 Byte(NetEvent.peer^.data^) := 255;
1659 enet_peer_disconnect(NetEvent.peer, NET_DISC_FULL);
1660 enet_host_flush(NetHost);
1661 Exit;
1662 end;
1664 NetClients[ID].Peer := NetEvent.peer;
1665 NetClients[ID].Peer^.data := GetMemory(SizeOf(Byte));
1666 Byte(NetClients[ID].Peer^.data^) := ID;
1667 NetClients[ID].State := NET_STATE_AUTH;
1668 NetClients[ID].RCONAuth := False;
1669 NetClients[ID].NetOut[NET_UNRELIABLE].Alloc(NET_BUFSIZE*2);
1670 NetClients[ID].NetOut[NET_RELIABLE].Alloc(NET_BUFSIZE*2);
1671 clearNetClientTransfers(NetClients[ID]); // just in case
1673 enet_peer_timeout(NetEvent.peer, ENET_PEER_TIMEOUT_LIMIT * 2, ENET_PEER_TIMEOUT_MINIMUM * 2, ENET_PEER_TIMEOUT_MAXIMUM * 2);
1675 Inc(NetClientCount);
1676 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST_ADD], [ID]));
1677 end;
1679 ENET_EVENT_TYPE_RECEIVE:
1680 begin
1681 //e_LogWritefln('RECEIVE: chan=%u', [NetEvent.channelID]);
1682 if (NetEvent.channelID = NET_CHAN_DOWNLOAD_EX) then
1683 begin
1684 ProcessDownloadExPacket();
1685 end
1686 else
1687 begin
1688 ID := Byte(NetEvent.peer^.data^);
1689 if ID > High(NetClients) then Exit;
1690 TC := @NetClients[ID];
1692 if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
1693 g_Net_Host_HandlePacket(TC, NetEvent.packet, g_Net_HostMsgHandler);
1694 end;
1695 end;
1697 ENET_EVENT_TYPE_DISCONNECT:
1698 begin
1699 ID := Byte(NetEvent.peer^.data^);
1700 if ID > High(NetClients) then Exit;
1701 clearNetClient(NetClients[ID]);
1702 TC := @NetClients[ID];
1703 if TC = nil then Exit;
1705 if not (TC^.Used) then Exit;
1707 TP := g_Player_Get(TC^.Player);
1709 if TP <> nil then
1710 begin
1711 TP.Lives := 0;
1712 TP.Kill(K_SIMPLEKILL, 0, HIT_DISCON);
1713 g_Console_Add(Format(_lc[I_PLAYER_LEAVE], [TP.Name]), True);
1714 e_WriteLog('NET: Client ' + TP.Name + ' [' + IntToStr(ID) + '] disconnected.', TMsgType.Notify);
1715 g_Player_Remove(TP.UID);
1716 end;
1718 TC^.Used := False;
1719 TC^.State := NET_STATE_NONE;
1720 TC^.Peer := nil;
1721 TC^.Player := 0;
1722 TC^.RequestedFullUpdate := False;
1723 TC^.WaitForFirstSpawn := False;
1724 TC^.NetOut[NET_UNRELIABLE].Free();
1725 TC^.NetOut[NET_RELIABLE].Free();
1727 FreeMemory(NetEvent.peer^.data);
1728 NetEvent.peer^.data := nil;
1729 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST_DISC], [ID]));
1730 Dec(NetClientCount);
1732 if NetUseMaster then
1733 begin
1734 //g_Net_Slist_Update;
1735 g_Net_Slist_Pulse();
1736 end;
1737 end;
1738 end;
1739 end;
1740 end;
1743 //**************************************************************************
1744 //
1745 // CLIENT FUNCTIONS
1746 //
1747 //**************************************************************************
1749 procedure g_Net_Disconnect(Forced: Boolean = False);
1750 begin
1751 if NetMode <> NET_CLIENT then Exit;
1752 if (NetHost = nil) or (NetPeer = nil) then Exit;
1754 if not Forced then
1755 begin
1756 enet_peer_disconnect(NetPeer, NET_DISC_NONE);
1758 while (enet_host_service(NetHost, @NetEvent, 1500) > 0) do
1759 begin
1760 if (NetEvent.kind = ENET_EVENT_TYPE_DISCONNECT) then
1761 begin
1762 NetPeer := nil;
1763 break;
1764 end;
1766 if (NetEvent.kind = ENET_EVENT_TYPE_RECEIVE) then
1767 enet_packet_destroy(NetEvent.packet);
1768 end;
1770 if NetPeer <> nil then
1771 begin
1772 enet_peer_reset(NetPeer);
1773 NetPeer := nil;
1774 end;
1775 end
1776 else
1777 begin
1778 e_WriteLog('NET: Kicked from server: ' + IntToStr(NetEvent.data), TMsgType.Notify);
1779 if (NetEvent.data <= NET_DISC_MAX) then
1780 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_KICK] +
1781 _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + NetEvent.data)], True);
1782 end;
1784 if NetHost <> nil then
1785 begin
1786 enet_host_destroy(NetHost);
1787 NetHost := nil;
1788 end;
1789 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_CLIENT_DISC]);
1791 g_Net_Cleanup;
1792 e_WriteLog('NET: Disconnected', TMsgType.Notify);
1793 end;
1795 procedure g_Net_Client_Send(Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
1796 var
1797 T: Integer;
1798 begin
1799 if (Reliable) then
1800 T := NET_RELIABLE
1801 else
1802 T := NET_UNRELIABLE;
1804 // write size first
1805 NetBuf[T].Write(Integer(NetOut.CurSize));
1806 NetBuf[T].Write(NetOut);
1808 if NetDump then g_Net_DumpSendBuffer();
1809 NetOut.Clear();
1810 g_Net_Flush(); // FIXME: for now, send immediately
1811 end;
1813 function g_Net_Client_Update(): enet_size_t;
1814 begin
1815 Result := 0;
1816 while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
1817 begin
1818 case NetEvent.kind of
1819 ENET_EVENT_TYPE_RECEIVE:
1820 begin
1821 if (NetEvent.channelID = NET_CHAN_DOWNLOAD_EX) then continue; // ignore all download packets, they're processed by separate code
1822 if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
1823 g_Net_Client_HandlePacket(NetEvent.packet, g_Net_ClientMsgHandler);
1824 end;
1826 ENET_EVENT_TYPE_DISCONNECT:
1827 begin
1828 g_Net_Disconnect(True);
1829 Result := 1;
1830 Exit;
1831 end;
1832 end;
1833 end
1834 end;
1836 function g_Net_Client_UpdateWhileLoading(): enet_size_t;
1837 begin
1838 Result := 0;
1839 while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
1840 begin
1841 case NetEvent.kind of
1842 ENET_EVENT_TYPE_RECEIVE:
1843 begin
1844 if (NetEvent.channelID = NET_CHAN_DOWNLOAD_EX) then continue; // ignore all download packets, they're processed by separate code
1845 if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
1846 g_Net_Client_HandlePacket(NetEvent.packet, g_Net_ClientLightMsgHandler);
1847 end;
1849 ENET_EVENT_TYPE_DISCONNECT:
1850 begin
1851 g_Net_Disconnect(True);
1852 Result := 1;
1853 Exit;
1854 end;
1855 end;
1856 end;
1857 g_Net_Flush();
1858 end;
1860 function g_Net_Connect(IP: string; Port: enet_uint16): Boolean;
1861 var
1862 OuterLoop: Boolean;
1863 TimeoutTime, T: Int64;
1864 begin
1865 if NetMode <> NET_NONE then
1866 begin
1867 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_ERR_INGAME], True);
1868 Result := False;
1869 Exit;
1870 end;
1872 Result := True;
1874 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_CLIENT_CONN],
1875 [IP, Port]));
1876 if not NetInitDone then
1877 begin
1878 if (not g_Net_Init()) then
1879 begin
1880 g_Console_Add(_lc[I_NET_MSG_FERROR] + _lc[I_NET_ERR_ENET], True);
1881 Result := False;
1882 Exit;
1883 end
1884 else
1885 NetInitDone := True;
1886 end;
1888 NetHost := enet_host_create(nil, 1, NET_CHANS, 0, 0);
1890 if (NetHost = nil) then
1891 begin
1892 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT], True);
1893 g_Net_Cleanup;
1894 Result := False;
1895 Exit;
1896 end;
1898 enet_address_set_host(@NetAddr, PChar(Addr(IP[1])));
1899 NetAddr.port := Port;
1901 NetPeer := enet_host_connect(NetHost, @NetAddr, NET_CHANS, NET_PROTOCOL_VER);
1903 if (NetPeer = nil) then
1904 begin
1905 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT], True);
1906 enet_host_destroy(NetHost);
1907 g_Net_Cleanup;
1908 Result := False;
1909 Exit;
1910 end;
1912 // предупредить что ждем слишком долго через N секунд
1913 TimeoutTime := sys_GetTicks() + NET_CONNECT_TIMEOUT;
1915 OuterLoop := True;
1916 while OuterLoop do
1917 begin
1918 while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
1919 begin
1920 if (NetEvent.kind = ENET_EVENT_TYPE_CONNECT) then
1921 begin
1922 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_CLIENT_DONE]);
1923 NetMode := NET_CLIENT;
1924 NetOut.Clear();
1925 enet_peer_timeout(NetPeer, ENET_PEER_TIMEOUT_LIMIT * 2, ENET_PEER_TIMEOUT_MINIMUM * 2, ENET_PEER_TIMEOUT_MAXIMUM * 2);
1926 NetClientIP := IP;
1927 NetClientPort := Port;
1928 if NetDump then
1929 g_Net_DumpStart();
1930 Exit;
1931 end;
1932 end;
1934 T := sys_GetTicks();
1935 if T > TimeoutTime then
1936 begin
1937 TimeoutTime := T + NET_CONNECT_TIMEOUT * 100; // одного предупреждения хватит
1938 g_Console_Add(_lc[I_NET_MSG_TIMEOUT_WARN], True);
1939 g_Console_Add(Format(_lc[I_NET_MSG_PORTS], [Integer(Port), Integer(NET_PING_PORT)]), True);
1940 end;
1942 ProcessLoading(true);
1944 if e_KeyPressed(IK_SPACE) or e_KeyPressed(IK_ESCAPE) or e_KeyPressed(VK_ESCAPE) or
1945 e_KeyPressed(JOY0_JUMP) or e_KeyPressed(JOY1_JUMP) or e_KeyPressed(JOY2_JUMP) or e_KeyPressed(JOY3_JUMP) then
1946 OuterLoop := False;
1947 end;
1949 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_TIMEOUT], True);
1950 g_Console_Add(Format(_lc[I_NET_MSG_PORTS], [Integer(Port), Integer(NET_PING_PORT)]), True);
1951 if NetPeer <> nil then enet_peer_reset(NetPeer);
1952 if NetHost <> nil then
1953 begin
1954 enet_host_destroy(NetHost);
1955 NetHost := nil;
1956 end;
1957 g_Net_Cleanup();
1958 Result := False;
1959 end;
1961 function IpToStr(IP: LongWord): string;
1962 var
1963 Ptr: Pointer;
1964 begin
1965 Ptr := Addr(IP);
1966 Result := IntToStr(PByte(Ptr + 0)^) + '.';
1967 Result := Result + IntToStr(PByte(Ptr + 1)^) + '.';
1968 Result := Result + IntToStr(PByte(Ptr + 2)^) + '.';
1969 Result := Result + IntToStr(PByte(Ptr + 3)^);
1970 end;
1972 function StrToIp(IPstr: string; var IP: LongWord): Boolean;
1973 var
1974 EAddr: ENetAddress;
1975 begin
1976 Result := enet_address_set_host(@EAddr, PChar(@IPstr[1])) = 0;
1977 IP := EAddr.host;
1978 end;
1980 function g_Net_Client_ByName(Name: string): pTNetClient;
1981 var
1982 a: Integer;
1983 pl: TPlayer;
1984 begin
1985 Result := nil;
1986 for a := Low(NetClients) to High(NetClients) do
1987 if (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
1988 begin
1989 pl := g_Player_Get(NetClients[a].Player);
1990 if pl = nil then continue;
1991 if Copy(LowerCase(pl.Name), 1, Length(Name)) <> LowerCase(Name) then continue;
1992 if NetClients[a].Peer <> nil then
1993 begin
1994 Result := @NetClients[a];
1995 Exit;
1996 end;
1997 end;
1998 end;
2000 function g_Net_Client_ByPlayer(PID: Word): pTNetClient;
2001 var
2002 a: Integer;
2003 begin
2004 Result := nil;
2005 for a := Low(NetClients) to High(NetClients) do
2006 if (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
2007 if NetClients[a].Player = PID then
2008 begin
2009 Result := @NetClients[a];
2010 Exit;
2011 end;
2012 end;
2014 function g_Net_ClientName_ByID(ID: Integer): string;
2015 var
2016 a: Integer;
2017 pl: TPlayer;
2018 begin
2019 Result := '';
2020 if ID = NET_EVERYONE then
2021 Exit;
2022 for a := Low(NetClients) to High(NetClients) do
2023 if (NetClients[a].ID = ID) and (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
2024 begin
2025 pl := g_Player_Get(NetClients[a].Player);
2026 if pl = nil then Exit;
2027 Result := pl.Name;
2028 end;
2029 end;
2031 procedure g_Net_SendData(Data: AByte; peer: pENetPeer; Reliable: Boolean; Chan: Byte = NET_CHAN_DOWNLOAD);
2032 var
2033 P: pENetPacket;
2034 F: enet_uint32;
2035 dataLength: Cardinal;
2036 begin
2037 dataLength := Length(Data);
2039 if (Reliable) then
2040 F := LongWord(ENET_PACKET_FLAG_RELIABLE)
2041 else
2042 F := 0;
2044 if (peer <> nil) then
2045 begin
2046 P := enet_packet_create(@Data[0], dataLength, F);
2047 if not Assigned(P) then Exit;
2048 enet_peer_send(peer, Chan, P);
2049 end
2050 else
2051 begin
2052 P := enet_packet_create(@Data[0], dataLength, F);
2053 if not Assigned(P) then Exit;
2054 enet_host_broadcast(NetHost, Chan, P);
2055 end;
2057 enet_host_flush(NetHost);
2058 end;
2060 function g_Net_IsHostBanned(IP: LongWord; Perm: Boolean = False): Boolean;
2061 var
2062 I: Integer;
2063 begin
2064 Result := False;
2065 if NetBannedHosts = nil then
2066 Exit;
2067 for I := 0 to High(NetBannedHosts) do
2068 if (NetBannedHosts[I].IP = IP) and ((not Perm) or (NetBannedHosts[I].Perm)) then
2069 begin
2070 Result := True;
2071 break;
2072 end;
2073 end;
2075 procedure g_Net_BanHost(IP: LongWord; Perm: Boolean = True); overload;
2076 var
2077 I, P: Integer;
2078 begin
2079 if IP = 0 then
2080 Exit;
2081 if g_Net_IsHostBanned(IP, Perm) then
2082 Exit;
2084 P := -1;
2085 for I := Low(NetBannedHosts) to High(NetBannedHosts) do
2086 if NetBannedHosts[I].IP = 0 then
2087 begin
2088 P := I;
2089 break;
2090 end;
2092 if P < 0 then
2093 begin
2094 SetLength(NetBannedHosts, Length(NetBannedHosts) + 1);
2095 P := High(NetBannedHosts);
2096 end;
2098 NetBannedHosts[P].IP := IP;
2099 NetBannedHosts[P].Perm := Perm;
2100 end;
2102 procedure g_Net_BanHost(IP: string; Perm: Boolean = True); overload;
2103 var
2104 a: LongWord;
2105 b: Boolean;
2106 begin
2107 b := StrToIp(IP, a);
2108 if b then
2109 g_Net_BanHost(a, Perm);
2110 end;
2112 procedure g_Net_UnbanNonPermHosts();
2113 var
2114 I: Integer;
2115 begin
2116 if NetBannedHosts = nil then
2117 Exit;
2118 for I := Low(NetBannedHosts) to High(NetBannedHosts) do
2119 if (NetBannedHosts[I].IP > 0) and not NetBannedHosts[I].Perm then
2120 begin
2121 NetBannedHosts[I].IP := 0;
2122 NetBannedHosts[I].Perm := True;
2123 end;
2124 end;
2126 function g_Net_UnbanHost(IP: string): Boolean; overload;
2127 var
2128 a: LongWord;
2129 begin
2130 Result := StrToIp(IP, a);
2131 if Result then
2132 Result := g_Net_UnbanHost(a);
2133 end;
2135 function g_Net_UnbanHost(IP: LongWord): Boolean; overload;
2136 var
2137 I: Integer;
2138 begin
2139 Result := False;
2140 if IP = 0 then
2141 Exit;
2142 if NetBannedHosts = nil then
2143 Exit;
2144 for I := 0 to High(NetBannedHosts) do
2145 if NetBannedHosts[I].IP = IP then
2146 begin
2147 NetBannedHosts[I].IP := 0;
2148 NetBannedHosts[I].Perm := True;
2149 Result := True;
2150 // no break here to clear all bans of this host, perm and non-perm
2151 end;
2152 end;
2154 procedure g_Net_SaveBanList();
2155 var
2156 F: TextFile;
2157 I: Integer;
2158 begin
2159 Assign(F, DataDir + BANLIST_FILENAME);
2160 Rewrite(F);
2161 if NetBannedHosts <> nil then
2162 for I := 0 to High(NetBannedHosts) do
2163 if NetBannedHosts[I].Perm and (NetBannedHosts[I].IP > 0) then
2164 Writeln(F, IpToStr(NetBannedHosts[I].IP));
2165 CloseFile(F);
2166 end;
2168 procedure g_Net_DumpStart();
2169 begin
2170 if NetMode = NET_SERVER then
2171 NetDumpFile := createDiskFile(NETDUMP_FILENAME + '_server')
2172 else
2173 NetDumpFile := createDiskFile(NETDUMP_FILENAME + '_client');
2174 end;
2176 procedure g_Net_DumpSendBuffer();
2177 begin
2178 writeInt(NetDumpFile, gTime);
2179 writeInt(NetDumpFile, LongWord(NetOut.CurSize));
2180 writeInt(NetDumpFile, Byte(1));
2181 NetDumpFile.WriteBuffer(NetOut.Data^, NetOut.CurSize);
2182 end;
2184 procedure g_Net_DumpRecvBuffer(Buf: penet_uint8; Len: LongWord);
2185 begin
2186 if (Buf = nil) or (Len = 0) then Exit;
2187 writeInt(NetDumpFile, gTime);
2188 writeInt(NetDumpFile, Len);
2189 writeInt(NetDumpFile, Byte(0));
2190 NetDumpFile.WriteBuffer(Buf^, Len);
2191 end;
2193 procedure g_Net_DumpEnd();
2194 begin
2195 NetDumpFile.Free();
2196 NetDumpFile := nil;
2197 end;
2199 function g_Net_ForwardPorts(ForwardPongPort: Boolean = True): Boolean;
2200 {$IFDEF USE_MINIUPNPC}
2201 var
2202 DevList: PUPNPDev;
2203 Urls: TUPNPUrls;
2204 Data: TIGDDatas;
2205 LanAddr: array [0..255] of Char;
2206 StrPort: AnsiString;
2207 Err, I: Integer;
2208 begin
2209 Result := False;
2211 if NetPortForwarded = NetPort then
2212 begin
2213 Result := True;
2214 exit;
2215 end;
2217 NetPongForwarded := False;
2218 NetPortForwarded := 0;
2220 DevList := upnpDiscover(1000, nil, nil, 0, 0, 2, Addr(Err));
2221 if DevList = nil then
2222 begin
2223 conwritefln('port forwarding failed: upnpDiscover() failed: %d', [Err]);
2224 exit;
2225 end;
2227 I := UPNP_GetValidIGD(DevList, @Urls, @Data, Addr(LanAddr[0]), 256);
2229 if I = 0 then
2230 begin
2231 conwriteln('port forwarding failed: could not find an IGD device on this LAN');
2232 FreeUPNPDevList(DevList);
2233 FreeUPNPUrls(@Urls);
2234 exit;
2235 end;
2237 StrPort := IntToStr(NetPort);
2238 I := UPNP_AddPortMapping(
2239 Urls.controlURL, Addr(data.first.servicetype[1]),
2240 PChar(StrPort), PChar(StrPort), Addr(LanAddr[0]), PChar('D2DF'),
2241 PChar('UDP'), nil, PChar('0')
2242 );
2244 if I <> 0 then
2245 begin
2246 conwritefln('forwarding port %d failed: error %d', [NetPort, I]);
2247 FreeUPNPDevList(DevList);
2248 FreeUPNPUrls(@Urls);
2249 exit;
2250 end;
2252 if ForwardPongPort then
2253 begin
2254 StrPort := IntToStr(NET_PING_PORT);
2255 I := UPNP_AddPortMapping(
2256 Urls.controlURL, Addr(data.first.servicetype[1]),
2257 PChar(StrPort), PChar(StrPort), Addr(LanAddr[0]), PChar('D2DF'),
2258 PChar('UDP'), nil, PChar('0')
2259 );
2261 if I <> 0 then
2262 begin
2263 conwritefln('forwarding port %d failed: error %d', [NetPort + 1, I]);
2264 NetPongForwarded := False;
2265 end
2266 else
2267 begin
2268 conwritefln('forwarded port %d successfully', [NetPort + 1]);
2269 NetPongForwarded := True;
2270 end;
2271 end;
2273 conwritefln('forwarded port %d successfully', [NetPort]);
2274 NetIGDControl := AnsiString(Urls.controlURL);
2275 NetIGDService := data.first.servicetype;
2276 NetPortForwarded := NetPort;
2278 FreeUPNPDevList(DevList);
2279 FreeUPNPUrls(@Urls);
2280 Result := True;
2281 end;
2282 {$ELSE}
2283 begin
2284 Result := False;
2285 end;
2286 {$ENDIF}
2288 procedure g_Net_UnforwardPorts();
2289 {$IFDEF USE_MINIUPNPC}
2290 var
2291 I: Integer;
2292 StrPort: AnsiString;
2293 begin
2294 if NetPortForwarded = 0 then Exit;
2296 conwriteln('unforwarding ports...');
2298 StrPort := IntToStr(NetPortForwarded);
2299 I := UPNP_DeletePortMapping(
2300 PChar(NetIGDControl), Addr(NetIGDService[1]),
2301 PChar(StrPort), PChar('UDP'), nil
2302 );
2303 conwritefln(' port %d: %d', [NetPortForwarded, I]);
2305 if NetPongForwarded then
2306 begin
2307 NetPongForwarded := False;
2308 StrPort := IntToStr(NetPortForwarded + 1);
2309 I := UPNP_DeletePortMapping(
2310 PChar(NetIGDControl), Addr(NetIGDService[1]),
2311 PChar(StrPort), PChar('UDP'), nil
2312 );
2313 conwritefln(' port %d: %d', [NetPortForwarded + 1, I]);
2314 end;
2316 NetPortForwarded := 0;
2317 end;
2318 {$ELSE}
2319 begin
2320 end;
2321 {$ENDIF}
2324 initialization
2325 conRegVar('cl_downloadtimeout', @g_Net_DownloadTimeout, 0.0, 1000000.0, '', 'timeout in seconds, 0 to disable it');
2326 SetLength(NetClients, 0);
2327 g_Net_DownloadTimeout := 60;
2328 NetIn.Alloc(NET_BUFSIZE);
2329 NetOut.Alloc(NET_BUFSIZE);
2330 NetBuf[NET_UNRELIABLE].Alloc(NET_BUFSIZE*2);
2331 NetBuf[NET_RELIABLE].Alloc(NET_BUFSIZE*2);
2332 trans_omsg.Alloc(NET_BUFSIZE);
2333 finalization
2334 NetIn.Free();
2335 NetOut.Free();
2336 NetBuf[NET_UNRELIABLE].Free();
2337 NetBuf[NET_RELIABLE].Free();
2338 end.