DEADSOFTWARE

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