DEADSOFTWARE

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