DEADSOFTWARE

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


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