DEADSOFTWARE

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