DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob


e6c1fbccb6b19deaec6cbb8e58ec3d41c9681eab
[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;
17
18 interface
19
20 uses
21 e_log, e_msg, ENet, Classes, md5, MAPDEF{$IFDEF USE_MINIUPNPC}, miniupnpc;{$ELSE};{$ENDIF}
22
23 const
24 NET_PROTOCOL_VER = 182;
25
26 NET_MAXCLIENTS = 24;
27 NET_CHANS = 12;
28
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;
41
42 NET_NONE = 0;
43 NET_SERVER = 1;
44 NET_CLIENT = 2;
45
46 NET_BUFSIZE = $FFFF;
47 NET_PING_PORT = $DF2D;
48
49 NET_EVERYONE = -1;
50
51 NET_UNRELIABLE = 0;
52 NET_RELIABLE = 1;
53
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;
65
66 NET_STATE_NONE = 0;
67 NET_STATE_AUTH = 1;
68 NET_STATE_GAME = 2;
69
70 NET_CONNECT_TIMEOUT = 1000 * 10;
71
72 BANLIST_FILENAME = 'banlist.txt';
73 NETDUMP_FILENAME = 'netdump';
74
75 {$IF DEFINED(FREEBSD) OR DEFINED(DARWIN)}
76 NilThreadId = nil;
77 {$ELSE}
78 NilThreadId = 0;
79 {$ENDIF}
80
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;
87
88 TNetMapResourceInfoArray = array of TNetMapResourceInfo;
89
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;
103
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;
122
123 AByte = array of Byte;
124
125 var
126 NetInitDone: Boolean = False;
127 NetMode: Byte = NET_NONE;
128 NetDump: Boolean = False;
129
130 NetServerName: string = 'Unnamed Server';
131 NetPassword: string = '';
132 NetPort: Word = 25666;
133
134 NetAllowRCON: Boolean = False;
135 NetRCONPassword: string = '';
136
137 NetTimeToUpdate: Cardinal = 0;
138 NetTimeToReliable: Cardinal = 0;
139 NetTimeToMaster: Cardinal = 0;
140
141 NetHost: pENetHost = nil;
142 NetPeer: pENetPeer = nil;
143 NetEvent: ENetEvent;
144 NetAddr: ENetAddress;
145
146 NetPongAddr: ENetAddress;
147 NetPongSock: ENetSocket = ENET_SOCKET_NULL;
148
149 NetUseMaster: Boolean = True;
150 NetSlistAddr: ENetAddress;
151 NetSlistIP: string = 'mpms.doom2d.org';
152 NetSlistPort: Word = 25665;
153
154 NetClientIP: string = '127.0.0.1';
155 NetClientPort: Word = 25666;
156
157 NetIn, NetOut: TMsg;
158 NetBuf: array [0..1] of TMsg;
159
160 NetClients: array of TNetClient;
161 NetClientCount: Byte = 0;
162 NetMaxClients: Byte = 255;
163 NetBannedHosts: array of TBanRecord;
164
165 NetState: Integer = NET_STATE_NONE;
166
167 NetMyID: Integer = -1;
168 NetPlrUID1: Integer = -1;
169 NetPlrUID2: Integer = -1;
170
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;
175
176 NetForcePlayerUpdate: Boolean = False;
177 NetPredictSelf: Boolean = True;
178 NetForwardPorts: Boolean = False;
179
180 NetGotEverything: Boolean = False;
181 NetGotKeys: Boolean = False;
182
183 {$IFDEF USE_MINIUPNPC}
184 NetPortForwarded: Word = 0;
185 NetPongForwarded: Boolean = False;
186 NetIGDControl: AnsiString;
187 NetIGDService: TURLStr;
188 {$ENDIF}
189
190 NetPortThread: TThreadID = NilThreadId;
191
192 NetDumpFile: TStream;
193
194 g_Res_received_map_start: Integer = 0; // set if we received "map change" event
195
196
197 function g_Net_Init(): Boolean;
198 procedure g_Net_Cleanup();
199 procedure g_Net_Free();
200 procedure g_Net_Flush();
201
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;
206
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;
212
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;
216
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;
220
221 function IpToStr(IP: LongWord): string;
222 function StrToIp(IPstr: string; var IP: LongWord): Boolean;
223
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();
231
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();
236
237 function g_Net_ForwardPorts(ForwardPongPort: Boolean = True): Boolean;
238 procedure g_Net_UnforwardPorts();
239
240 function g_Net_UserRequestExit: Boolean;
241
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;
246
247 function g_Net_IsNetworkAvailable (): Boolean;
248 procedure g_Net_InitLowLevel ();
249 procedure g_Net_DeinitLowLevel ();
250
251
252 implementation
253
254 uses
255 SysUtils,
256 e_input, g_nethandler, g_netmsg, g_netmaster, g_player, g_window, g_console,
257 g_main, g_game, g_language, g_weapons, utils, ctypes, g_system,
258 g_map;
259
260 const
261 FILE_CHUNK_SIZE = 8192;
262
263 var
264 enet_init_success: Boolean = false;
265 g_Net_DownloadTimeout: Single;
266 trans_omsg: TMsg;
267
268
269 function g_Net_IsNetworkAvailable (): Boolean;
270 begin
271 result := enet_init_success;
272 end;
273
274 procedure g_Net_InitLowLevel ();
275 begin
276 if enet_init_success then raise Exception.Create('wuta?!');
277 enet_init_success := (enet_initialize() = 0);
278 end;
279
280 procedure g_Net_DeinitLowLevel ();
281 begin
282 if enet_init_success then
283 begin
284 enet_deinitialize();
285 enet_init_success := false;
286 end;
287 end;
288
289
290 //**************************************************************************
291 //
292 // SERVICE FUNCTIONS
293 //
294 //**************************************************************************
295
296 procedure clearNetClientTransfers (var nc: TNetClient);
297 begin
298 nc.Transfer.stream.Free;
299 nc.Transfer.diskName := ''; // just in case
300 if (nc.Transfer.diskBuffer <> nil) then FreeMem(nc.Transfer.diskBuffer);
301 nc.Transfer.stream := nil;
302 nc.Transfer.diskBuffer := nil;
303 end;
304
305
306 procedure clearNetClient (var nc: TNetClient);
307 begin
308 clearNetClientTransfers(nc);
309 end;
310
311
312 procedure clearNetClients (clearArray: Boolean);
313 var
314 f: Integer;
315 begin
316 for f := Low(NetClients) to High(NetClients) do clearNetClient(NetClients[f]);
317 if (clearArray) then SetLength(NetClients, 0);
318 end;
319
320
321 function g_Net_UserRequestExit (): Boolean;
322 begin
323 Result := {e_KeyPressed(IK_SPACE) or}
324 e_KeyPressed(IK_ESCAPE) or
325 e_KeyPressed(VK_ESCAPE) or
326 e_KeyPressed(JOY0_JUMP) or
327 e_KeyPressed(JOY1_JUMP) or
328 e_KeyPressed(JOY2_JUMP) or
329 e_KeyPressed(JOY3_JUMP)
330 end;
331
332
333 //**************************************************************************
334 //
335 // file transfer declaraions and host packet processor
336 //
337 //**************************************************************************
338
339 const
340 // server packet type
341 NTF_SERVER_DONE = 10; // done with this file
342 NTF_SERVER_FILE_INFO = 11; // sent after client request
343 NTF_SERVER_CHUNK = 12; // next chunk; chunk number follows
344 NTF_SERVER_ABORT = 13; // server abort
345 NTF_SERVER_MAP_INFO = 14;
346
347 // client packet type
348 NTF_CLIENT_MAP_REQUEST = 100; // map file request; also, returns list of additional wads to download
349 NTF_CLIENT_FILE_REQUEST = 101; // resource file request (by index)
350 NTF_CLIENT_ABORT = 102; // do not send requested file, or abort current transfer
351 NTF_CLIENT_START = 103; // start transfer; client may resume download by sending non-zero starting chunk
352 NTF_CLIENT_ACK = 104; // chunk ack; chunk number follows
353
354
355 // disconnect client due to some file transfer error
356 procedure killClientByFT (var nc: TNetClient);
357 begin
358 e_LogWritefln('disconnected client #%d due to file transfer error', [nc.ID], TMsgType.Warning);
359 enet_peer_disconnect(nc.Peer, NET_DISC_FILE_TIMEOUT);
360 clearNetClientTransfers(nc);
361 end;
362
363
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;
376
377
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;
390
391
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;
416
417 if (tf.lastSentChunk > chunks) then
418 begin
419 killClientByFT(nc);
420 exit;
421 end;
422
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;
454
455
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]);
486
487 if (nid < 0) then exit; // wtf?!
488 nc := @NetClients[nid];
489
490 if (NetEvent.packet^.dataLength = 0) then
491 begin
492 killClientByFT(nc^);
493 exit;
494 end;
495
496 tf := @NetClients[nid].Transfer;
497 tf.lastAckTime := GetTimerMS();
498
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 := MapsDir+gGameSettings.WAD else fname := {GameDir+'/wads/'+}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 tf.diskName := findDiskWad(GameDir+'/wads/'+fname);
537 if (length(tf.diskName) = 0) then
538 begin
539 e_LogWritefln('NETWORK: file "%s" not found!', [fname], TMsgType.Fatal);
540 killClientByFT(nc^);
541 exit;
542 end;
543 // calculate hash
544 //tf.hash := MD5File(tf.diskName);
545 if (ridx < 0) then tf.hash := gWADHash else tf.hash := gExternalResources[ridx].hash;
546 // create file stream
547 tf.diskName := findDiskWad(fname);
548 try
549 tf.stream := openDiskFileRO(tf.diskName);
550 except
551 tf.stream := nil;
552 end;
553 if (tf.stream = nil) then
554 begin
555 e_WriteLog(Format('NETWORK: file "%s" not found!', [fname]), TMsgType.Fatal);
556 killClientByFT(nc^);
557 exit;
558 end;
559 e_LogWritefln('client #%d requested resource #%d (file is `%s` : `%s`)', [nc.ID, ridx, fname, tf.diskName]);
560 tf.size := tf.stream.size;
561 tf.chunkSize := FILE_CHUNK_SIZE; // arbitrary
562 tf.lastSentChunk := -1;
563 tf.lastAckChunk := -1;
564 tf.lastAckTime := GetTimerMS();
565 tf.inProgress := False; // waiting for the first ACK or for the cancel
566 GetMem(tf.diskBuffer, tf.chunkSize);
567 // sent file info message
568 trans_omsg.Clear();
569 trans_omsg.Write(Byte(NTF_SERVER_FILE_INFO));
570 trans_omsg.Write(tf.hash);
571 trans_omsg.Write(tf.size);
572 trans_omsg.Write(tf.chunkSize);
573 trans_omsg.Write(ExtractFileName(fname));
574 if not ftransSendServerMsg(nc^, trans_omsg) then exit;
575 end;
576 NTF_CLIENT_ABORT: // do not send requested file, or abort current transfer
577 begin
578 e_LogWritefln('client #%d aborted file transfer', [nc.ID]);
579 clearNetClientTransfers(nc^);
580 end;
581 NTF_CLIENT_START: // start transfer; client may resume download by sending non-zero starting chunk
582 begin
583 if not Assigned(tf.stream) then
584 begin
585 killClientByFT(nc^);
586 exit;
587 end;
588 if (tf.lastSentChunk <> -1) or (tf.lastAckChunk <> -1) or (tf.inProgress) then
589 begin
590 // double ack, get lost
591 killClientByFT(nc^);
592 exit;
593 end;
594 if (NetEvent.packet^.dataLength < 2) then
595 begin
596 killClientByFT(nc^);
597 exit;
598 end;
599 // build packet
600 if not msg.Init(NetEvent.packet^.data+1, NetEvent.packet^.dataLength-1, True) then
601 begin
602 killClientByFT(nc^);
603 exit;
604 end;
605 chunk := msg.ReadLongInt();
606 if (chunk < 0) or (chunk > (tf.size+tf.chunkSize-1) div tf.chunkSize) then
607 begin
608 killClientByFT(nc^);
609 exit;
610 end;
611 e_LogWritefln('client #%d started file transfer from chunk %d', [nc.ID, chunk]);
612 // start sending chunks
613 tf.inProgress := True;
614 tf.lastSentChunk := chunk-1;
615 tf.lastAckChunk := chunk-1;
616 ProcessChunkSend(nc^);
617 end;
618 NTF_CLIENT_ACK: // chunk ack; chunk number follows
619 begin
620 if not Assigned(tf.stream) then
621 begin
622 killClientByFT(nc^);
623 exit;
624 end;
625 if (tf.lastSentChunk < 0) or (not tf.inProgress) then
626 begin
627 // double ack, get lost
628 killClientByFT(nc^);
629 exit;
630 end;
631 if (NetEvent.packet^.dataLength < 2) then
632 begin
633 killClientByFT(nc^);
634 exit;
635 end;
636 // build packet
637 if not msg.Init(NetEvent.packet^.data+1, NetEvent.packet^.dataLength-1, True) then
638 begin
639 killClientByFT(nc^);
640 exit;
641 end;
642 chunk := msg.ReadLongInt();
643 if (chunk < 0) or (chunk > (tf.size+tf.chunkSize-1) div tf.chunkSize) then
644 begin
645 killClientByFT(nc^);
646 exit;
647 end;
648 // do it this way, so client may seek, or request retransfers for some reason
649 tf.lastAckChunk := chunk;
650 tf.lastSentChunk := chunk;
651 //e_LogWritefln('client #%d acked file transfer chunk %d', [nc.ID, chunk]);
652 ProcessChunkSend(nc^);
653 end;
654 NTF_CLIENT_MAP_REQUEST:
655 begin
656 e_LogWritefln('client #%d requested map info', [nc.ID]);
657 trans_omsg.Clear();
658 dfn := findDiskWad(MapsDir+gGameSettings.WAD);
659 if (dfn = '') then dfn := '!wad_not_found!.wad'; //FIXME
660 //md5 := MD5File(dfn);
661 md5 := gWADHash;
662 if (not GetDiskFileInfo(dfn, fi)) then
663 begin
664 e_LogWritefln('client #%d requested map info, but i cannot get file info', [nc.ID]);
665 killClientByFT(nc^);
666 exit;
667 end;
668 size := fi.size;
669 {
670 st := openDiskFileRO(dfn);
671 if not assigned(st) then exit; //wtf?!
672 size := st.size;
673 st.Free;
674 }
675 // packet type
676 trans_omsg.Write(Byte(NTF_SERVER_MAP_INFO));
677 // map wad name
678 trans_omsg.Write(gGameSettings.WAD);
679 // map wad md5
680 trans_omsg.Write(md5);
681 // map wad size
682 trans_omsg.Write(size);
683 // number of external resources for map
684 trans_omsg.Write(LongInt(length(gExternalResources)));
685 // external resource names
686 for f := 0 to High(gExternalResources) do
687 begin
688 // old style packet
689 //trans_omsg.Write(ExtractFileName(gExternalResources[f])); // GameDir+'/wads/'+ResList.Strings[i]
690 // new style packet
691 trans_omsg.Write('!');
692 trans_omsg.Write(LongInt(gExternalResources[f].size));
693 trans_omsg.Write(gExternalResources[f].hash);
694 trans_omsg.Write(ExtractFileName(gExternalResources[f].diskName));
695 end;
696 // send packet
697 if not ftransSendServerMsg(nc^, trans_omsg) then exit;
698 end;
699 else
700 begin
701 killClientByFT(nc^);
702 exit;
703 end;
704 end;
705 end;
706
707
708 //**************************************************************************
709 //
710 // file transfer crap (both client and server)
711 //
712 //**************************************************************************
713
714 function getNewTimeoutEnd (): Int64;
715 begin
716 result := GetTimerMS();
717 if (g_Net_DownloadTimeout <= 0) then
718 begin
719 result := result+1000*60*3; // 3 minutes
720 end
721 else
722 begin
723 result := result+trunc(g_Net_DownloadTimeout*1000);
724 end;
725 end;
726
727
728 // send map request to server, and wait for "map info" server reply
729 //
730 // returns `false` on error or user abort
731 // fills:
732 // diskName: map wad file name (without a path)
733 // hash: map wad hash
734 // size: map wad size
735 // chunkSize: set too
736 // resList: list of resource wads
737 // returns:
738 // <0 on error
739 // 0 on success
740 // 1 on user abort
741 // 2 on server abort
742 // for maps, first `tf.diskName` name will be map wad name, and `tf.hash`/`tf.size` will contain map info
743 function g_Net_Wait_MapInfo (var tf: TNetFileTransfer; var resList: TNetMapResourceInfoArray): Integer;
744 var
745 ev: ENetEvent;
746 rMsgId: Byte;
747 Ptr: Pointer;
748 msg: TMsg;
749 freePacket: Boolean = false;
750 ct, ett: Int64;
751 status: cint;
752 s: AnsiString;
753 rc, f: LongInt;
754 ri: ^TNetMapResourceInfo;
755 begin
756 SetLength(resList, 0);
757
758 // send request
759 trans_omsg.Clear();
760 trans_omsg.Write(Byte(NTF_CLIENT_MAP_REQUEST));
761 if not ftransSendClientMsg(trans_omsg) then begin result := -1; exit; end;
762
763 FillChar(ev, SizeOf(ev), 0);
764 Result := -1;
765 try
766 ett := getNewTimeoutEnd();
767 repeat
768 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;
775 if (status = 0) then
776 begin
777 // check for timeout
778 ct := GetTimerMS();
779 if (ct >= ett) then
780 begin
781 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' timeout reached', True);
782 Result := -1;
783 exit;
784 end;
785 end
786 else
787 begin
788 // some event
789 case ev.kind of
790 ENET_EVENT_TYPE_RECEIVE:
791 begin
792 freePacket := true;
793 if (ev.channelID <> NET_CHAN_DOWNLOAD_EX) then
794 begin
795 //e_LogWritefln('g_Net_Wait_MapInfo: skip message from non-transfer channel', []);
796 freePacket := false;
797 g_Net_Client_HandlePacket(ev.packet, g_Net_ClientLightMsgHandler);
798 if (g_Res_received_map_start < 0) then begin result := -666; exit; end;
799 end
800 else
801 begin
802 ett := getNewTimeoutEnd();
803 if (ev.packet.dataLength < 1) then
804 begin
805 e_LogWritefln('g_Net_Wait_MapInfo: invalid server packet (no data)', []);
806 Result := -1;
807 exit;
808 end;
809 Ptr := ev.packet^.data;
810 rMsgId := Byte(Ptr^);
811 e_LogWritefln('g_Net_Wait_MapInfo: got message %u from server (dataLength=%u)', [rMsgId, ev.packet^.dataLength]);
812 if (rMsgId = NTF_SERVER_FILE_INFO) then
813 begin
814 e_LogWritefln('g_Net_Wait_MapInfo: waiting for map info reply, but got file info reply', []);
815 Result := -1;
816 exit;
817 end
818 else if (rMsgId = NTF_SERVER_ABORT) then
819 begin
820 e_LogWritefln('g_Net_Wait_MapInfo: server aborted transfer', []);
821 Result := 2;
822 exit;
823 end
824 else if (rMsgId = NTF_SERVER_MAP_INFO) then
825 begin
826 e_LogWritefln('g_Net_Wait_MapInfo: creating map info packet...', []);
827 if not msg.Init(ev.packet^.data+1, ev.packet^.dataLength-1, True) then exit;
828 e_LogWritefln('g_Net_Wait_MapInfo: parsing map info packet (rd=%d; max=%d)...', [msg.ReadCount, msg.MaxSize]);
829 SetLength(resList, 0); // just in case
830 // map wad name
831 tf.diskName := msg.ReadString();
832 e_LogWritefln('g_Net_Wait_MapInfo: map wad is `%s`', [tf.diskName]);
833 // map wad md5
834 tf.hash := msg.ReadMD5();
835 // map wad size
836 tf.size := msg.ReadLongInt();
837 e_LogWritefln('g_Net_Wait_MapInfo: map wad size is %d', [tf.size]);
838 // number of external resources for map
839 rc := msg.ReadLongInt();
840 if (rc < 0) or (rc > 1024) then
841 begin
842 e_LogWritefln('g_Net_Wait_Event: invalid number of map external resources (%d)', [rc]);
843 Result := -1;
844 exit;
845 end;
846 e_LogWritefln('g_Net_Wait_MapInfo: map external resource count is %d', [rc]);
847 SetLength(resList, rc);
848 // external resource names
849 for f := 0 to rc-1 do
850 begin
851 ri := @resList[f];
852 s := msg.ReadString();
853 if (length(s) = 0) then begin result := -1; exit; end;
854 if (s = '!') then
855 begin
856 // extended packet
857 ri.size := msg.ReadLongInt();
858 ri.hash := msg.ReadMD5();
859 ri.wadName := ExtractFileName(msg.ReadString());
860 if (length(ri.wadName) = 0) or (ri.size < 0) then begin result := -1; exit; end;
861 end
862 else
863 begin
864 // old-style packet, only name
865 ri.wadName := ExtractFileName(s);
866 if (length(ri.wadName) = 0) then begin result := -1; exit; end;
867 ri.size := -1; // unknown
868 end;
869 end;
870 e_LogWritefln('g_Net_Wait_MapInfo: got map info', []);
871 Result := 0; // success
872 exit;
873 end
874 else
875 begin
876 e_LogWritefln('g_Net_Wait_Event: invalid server packet type', []);
877 Result := -1;
878 exit;
879 end;
880 end;
881 end;
882 ENET_EVENT_TYPE_DISCONNECT:
883 begin
884 if (ev.data <= NET_DISC_MAX) then
885 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' ' + _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + ev.data)], True);
886 Result := -1;
887 exit;
888 end;
889 else
890 begin
891 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' unknown ENet event ' + IntToStr(Ord(ev.kind)), True);
892 result := -1;
893 exit;
894 end;
895 end;
896 if (freePacket) then begin freePacket := false; enet_packet_destroy(ev.packet); end;
897 end;
898 ProcessLoading();
899 if g_Net_UserRequestExit() then
900 begin
901 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' user abort', True);
902 Result := 1;
903 exit;
904 end;
905 until false;
906 finally
907 if (freePacket) then enet_packet_destroy(ev.packet);
908 end;
909 end;
910
911
912 // send file request to server, and wait for server reply
913 //
914 // returns `false` on error or user abort
915 // fills:
916 // diskName (actually, base name)
917 // hash
918 // size
919 // chunkSize
920 // returns:
921 // <0 on error
922 // 0 on success
923 // 1 on user abort
924 // 2 on server abort
925 // for maps, first `tf.diskName` name will be map wad name, and `tf.hash`/`tf.size` will contain map info
926 function g_Net_RequestResFileInfo (resIndex: LongInt; out tf: TNetFileTransfer): Integer;
927 var
928 ev: ENetEvent;
929 rMsgId: Byte;
930 Ptr: Pointer;
931 msg: TMsg;
932 freePacket: Boolean = false;
933 ct, ett: Int64;
934 status: cint;
935 begin
936 // send request
937 trans_omsg.Clear();
938 trans_omsg.Write(Byte(NTF_CLIENT_FILE_REQUEST));
939 trans_omsg.Write(resIndex);
940 if not ftransSendClientMsg(trans_omsg) then begin result := -1; exit; end;
941
942 FillChar(ev, SizeOf(ev), 0);
943 Result := -1;
944 try
945 ett := getNewTimeoutEnd();
946 repeat
947 status := enet_host_service(NetHost, @ev, 300);
948 if (status < 0) then
949 begin
950 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' network error', True);
951 Result := -1;
952 exit;
953 end;
954 if (status = 0) then
955 begin
956 // check for timeout
957 ct := GetTimerMS();
958 if (ct >= ett) then
959 begin
960 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' timeout reached', True);
961 Result := -1;
962 exit;
963 end;
964 end
965 else
966 begin
967 // some event
968 case ev.kind of
969 ENET_EVENT_TYPE_RECEIVE:
970 begin
971 freePacket := true;
972 if (ev.channelID <> NET_CHAN_DOWNLOAD_EX) then
973 begin
974 //e_LogWriteln('g_Net_Wait_Event: skip message from non-transfer channel');
975 freePacket := false;
976 g_Net_Client_HandlePacket(ev.packet, g_Net_ClientLightMsgHandler);
977 if (g_Res_received_map_start < 0) then begin result := -666; exit; end;
978 end
979 else
980 begin
981 ett := getNewTimeoutEnd();
982 if (ev.packet.dataLength < 1) then
983 begin
984 e_LogWriteln('g_Net_Wait_Event: invalid server packet (no data)');
985 Result := -1;
986 exit;
987 end;
988 Ptr := ev.packet^.data;
989 rMsgId := Byte(Ptr^);
990 e_LogWritefln('received transfer packet with id %d (%u bytes)', [rMsgId, ev.packet^.dataLength]);
991 if (rMsgId = NTF_SERVER_FILE_INFO) then
992 begin
993 if not msg.Init(ev.packet^.data+1, ev.packet^.dataLength-1, True) then exit;
994 tf.hash := msg.ReadMD5();
995 tf.size := msg.ReadLongInt();
996 tf.chunkSize := msg.ReadLongInt();
997 tf.diskName := ExtractFileName(msg.readString());
998 if (tf.size < 0) or (tf.chunkSize <> FILE_CHUNK_SIZE) or (length(tf.diskName) = 0) then
999 begin
1000 e_LogWritefln('g_Net_RequestResFileInfo: invalid file info packet', []);
1001 Result := -1;
1002 exit;
1003 end;
1004 e_LogWritefln('got file info for resource #%d: size=%d; name=%s', [resIndex, tf.size, tf.diskName]);
1005 Result := 0; // success
1006 exit;
1007 end
1008 else if (rMsgId = NTF_SERVER_ABORT) then
1009 begin
1010 e_LogWriteln('g_Net_RequestResFileInfo: server aborted transfer');
1011 Result := 2;
1012 exit;
1013 end
1014 else if (rMsgId = NTF_SERVER_MAP_INFO) then
1015 begin
1016 e_LogWriteln('g_Net_RequestResFileInfo: waiting for map info reply, but got file info reply');
1017 Result := -1;
1018 exit;
1019 end
1020 else
1021 begin
1022 e_LogWriteln('g_Net_RequestResFileInfo: invalid server packet type');
1023 Result := -1;
1024 exit;
1025 end;
1026 end;
1027 end;
1028 ENET_EVENT_TYPE_DISCONNECT:
1029 begin
1030 if (ev.data <= NET_DISC_MAX) then
1031 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' ' + _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + ev.data)], True);
1032 Result := -1;
1033 exit;
1034 end;
1035 else
1036 begin
1037 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' unknown ENet event ' + IntToStr(Ord(ev.kind)), True);
1038 result := -1;
1039 exit;
1040 end;
1041 end;
1042 if (freePacket) then begin freePacket := false; enet_packet_destroy(ev.packet); end;
1043 end;
1044 ProcessLoading();
1045 if g_Net_UserRequestExit() then
1046 begin
1047 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' user abort', True);
1048 Result := 1;
1049 exit;
1050 end;
1051 until false;
1052 finally
1053 if (freePacket) then enet_packet_destroy(ev.packet);
1054 end;
1055 end;
1056
1057
1058 // call this to cancel file transfer requested by `g_Net_RequestResFileInfo()`
1059 function g_Net_AbortResTransfer (var tf: TNetFileTransfer): Boolean;
1060 begin
1061 result := false;
1062 e_LogWritefln('aborting file transfer...', []);
1063 // send request
1064 trans_omsg.Clear();
1065 trans_omsg.Write(Byte(NTF_CLIENT_ABORT));
1066 result := ftransSendClientMsg(trans_omsg);
1067 if result then enet_host_flush(NetHost);
1068 end;
1069
1070
1071 // call this to start file transfer requested by `g_Net_RequestResFileInfo()`
1072 //
1073 // returns `false` on error or user abort
1074 // fills:
1075 // hash
1076 // size
1077 // chunkSize
1078 // returns:
1079 // <0 on error
1080 // 0 on success
1081 // 1 on user abort
1082 // 2 on server abort
1083 // for maps, first `tf.diskName` name will be map wad name, and `tf.hash`/`tf.size` will contain map info
1084 function g_Net_ReceiveResourceFile (resIndex: LongInt; var tf: TNetFileTransfer; strm: TStream): Integer;
1085 var
1086 ev: ENetEvent;
1087 rMsgId: Byte;
1088 Ptr: Pointer;
1089 msg: TMsg;
1090 freePacket: Boolean = false;
1091 ct, ett: Int64;
1092 status: cint;
1093 nextChunk: Integer = 0;
1094 chunkTotal: Integer;
1095 chunk: Integer;
1096 csize: Integer;
1097 buf: PChar = nil;
1098 resumed: Boolean;
1099 //stx: Int64;
1100 begin
1101 tf.resumed := false;
1102 e_LogWritefln('file `%s`, size=%d (%d)', [tf.diskName, Integer(strm.size), tf.size], TMsgType.Notify);
1103 // check if we should resume downloading
1104 resumed := (strm.size > tf.chunkSize) and (strm.size < tf.size);
1105 // send request
1106 trans_omsg.Clear();
1107 trans_omsg.Write(Byte(NTF_CLIENT_START));
1108 if resumed then chunk := strm.size div tf.chunkSize else chunk := 0;
1109 trans_omsg.Write(LongInt(chunk));
1110 if not ftransSendClientMsg(trans_omsg) then begin result := -1; exit; end;
1111
1112 strm.Seek(chunk*tf.chunkSize, soFromBeginning);
1113 chunkTotal := (tf.size+tf.chunkSize-1) div tf.chunkSize;
1114 e_LogWritefln('receiving file `%s` (%d chunks)', [tf.diskName, chunkTotal], TMsgType.Notify);
1115 g_Game_SetLoadingText('downloading "'+ExtractFileName(tf.diskName)+'"', chunkTotal, False);
1116 tf.resumed := resumed;
1117
1118 if (chunk > 0) then g_Game_StepLoading(chunk);
1119 nextChunk := chunk;
1120
1121 // wait for reply data
1122 FillChar(ev, SizeOf(ev), 0);
1123 Result := -1;
1124 GetMem(buf, tf.chunkSize);
1125 try
1126 ett := getNewTimeoutEnd();
1127 repeat
1128 //stx := -GetTimerMS();
1129 status := enet_host_service(NetHost, @ev, 300);
1130 if (status < 0) then
1131 begin
1132 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' network error', True);
1133 Result := -1;
1134 exit;
1135 end;
1136 if (status = 0) then
1137 begin
1138 // check for timeout
1139 ct := GetTimerMS();
1140 if (ct >= ett) then
1141 begin
1142 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' timeout reached', True);
1143 Result := -1;
1144 exit;
1145 end;
1146 end
1147 else
1148 begin
1149 // some event
1150 case ev.kind of
1151 ENET_EVENT_TYPE_RECEIVE:
1152 begin
1153 freePacket := true;
1154 if (ev.channelID <> NET_CHAN_DOWNLOAD_EX) then
1155 begin
1156 //e_LogWritefln('g_Net_Wait_Event: skip message from non-transfer channel', []);
1157 freePacket := false;
1158 g_Net_Client_HandlePacket(ev.packet, g_Net_ClientLightMsgHandler);
1159 if (g_Res_received_map_start < 0) then begin result := -666; exit; end;
1160 end
1161 else
1162 begin
1163 //stx := stx+GetTimerMS();
1164 //e_LogWritefln('g_Net_ReceiveResourceFile: stx=%d', [Integer(stx)]);
1165 //stx := -GetTimerMS();
1166 ett := getNewTimeoutEnd();
1167 if (ev.packet.dataLength < 1) then
1168 begin
1169 e_LogWritefln('g_Net_ReceiveResourceFile: invalid server packet (no data)', []);
1170 Result := -1;
1171 exit;
1172 end;
1173 Ptr := ev.packet^.data;
1174 rMsgId := Byte(Ptr^);
1175 if (rMsgId = NTF_SERVER_DONE) then
1176 begin
1177 e_LogWritefln('file transfer complete.', []);
1178 result := 0;
1179 exit;
1180 end
1181 else if (rMsgId = NTF_SERVER_CHUNK) then
1182 begin
1183 if not msg.Init(ev.packet^.data+1, ev.packet^.dataLength-1, True) then exit;
1184 chunk := msg.ReadLongInt();
1185 csize := msg.ReadLongInt();
1186 if (chunk <> nextChunk) then
1187 begin
1188 e_LogWritefln('received chunk %d, but expected chunk %d', [chunk, nextChunk]);
1189 Result := -1;
1190 exit;
1191 end;
1192 if (csize < 0) or (csize > tf.chunkSize) then
1193 begin
1194 e_LogWritefln('received chunk with size %d, but expected chunk size is %d', [csize, tf.chunkSize]);
1195 Result := -1;
1196 exit;
1197 end;
1198 //e_LogWritefln('got chunk #%d of #%d (csize=%d)', [chunk, (tf.size+tf.chunkSize-1) div tf.chunkSize, csize]);
1199 msg.ReadData(buf, csize);
1200 strm.WriteBuffer(buf^, csize);
1201 nextChunk := chunk+1;
1202 g_Game_StepLoading();
1203 // send ack
1204 trans_omsg.Clear();
1205 trans_omsg.Write(Byte(NTF_CLIENT_ACK));
1206 trans_omsg.Write(LongInt(chunk));
1207 if not ftransSendClientMsg(trans_omsg) then begin result := -1; exit; end;
1208 end
1209 else if (rMsgId = NTF_SERVER_ABORT) then
1210 begin
1211 e_LogWritefln('g_Net_ReceiveResourceFile: server aborted transfer', []);
1212 Result := 2;
1213 exit;
1214 end
1215 else
1216 begin
1217 e_LogWritefln('g_Net_ReceiveResourceFile: invalid server packet type', []);
1218 Result := -1;
1219 exit;
1220 end;
1221 //stx := stx+GetTimerMS();
1222 //e_LogWritefln('g_Net_ReceiveResourceFile: process stx=%d', [Integer(stx)]);
1223 end;
1224 end;
1225 ENET_EVENT_TYPE_DISCONNECT:
1226 begin
1227 if (ev.data <= NET_DISC_MAX) then
1228 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' ' + _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + ev.data)], True);
1229 Result := -1;
1230 exit;
1231 end;
1232 else
1233 begin
1234 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' unknown ENet event ' + IntToStr(Ord(ev.kind)), True);
1235 result := -1;
1236 exit;
1237 end;
1238 end;
1239 if (freePacket) then begin freePacket := false; enet_packet_destroy(ev.packet); end;
1240 end;
1241 ProcessLoading();
1242 if g_Net_UserRequestExit() then
1243 begin
1244 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' user abort', True);
1245 Result := 1;
1246 exit;
1247 end;
1248 until false;
1249 finally
1250 FreeMem(buf);
1251 if (freePacket) then enet_packet_destroy(ev.packet);
1252 end;
1253 end;
1254
1255
1256 //**************************************************************************
1257 //
1258 // common functions
1259 //
1260 //**************************************************************************
1261
1262 function g_Net_FindSlot(): Integer;
1263 var
1264 I: Integer;
1265 F: Boolean;
1266 N, C: Integer;
1267 begin
1268 N := -1;
1269 F := False;
1270 C := 0;
1271 for I := Low(NetClients) to High(NetClients) do
1272 begin
1273 if NetClients[I].Used then
1274 Inc(C)
1275 else
1276 if not F then
1277 begin
1278 F := True;
1279 N := I;
1280 end;
1281 end;
1282 if C >= NetMaxClients then
1283 begin
1284 Result := -1;
1285 Exit;
1286 end;
1287
1288 if not F then
1289 begin
1290 if (Length(NetClients) >= NetMaxClients) then
1291 N := -1
1292 else
1293 begin
1294 SetLength(NetClients, Length(NetClients) + 1);
1295 N := High(NetClients);
1296 end;
1297 end;
1298
1299 if N >= 0 then
1300 begin
1301 NetClients[N].Used := True;
1302 NetClients[N].ID := N;
1303 NetClients[N].RequestedFullUpdate := False;
1304 NetClients[N].WaitForFirstSpawn := False;
1305 NetClients[N].RCONAuth := False;
1306 NetClients[N].Voted := False;
1307 NetClients[N].Player := 0;
1308 clearNetClientTransfers(NetClients[N]); // just in case
1309 end;
1310
1311 Result := N;
1312 end;
1313
1314
1315 function g_Net_Init(): Boolean;
1316 var
1317 F: TextFile;
1318 IPstr: string;
1319 IP: LongWord;
1320 begin
1321 NetIn.Clear();
1322 NetOut.Clear();
1323 NetBuf[NET_UNRELIABLE].Clear();
1324 NetBuf[NET_RELIABLE].Clear();
1325 //SetLength(NetClients, 0);
1326 clearNetClients(true); // clear array
1327 NetPeer := nil;
1328 NetHost := nil;
1329 NetMyID := -1;
1330 NetPlrUID1 := -1;
1331 NetPlrUID2 := -1;
1332 NetAddr.port := 25666;
1333 SetLength(NetBannedHosts, 0);
1334 if FileExists(DataDir + BANLIST_FILENAME) then
1335 begin
1336 Assign(F, DataDir + BANLIST_FILENAME);
1337 Reset(F);
1338 while not EOF(F) do
1339 begin
1340 Readln(F, IPstr);
1341 if StrToIp(IPstr, IP) then
1342 g_Net_BanHost(IP);
1343 end;
1344 CloseFile(F);
1345 g_Net_SaveBanList();
1346 end;
1347
1348 //Result := (enet_initialize() = 0);
1349 Result := enet_init_success;
1350 end;
1351
1352 procedure g_Net_Flush();
1353 var
1354 T: Integer;
1355 P: pENetPacket;
1356 F, Chan: enet_uint32;
1357 I: Integer;
1358 begin
1359 F := 0;
1360 Chan := NET_CHAN_GAME;
1361
1362 if NetMode = NET_SERVER then
1363 for T := NET_UNRELIABLE to NET_RELIABLE do
1364 begin
1365 if NetBuf[T].CurSize > 0 then
1366 begin
1367 P := enet_packet_create(NetBuf[T].Data, NetBuf[T].CurSize, F);
1368 if not Assigned(P) then continue;
1369 enet_host_broadcast(NetHost, Chan, P);
1370 NetBuf[T].Clear();
1371 end;
1372
1373 for I := Low(NetClients) to High(NetClients) do
1374 begin
1375 if not NetClients[I].Used then continue;
1376 if NetClients[I].NetOut[T].CurSize <= 0 then continue;
1377 P := enet_packet_create(NetClients[I].NetOut[T].Data, NetClients[I].NetOut[T].CurSize, F);
1378 if not Assigned(P) then continue;
1379 enet_peer_send(NetClients[I].Peer, Chan, P);
1380 NetClients[I].NetOut[T].Clear();
1381 end;
1382
1383 // next and last iteration is always RELIABLE
1384 F := LongWord(ENET_PACKET_FLAG_RELIABLE);
1385 Chan := NET_CHAN_IMPORTANT;
1386 end
1387 else if NetMode = NET_CLIENT then
1388 for T := NET_UNRELIABLE to NET_RELIABLE do
1389 begin
1390 if NetBuf[T].CurSize > 0 then
1391 begin
1392 P := enet_packet_create(NetBuf[T].Data, NetBuf[T].CurSize, F);
1393 if not Assigned(P) then continue;
1394 enet_peer_send(NetPeer, Chan, P);
1395 NetBuf[T].Clear();
1396 end;
1397 // next and last iteration is always RELIABLE
1398 F := LongWord(ENET_PACKET_FLAG_RELIABLE);
1399 Chan := NET_CHAN_IMPORTANT;
1400 end;
1401 end;
1402
1403 procedure g_Net_Cleanup();
1404 begin
1405 NetIn.Clear();
1406 NetOut.Clear();
1407 NetBuf[NET_UNRELIABLE].Clear();
1408 NetBuf[NET_RELIABLE].Clear();
1409
1410 //SetLength(NetClients, 0);
1411 clearNetClients(true); // clear array
1412 NetClientCount := 0;
1413
1414 NetPeer := nil;
1415 NetHost := nil;
1416 g_Net_Slist_NetworkStopped();
1417 //g_Net_Slist_Disconnect(false); // do not spam console
1418 NetMyID := -1;
1419 NetPlrUID1 := -1;
1420 NetPlrUID2 := -1;
1421 NetState := NET_STATE_NONE;
1422
1423 NetPongSock := ENET_SOCKET_NULL;
1424
1425 NetTimeToMaster := 0;
1426 NetTimeToUpdate := 0;
1427 NetTimeToReliable := 0;
1428
1429 NetMode := NET_NONE;
1430
1431 if NetPortThread <> NilThreadId then
1432 WaitForThreadTerminate(NetPortThread, 66666);
1433
1434 NetPortThread := NilThreadId;
1435 g_Net_UnforwardPorts();
1436
1437 if NetDump then
1438 g_Net_DumpEnd();
1439 end;
1440
1441 procedure g_Net_Free();
1442 begin
1443 g_Net_Cleanup();
1444
1445 //enet_deinitialize();
1446 NetInitDone := False;
1447 end;
1448
1449
1450 //**************************************************************************
1451 //
1452 // SERVER FUNCTIONS
1453 //
1454 //**************************************************************************
1455
1456 function ForwardThread(Param: Pointer): PtrInt;
1457 begin
1458 Result := 0;
1459 if not g_Net_ForwardPorts() then Result := -1;
1460 end;
1461
1462 function g_Net_Host(IPAddr: LongWord; Port: enet_uint16; MaxClients: Cardinal = 16): Boolean;
1463 begin
1464 if NetMode <> NET_NONE then
1465 begin
1466 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_INGAME]);
1467 Result := False;
1468 Exit;
1469 end;
1470
1471 Result := True;
1472
1473 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST], [Port]));
1474 if not NetInitDone then
1475 begin
1476 if (not g_Net_Init()) then
1477 begin
1478 g_Console_Add(_lc[I_NET_MSG_FERROR] + _lc[I_NET_ERR_ENET]);
1479 Result := False;
1480 Exit;
1481 end
1482 else
1483 NetInitDone := True;
1484 end;
1485
1486 NetAddr.host := IPAddr;
1487 NetAddr.port := Port;
1488
1489 if NetForwardPorts then NetPortThread := BeginThread(ForwardThread);
1490
1491 NetHost := enet_host_create(@NetAddr, NET_MAXCLIENTS, NET_CHANS, 0, 0);
1492
1493 if (NetHost = nil) then
1494 begin
1495 g_Console_Add(_lc[I_NET_MSG_ERROR] + Format(_lc[I_NET_ERR_HOST], [Port]));
1496 Result := False;
1497 g_Net_Cleanup;
1498 Exit;
1499 end;
1500
1501 NetPongSock := enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM);
1502 if NetPongSock <> ENET_SOCKET_NULL then
1503 begin
1504 NetPongAddr.host := IPAddr;
1505 NetPongAddr.port := NET_PING_PORT;
1506 if enet_socket_bind(NetPongSock, @NetPongAddr) < 0 then
1507 begin
1508 enet_socket_destroy(NetPongSock);
1509 NetPongSock := ENET_SOCKET_NULL;
1510 end
1511 else
1512 enet_socket_set_option(NetPongSock, ENET_SOCKOPT_NONBLOCK, 1);
1513 end;
1514
1515 NetMode := NET_SERVER;
1516 NetOut.Clear();
1517 NetBuf[NET_UNRELIABLE].Clear();
1518 NetBuf[NET_RELIABLE].Clear();
1519
1520 if NetDump then
1521 g_Net_DumpStart();
1522 end;
1523
1524 procedure g_Net_Host_Die();
1525 var
1526 I: Integer;
1527 begin
1528 if NetMode <> NET_SERVER then Exit;
1529
1530 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_DISCALL]);
1531 for I := 0 to High(NetClients) do
1532 if NetClients[I].Used then
1533 enet_peer_disconnect(NetClients[I].Peer, NET_DISC_DOWN);
1534
1535 while enet_host_service(NetHost, @NetEvent, 1000) > 0 do
1536 if NetEvent.kind = ENET_EVENT_TYPE_RECEIVE then
1537 enet_packet_destroy(NetEvent.packet);
1538
1539 for I := 0 to High(NetClients) do
1540 if NetClients[I].Used then
1541 begin
1542 FreeMemory(NetClients[I].Peer^.data);
1543 NetClients[I].Peer^.data := nil;
1544 enet_peer_reset(NetClients[I].Peer);
1545 NetClients[I].Peer := nil;
1546 NetClients[I].Used := False;
1547 NetClients[I].NetOut[NET_UNRELIABLE].Free();
1548 NetClients[I].NetOut[NET_RELIABLE].Free();
1549 end;
1550
1551 clearNetClients(false); // don't clear array
1552 //if (g_Net_Slist_IsConnectionActive) then g_Net_Slist_Disconnect;
1553 g_Net_Slist_NetworkStopped();
1554 if NetPongSock <> ENET_SOCKET_NULL then
1555 enet_socket_destroy(NetPongSock);
1556
1557 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_DIE]);
1558 enet_host_destroy(NetHost);
1559
1560 NetMode := NET_NONE;
1561
1562 g_Net_Cleanup;
1563 e_WriteLog('NET: Server stopped', TMsgType.Notify);
1564 end;
1565
1566
1567 procedure g_Net_Host_Send(ID: Integer; Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
1568 var
1569 T: Integer;
1570 begin
1571 if (Reliable) then
1572 T := NET_RELIABLE
1573 else
1574 T := NET_UNRELIABLE;
1575
1576 if (ID >= 0) then
1577 begin
1578 if ID > High(NetClients) then Exit;
1579 if NetClients[ID].Peer = nil then Exit;
1580 // write size first
1581 NetClients[ID].NetOut[T].Write(Integer(NetOut.CurSize));
1582 NetClients[ID].NetOut[T].Write(NetOut);
1583 end
1584 else
1585 begin
1586 // write size first
1587 NetBuf[T].Write(Integer(NetOut.CurSize));
1588 NetBuf[T].Write(NetOut);
1589 end;
1590
1591 if NetDump then g_Net_DumpSendBuffer();
1592 NetOut.Clear();
1593 end;
1594
1595 procedure g_Net_Host_CheckPings();
1596 var
1597 ClAddr: ENetAddress;
1598 Buf: ENetBuffer;
1599 Len: Integer;
1600 ClTime: Int64;
1601 Ping: array [0..9] of Byte;
1602 NPl: Byte;
1603 begin
1604 if NetPongSock = ENET_SOCKET_NULL then Exit;
1605
1606 Buf.data := Addr(Ping[0]);
1607 Buf.dataLength := 2+8;
1608
1609 Ping[0] := 0;
1610
1611 Len := enet_socket_receive(NetPongSock, @ClAddr, @Buf, 1);
1612 if Len < 0 then Exit;
1613
1614 if (Ping[0] = Ord('D')) and (Ping[1] = Ord('F')) then
1615 begin
1616 ClTime := Int64(Addr(Ping[2])^);
1617
1618 NetOut.Clear();
1619 NetOut.Write(Byte(Ord('D')));
1620 NetOut.Write(Byte(Ord('F')));
1621 NetOut.Write(NetPort);
1622 NetOut.Write(ClTime);
1623 //g_Net_Slist_WriteInfo();
1624 TMasterHost.writeInfo(NetOut);
1625 NPl := 0;
1626 if gPlayer1 <> nil then Inc(NPl);
1627 if gPlayer2 <> nil then Inc(NPl);
1628 NetOut.Write(NPl);
1629 NetOut.Write(gNumBots);
1630
1631 Buf.data := NetOut.Data;
1632 Buf.dataLength := NetOut.CurSize;
1633 enet_socket_send(NetPongSock, @ClAddr, @Buf, 1);
1634
1635 NetOut.Clear();
1636 end;
1637 end;
1638
1639
1640 function g_Net_Host_Update(): enet_size_t;
1641 var
1642 IP: string;
1643 Port: Word;
1644 ID: Integer;
1645 TC: pTNetClient;
1646 TP: TPlayer;
1647 begin
1648 IP := '';
1649 Result := 0;
1650
1651 if NetUseMaster then
1652 begin
1653 //g_Net_Slist_Check;
1654 g_Net_Slist_Pulse();
1655 end;
1656 g_Net_Host_CheckPings;
1657
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]));
1667
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;
1678
1679 ID := g_Net_FindSlot();
1680
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;
1691
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
1700
1701 enet_peer_timeout(NetEvent.peer, ENET_PEER_TIMEOUT_LIMIT * 2, ENET_PEER_TIMEOUT_MINIMUM * 2, ENET_PEER_TIMEOUT_MAXIMUM * 2);
1702
1703 Inc(NetClientCount);
1704 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST_ADD], [ID]));
1705 end;
1706
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];
1719
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;
1724
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;
1732
1733 if not (TC^.Used) then Exit;
1734
1735 TP := g_Player_Get(TC^.Player);
1736
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;
1745
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();
1754
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);
1759
1760 if NetUseMaster then
1761 begin
1762 //g_Net_Slist_Update;
1763 g_Net_Slist_Pulse();
1764 end;
1765 end;
1766 end;
1767 end;
1768 end;
1769
1770
1771 //**************************************************************************
1772 //
1773 // CLIENT FUNCTIONS
1774 //
1775 //**************************************************************************
1776
1777 procedure g_Net_Disconnect(Forced: Boolean = False);
1778 begin
1779 if NetMode <> NET_CLIENT then Exit;
1780 if (NetHost = nil) or (NetPeer = nil) then Exit;
1781
1782 if not Forced then
1783 begin
1784 enet_peer_disconnect(NetPeer, NET_DISC_NONE);
1785
1786 while (enet_host_service(NetHost, @NetEvent, 1500) > 0) do
1787 begin
1788 if (NetEvent.kind = ENET_EVENT_TYPE_DISCONNECT) then
1789 begin
1790 NetPeer := nil;
1791 break;
1792 end;
1793
1794 if (NetEvent.kind = ENET_EVENT_TYPE_RECEIVE) then
1795 enet_packet_destroy(NetEvent.packet);
1796 end;
1797
1798 if NetPeer <> nil then
1799 begin
1800 enet_peer_reset(NetPeer);
1801 NetPeer := nil;
1802 end;
1803 end
1804 else
1805 begin
1806 e_WriteLog('NET: Kicked from server: ' + IntToStr(NetEvent.data), TMsgType.Notify);
1807 if (NetEvent.data <= NET_DISC_MAX) then
1808 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_KICK] +
1809 _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + NetEvent.data)], True);
1810 end;
1811
1812 if NetHost <> nil then
1813 begin
1814 enet_host_destroy(NetHost);
1815 NetHost := nil;
1816 end;
1817 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_CLIENT_DISC]);
1818
1819 g_Net_Cleanup;
1820 e_WriteLog('NET: Disconnected', TMsgType.Notify);
1821 end;
1822
1823 procedure g_Net_Client_Send(Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
1824 var
1825 T: Integer;
1826 begin
1827 if (Reliable) then
1828 T := NET_RELIABLE
1829 else
1830 T := NET_UNRELIABLE;
1831
1832 // write size first
1833 NetBuf[T].Write(Integer(NetOut.CurSize));
1834 NetBuf[T].Write(NetOut);
1835
1836 if NetDump then g_Net_DumpSendBuffer();
1837 NetOut.Clear();
1838 g_Net_Flush(); // FIXME: for now, send immediately
1839 end;
1840
1841 function g_Net_Client_Update(): enet_size_t;
1842 begin
1843 Result := 0;
1844 while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
1845 begin
1846 case NetEvent.kind of
1847 ENET_EVENT_TYPE_RECEIVE:
1848 begin
1849 if (NetEvent.channelID = NET_CHAN_DOWNLOAD_EX) then continue; // ignore all download packets, they're processed by separate code
1850 if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
1851 g_Net_Client_HandlePacket(NetEvent.packet, g_Net_ClientMsgHandler);
1852 end;
1853
1854 ENET_EVENT_TYPE_DISCONNECT:
1855 begin
1856 g_Net_Disconnect(True);
1857 Result := 1;
1858 Exit;
1859 end;
1860 end;
1861 end
1862 end;
1863
1864 function g_Net_Client_UpdateWhileLoading(): enet_size_t;
1865 begin
1866 Result := 0;
1867 while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
1868 begin
1869 case NetEvent.kind of
1870 ENET_EVENT_TYPE_RECEIVE:
1871 begin
1872 if (NetEvent.channelID = NET_CHAN_DOWNLOAD_EX) then continue; // ignore all download packets, they're processed by separate code
1873 if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
1874 g_Net_Client_HandlePacket(NetEvent.packet, g_Net_ClientLightMsgHandler);
1875 end;
1876
1877 ENET_EVENT_TYPE_DISCONNECT:
1878 begin
1879 g_Net_Disconnect(True);
1880 Result := 1;
1881 Exit;
1882 end;
1883 end;
1884 end;
1885 g_Net_Flush();
1886 end;
1887
1888 function g_Net_Connect(IP: string; Port: enet_uint16): Boolean;
1889 var
1890 OuterLoop: Boolean;
1891 TimeoutTime, T: Int64;
1892 begin
1893 if NetMode <> NET_NONE then
1894 begin
1895 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_ERR_INGAME], True);
1896 Result := False;
1897 Exit;
1898 end;
1899
1900 Result := True;
1901
1902 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_CLIENT_CONN],
1903 [IP, Port]));
1904 if not NetInitDone then
1905 begin
1906 if (not g_Net_Init()) then
1907 begin
1908 g_Console_Add(_lc[I_NET_MSG_FERROR] + _lc[I_NET_ERR_ENET], True);
1909 Result := False;
1910 Exit;
1911 end
1912 else
1913 NetInitDone := True;
1914 end;
1915
1916 NetHost := enet_host_create(nil, 1, NET_CHANS, 0, 0);
1917
1918 if (NetHost = nil) then
1919 begin
1920 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT], True);
1921 g_Net_Cleanup;
1922 Result := False;
1923 Exit;
1924 end;
1925
1926 enet_address_set_host(@NetAddr, PChar(Addr(IP[1])));
1927 NetAddr.port := Port;
1928
1929 NetPeer := enet_host_connect(NetHost, @NetAddr, NET_CHANS, NET_PROTOCOL_VER);
1930
1931 if (NetPeer = nil) then
1932 begin
1933 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT], True);
1934 enet_host_destroy(NetHost);
1935 g_Net_Cleanup;
1936 Result := False;
1937 Exit;
1938 end;
1939
1940 // предупредить что ждем слишком долго через N секунд
1941 TimeoutTime := sys_GetTicks() + NET_CONNECT_TIMEOUT;
1942
1943 OuterLoop := True;
1944 while OuterLoop do
1945 begin
1946 while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
1947 begin
1948 if (NetEvent.kind = ENET_EVENT_TYPE_CONNECT) then
1949 begin
1950 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_CLIENT_DONE]);
1951 NetMode := NET_CLIENT;
1952 NetOut.Clear();
1953 enet_peer_timeout(NetPeer, ENET_PEER_TIMEOUT_LIMIT * 2, ENET_PEER_TIMEOUT_MINIMUM * 2, ENET_PEER_TIMEOUT_MAXIMUM * 2);
1954 NetClientIP := IP;
1955 NetClientPort := Port;
1956 if NetDump then
1957 g_Net_DumpStart();
1958 Exit;
1959 end;
1960 end;
1961
1962 T := sys_GetTicks();
1963 if T > TimeoutTime then
1964 begin
1965 TimeoutTime := T + NET_CONNECT_TIMEOUT * 100; // одного предупреждения хватит
1966 g_Console_Add(_lc[I_NET_MSG_TIMEOUT_WARN], True);
1967 g_Console_Add(Format(_lc[I_NET_MSG_PORTS], [Integer(Port), Integer(NET_PING_PORT)]), True);
1968 end;
1969
1970 ProcessLoading(true);
1971
1972 if e_KeyPressed(IK_SPACE) or e_KeyPressed(IK_ESCAPE) or e_KeyPressed(VK_ESCAPE) or
1973 e_KeyPressed(JOY0_JUMP) or e_KeyPressed(JOY1_JUMP) or e_KeyPressed(JOY2_JUMP) or e_KeyPressed(JOY3_JUMP) then
1974 OuterLoop := False;
1975 end;
1976
1977 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_TIMEOUT], True);
1978 g_Console_Add(Format(_lc[I_NET_MSG_PORTS], [Integer(Port), Integer(NET_PING_PORT)]), True);
1979 if NetPeer <> nil then enet_peer_reset(NetPeer);
1980 if NetHost <> nil then
1981 begin
1982 enet_host_destroy(NetHost);
1983 NetHost := nil;
1984 end;
1985 g_Net_Cleanup();
1986 Result := False;
1987 end;
1988
1989 function IpToStr(IP: LongWord): string;
1990 var
1991 Ptr: Pointer;
1992 begin
1993 Ptr := Addr(IP);
1994 Result := IntToStr(PByte(Ptr + 0)^) + '.';
1995 Result := Result + IntToStr(PByte(Ptr + 1)^) + '.';
1996 Result := Result + IntToStr(PByte(Ptr + 2)^) + '.';
1997 Result := Result + IntToStr(PByte(Ptr + 3)^);
1998 end;
1999
2000 function StrToIp(IPstr: string; var IP: LongWord): Boolean;
2001 var
2002 EAddr: ENetAddress;
2003 begin
2004 Result := enet_address_set_host(@EAddr, PChar(@IPstr[1])) = 0;
2005 IP := EAddr.host;
2006 end;
2007
2008 function g_Net_Client_ByName(Name: string): pTNetClient;
2009 var
2010 a: Integer;
2011 pl: TPlayer;
2012 begin
2013 Result := nil;
2014 for a := Low(NetClients) to High(NetClients) do
2015 if (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
2016 begin
2017 pl := g_Player_Get(NetClients[a].Player);
2018 if pl = nil then continue;
2019 if Copy(LowerCase(pl.Name), 1, Length(Name)) <> LowerCase(Name) then continue;
2020 if NetClients[a].Peer <> nil then
2021 begin
2022 Result := @NetClients[a];
2023 Exit;
2024 end;
2025 end;
2026 end;
2027
2028 function g_Net_Client_ByPlayer(PID: Word): pTNetClient;
2029 var
2030 a: Integer;
2031 begin
2032 Result := nil;
2033 for a := Low(NetClients) to High(NetClients) do
2034 if (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
2035 if NetClients[a].Player = PID then
2036 begin
2037 Result := @NetClients[a];
2038 Exit;
2039 end;
2040 end;
2041
2042 function g_Net_ClientName_ByID(ID: Integer): string;
2043 var
2044 a: Integer;
2045 pl: TPlayer;
2046 begin
2047 Result := '';
2048 if ID = NET_EVERYONE then
2049 Exit;
2050 for a := Low(NetClients) to High(NetClients) do
2051 if (NetClients[a].ID = ID) and (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
2052 begin
2053 pl := g_Player_Get(NetClients[a].Player);
2054 if pl = nil then Exit;
2055 Result := pl.Name;
2056 end;
2057 end;
2058
2059 procedure g_Net_SendData(Data: AByte; peer: pENetPeer; Reliable: Boolean; Chan: Byte = NET_CHAN_DOWNLOAD);
2060 var
2061 P: pENetPacket;
2062 F: enet_uint32;
2063 dataLength: Cardinal;
2064 begin
2065 dataLength := Length(Data);
2066
2067 if (Reliable) then
2068 F := LongWord(ENET_PACKET_FLAG_RELIABLE)
2069 else
2070 F := 0;
2071
2072 if (peer <> nil) then
2073 begin
2074 P := enet_packet_create(@Data[0], dataLength, F);
2075 if not Assigned(P) then Exit;
2076 enet_peer_send(peer, Chan, P);
2077 end
2078 else
2079 begin
2080 P := enet_packet_create(@Data[0], dataLength, F);
2081 if not Assigned(P) then Exit;
2082 enet_host_broadcast(NetHost, Chan, P);
2083 end;
2084
2085 enet_host_flush(NetHost);
2086 end;
2087
2088 function g_Net_IsHostBanned(IP: LongWord; Perm: Boolean = False): Boolean;
2089 var
2090 I: Integer;
2091 begin
2092 Result := False;
2093 if NetBannedHosts = nil then
2094 Exit;
2095 for I := 0 to High(NetBannedHosts) do
2096 if (NetBannedHosts[I].IP = IP) and ((not Perm) or (NetBannedHosts[I].Perm)) then
2097 begin
2098 Result := True;
2099 break;
2100 end;
2101 end;
2102
2103 procedure g_Net_BanHost(IP: LongWord; Perm: Boolean = True); overload;
2104 var
2105 I, P: Integer;
2106 begin
2107 if IP = 0 then
2108 Exit;
2109 if g_Net_IsHostBanned(IP, Perm) then
2110 Exit;
2111
2112 P := -1;
2113 for I := Low(NetBannedHosts) to High(NetBannedHosts) do
2114 if NetBannedHosts[I].IP = 0 then
2115 begin
2116 P := I;
2117 break;
2118 end;
2119
2120 if P < 0 then
2121 begin
2122 SetLength(NetBannedHosts, Length(NetBannedHosts) + 1);
2123 P := High(NetBannedHosts);
2124 end;
2125
2126 NetBannedHosts[P].IP := IP;
2127 NetBannedHosts[P].Perm := Perm;
2128 end;
2129
2130 procedure g_Net_BanHost(IP: string; Perm: Boolean = True); overload;
2131 var
2132 a: LongWord;
2133 b: Boolean;
2134 begin
2135 b := StrToIp(IP, a);
2136 if b then
2137 g_Net_BanHost(a, Perm);
2138 end;
2139
2140 procedure g_Net_UnbanNonPermHosts();
2141 var
2142 I: Integer;
2143 begin
2144 if NetBannedHosts = nil then
2145 Exit;
2146 for I := Low(NetBannedHosts) to High(NetBannedHosts) do
2147 if (NetBannedHosts[I].IP > 0) and not NetBannedHosts[I].Perm then
2148 begin
2149 NetBannedHosts[I].IP := 0;
2150 NetBannedHosts[I].Perm := True;
2151 end;
2152 end;
2153
2154 function g_Net_UnbanHost(IP: string): Boolean; overload;
2155 var
2156 a: LongWord;
2157 begin
2158 Result := StrToIp(IP, a);
2159 if Result then
2160 Result := g_Net_UnbanHost(a);
2161 end;
2162
2163 function g_Net_UnbanHost(IP: LongWord): Boolean; overload;
2164 var
2165 I: Integer;
2166 begin
2167 Result := False;
2168 if IP = 0 then
2169 Exit;
2170 if NetBannedHosts = nil then
2171 Exit;
2172 for I := 0 to High(NetBannedHosts) do
2173 if NetBannedHosts[I].IP = IP then
2174 begin
2175 NetBannedHosts[I].IP := 0;
2176 NetBannedHosts[I].Perm := True;
2177 Result := True;
2178 // no break here to clear all bans of this host, perm and non-perm
2179 end;
2180 end;
2181
2182 procedure g_Net_SaveBanList();
2183 var
2184 F: TextFile;
2185 I: Integer;
2186 begin
2187 Assign(F, DataDir + BANLIST_FILENAME);
2188 Rewrite(F);
2189 if NetBannedHosts <> nil then
2190 for I := 0 to High(NetBannedHosts) do
2191 if NetBannedHosts[I].Perm and (NetBannedHosts[I].IP > 0) then
2192 Writeln(F, IpToStr(NetBannedHosts[I].IP));
2193 CloseFile(F);
2194 end;
2195
2196 procedure g_Net_DumpStart();
2197 begin
2198 if NetMode = NET_SERVER then
2199 NetDumpFile := createDiskFile(NETDUMP_FILENAME + '_server')
2200 else
2201 NetDumpFile := createDiskFile(NETDUMP_FILENAME + '_client');
2202 end;
2203
2204 procedure g_Net_DumpSendBuffer();
2205 begin
2206 writeInt(NetDumpFile, gTime);
2207 writeInt(NetDumpFile, LongWord(NetOut.CurSize));
2208 writeInt(NetDumpFile, Byte(1));
2209 NetDumpFile.WriteBuffer(NetOut.Data^, NetOut.CurSize);
2210 end;
2211
2212 procedure g_Net_DumpRecvBuffer(Buf: penet_uint8; Len: LongWord);
2213 begin
2214 if (Buf = nil) or (Len = 0) then Exit;
2215 writeInt(NetDumpFile, gTime);
2216 writeInt(NetDumpFile, Len);
2217 writeInt(NetDumpFile, Byte(0));
2218 NetDumpFile.WriteBuffer(Buf^, Len);
2219 end;
2220
2221 procedure g_Net_DumpEnd();
2222 begin
2223 NetDumpFile.Free();
2224 NetDumpFile := nil;
2225 end;
2226
2227 function g_Net_ForwardPorts(ForwardPongPort: Boolean = True): Boolean;
2228 {$IFDEF USE_MINIUPNPC}
2229 var
2230 DevList: PUPNPDev;
2231 Urls: TUPNPUrls;
2232 Data: TIGDDatas;
2233 LanAddr: array [0..255] of Char;
2234 StrPort: AnsiString;
2235 Err, I: Integer;
2236 begin
2237 Result := False;
2238
2239 if NetPortForwarded = NetPort then
2240 begin
2241 Result := True;
2242 exit;
2243 end;
2244
2245 NetPongForwarded := False;
2246 NetPortForwarded := 0;
2247
2248 DevList := upnpDiscover(1000, nil, nil, 0, 0, 2, Addr(Err));
2249 if DevList = nil then
2250 begin
2251 conwritefln('port forwarding failed: upnpDiscover() failed: %d', [Err]);
2252 exit;
2253 end;
2254
2255 I := UPNP_GetValidIGD(DevList, @Urls, @Data, Addr(LanAddr[0]), 256);
2256
2257 if I = 0 then
2258 begin
2259 conwriteln('port forwarding failed: could not find an IGD device on this LAN');
2260 FreeUPNPDevList(DevList);
2261 FreeUPNPUrls(@Urls);
2262 exit;
2263 end;
2264
2265 StrPort := IntToStr(NetPort);
2266 I := UPNP_AddPortMapping(
2267 Urls.controlURL, Addr(data.first.servicetype[1]),
2268 PChar(StrPort), PChar(StrPort), Addr(LanAddr[0]), PChar('D2DF'),
2269 PChar('UDP'), nil, PChar('0')
2270 );
2271
2272 if I <> 0 then
2273 begin
2274 conwritefln('forwarding port %d failed: error %d', [NetPort, I]);
2275 FreeUPNPDevList(DevList);
2276 FreeUPNPUrls(@Urls);
2277 exit;
2278 end;
2279
2280 if ForwardPongPort then
2281 begin
2282 StrPort := IntToStr(NET_PING_PORT);
2283 I := UPNP_AddPortMapping(
2284 Urls.controlURL, Addr(data.first.servicetype[1]),
2285 PChar(StrPort), PChar(StrPort), Addr(LanAddr[0]), PChar('D2DF'),
2286 PChar('UDP'), nil, PChar('0')
2287 );
2288
2289 if I <> 0 then
2290 begin
2291 conwritefln('forwarding port %d failed: error %d', [NetPort + 1, I]);
2292 NetPongForwarded := False;
2293 end
2294 else
2295 begin
2296 conwritefln('forwarded port %d successfully', [NetPort + 1]);
2297 NetPongForwarded := True;
2298 end;
2299 end;
2300
2301 conwritefln('forwarded port %d successfully', [NetPort]);
2302 NetIGDControl := AnsiString(Urls.controlURL);
2303 NetIGDService := data.first.servicetype;
2304 NetPortForwarded := NetPort;
2305
2306 FreeUPNPDevList(DevList);
2307 FreeUPNPUrls(@Urls);
2308 Result := True;
2309 end;
2310 {$ELSE}
2311 begin
2312 Result := False;
2313 end;
2314 {$ENDIF}
2315
2316 procedure g_Net_UnforwardPorts();
2317 {$IFDEF USE_MINIUPNPC}
2318 var
2319 I: Integer;
2320 StrPort: AnsiString;
2321 begin
2322 if NetPortForwarded = 0 then Exit;
2323
2324 conwriteln('unforwarding ports...');
2325
2326 StrPort := IntToStr(NetPortForwarded);
2327 I := UPNP_DeletePortMapping(
2328 PChar(NetIGDControl), Addr(NetIGDService[1]),
2329 PChar(StrPort), PChar('UDP'), nil
2330 );
2331 conwritefln(' port %d: %d', [NetPortForwarded, I]);
2332
2333 if NetPongForwarded then
2334 begin
2335 NetPongForwarded := False;
2336 StrPort := IntToStr(NetPortForwarded + 1);
2337 I := UPNP_DeletePortMapping(
2338 PChar(NetIGDControl), Addr(NetIGDService[1]),
2339 PChar(StrPort), PChar('UDP'), nil
2340 );
2341 conwritefln(' port %d: %d', [NetPortForwarded + 1, I]);
2342 end;
2343
2344 NetPortForwarded := 0;
2345 end;
2346 {$ELSE}
2347 begin
2348 end;
2349 {$ENDIF}
2350
2351
2352 initialization
2353 conRegVar('cl_downloadtimeout', @g_Net_DownloadTimeout, 0.0, 1000000.0, '', 'timeout in seconds, 0 to disable it');
2354 SetLength(NetClients, 0);
2355 g_Net_DownloadTimeout := 60;
2356 NetIn.Alloc(NET_BUFSIZE);
2357 NetOut.Alloc(NET_BUFSIZE);
2358 NetBuf[NET_UNRELIABLE].Alloc(NET_BUFSIZE*2);
2359 NetBuf[NET_RELIABLE].Alloc(NET_BUFSIZE*2);
2360 trans_omsg.Alloc(NET_BUFSIZE);
2361 finalization
2362 NetIn.Free();
2363 NetOut.Free();
2364 NetBuf[NET_UNRELIABLE].Free();
2365 NetBuf[NET_RELIABLE].Free();
2366 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024