DEADSOFTWARE

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


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