DEADSOFTWARE

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


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