DEADSOFTWARE

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


35968491ebc828dc90f30cbcf5cd56d2d447db16
[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, either version 3 of the License, or
6 * (at your option) any later version.
7 *
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
12 *
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
15 *)
16 {$INCLUDE g_amodes.inc}
17 unit g_net;
18
19 interface
20
21 uses
22 e_log, e_fixedbuffer, ENet, Classes;
23
24 const
25 NET_PROTOCOL_VER = 171;
26
27 NET_MAXCLIENTS = 24;
28 NET_CHANS = 11;
29
30 NET_CHAN_SERVICE = 0;
31 NET_CHAN_IMPORTANT = 1;
32 NET_CHAN_GAME = 2;
33 NET_CHAN_PLAYER = 3;
34 NET_CHAN_PLAYERPOS = 4;
35 NET_CHAN_MONSTER = 5;
36 NET_CHAN_MONSTERPOS = 6;
37 NET_CHAN_LARGEDATA = 7;
38 NET_CHAN_CHAT = 8;
39 NET_CHAN_DOWNLOAD = 9;
40 NET_CHAN_SHOTS = 10;
41
42 NET_NONE = 0;
43 NET_SERVER = 1;
44 NET_CLIENT = 2;
45
46 NET_BUFSIZE = 65536;
47
48 NET_EVERYONE = -1;
49
50 NET_DISC_NONE: enet_uint32 = 0;
51 NET_DISC_PROTOCOL: enet_uint32 = 1;
52 NET_DISC_VERSION: enet_uint32 = 2;
53 NET_DISC_FULL: enet_uint32 = 3;
54 NET_DISC_KICK: enet_uint32 = 4;
55 NET_DISC_DOWN: enet_uint32 = 5;
56 NET_DISC_PASSWORD: enet_uint32 = 6;
57 NET_DISC_TEMPBAN: enet_uint32 = 7;
58 NET_DISC_BAN: enet_uint32 = 8;
59 NET_DISC_MAX: enet_uint32 = 8;
60
61 NET_STATE_NONE = 0;
62 NET_STATE_AUTH = 1;
63 NET_STATE_GAME = 2;
64
65 BANLIST_FILENAME = 'banlist.txt';
66 NETDUMP_FILENAME = 'netdump';
67
68 type
69 TNetClient = record
70 ID: Byte;
71 Used: Boolean;
72 State: Byte;
73 Peer: pENetPeer;
74 Player: Word;
75 RequestedFullUpdate: Boolean;
76 RCONAuth: Boolean;
77 Voted: Boolean;
78 end;
79 TBanRecord = record
80 IP: LongWord;
81 Perm: Boolean;
82 end;
83 pTNetClient = ^TNetClient;
84
85 AByte = array of Byte;
86
87 var
88 NetInitDone: Boolean = False;
89 NetMode: Byte = NET_NONE;
90 NetDump: Boolean = False;
91
92 NetServerName: string = 'Unnamed Server';
93 NetPassword: string = '';
94 NetPort: Word = 25666;
95
96 NetAllowRCON: Boolean = False;
97 NetRCONPassword: string = '';
98
99 NetTimeToUpdate: Cardinal = 0;
100 NetTimeToReliable: Cardinal = 0;
101 NetTimeToMaster: Cardinal = 0;
102
103 NetHost: pENetHost = nil;
104 NetPeer: pENetPeer = nil;
105 NetEvent: ENetEvent;
106 NetAddr: ENetAddress;
107
108 NetPongAddr: ENetAddress;
109 NetPongSock: ENetSocket = ENET_SOCKET_NULL;
110
111 NetUseMaster: Boolean = True;
112 NetSlistAddr: ENetAddress;
113 NetSlistIP: string = 'mpms.doom2d.org';
114 NetSlistPort: Word = 25665;
115
116 NetClientIP: string = '127.0.0.1';
117 NetClientPort: Word = 25666;
118
119 NetIn, NetOut: TBuffer;
120
121 NetClients: array of TNetClient;
122 NetClientCount: Byte = 0;
123 NetMaxClients: Byte = 255;
124 NetBannedHosts: array of TBanRecord;
125
126 NetState: Integer = NET_STATE_NONE;
127
128 NetMyID: Integer = -1;
129 NetPlrUID1: Integer = -1;
130 NetPlrUID2: Integer = -1;
131
132 NetInterpLevel: Integer = 1;
133 NetUpdateRate: Cardinal = 0; // as soon as possible
134 NetRelupdRate: Cardinal = 18; // around two times a second
135 NetMasterRate: Cardinal = 60000;
136
137 NetForcePlayerUpdate: Boolean = False;
138 NetPredictSelf: Boolean = True;
139 NetGotKeys: Boolean = False;
140
141 NetGotEverything: Boolean = False;
142
143 NetDumpFile: TStream;
144
145 function g_Net_Init(): Boolean;
146 procedure g_Net_Cleanup();
147 procedure g_Net_Free();
148 procedure g_Net_Flush();
149
150 function g_Net_Host(IPAddr: LongWord; Port: enet_uint16; MaxClients: Cardinal = 16): Boolean;
151 procedure g_Net_Host_Die();
152 procedure g_Net_Host_Send(ID: Integer; Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
153 function g_Net_Host_Update(): enet_size_t;
154
155 function g_Net_Connect(IP: string; Port: enet_uint16): Boolean;
156 procedure g_Net_Disconnect(Forced: Boolean = False);
157 procedure g_Net_Client_Send(Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
158 function g_Net_Client_Update(): enet_size_t;
159 function g_Net_Client_UpdateWhileLoading(): enet_size_t;
160
161 function g_Net_Client_ByName(Name: string): pTNetClient;
162 function g_Net_Client_ByPlayer(PID: Word): pTNetClient;
163 function g_Net_ClientName_ByID(ID: Integer): string;
164
165 procedure g_Net_SendData(Data:AByte; peer: pENetPeer; Reliable: Boolean; Chan: Byte = NET_CHAN_DOWNLOAD);
166 function g_Net_Wait_Event(msgId: Word): TMemoryStream;
167
168 function IpToStr(IP: LongWord): string;
169 function StrToIp(IPstr: string; var IP: LongWord): Boolean;
170
171 function g_Net_IsHostBanned(IP: LongWord; Perm: Boolean = False): Boolean;
172 procedure g_Net_BanHost(IP: LongWord; Perm: Boolean = True); overload;
173 procedure g_Net_BanHost(IP: string; Perm: Boolean = True); overload;
174 function g_Net_UnbanHost(IP: string): Boolean; overload;
175 function g_Net_UnbanHost(IP: LongWord): Boolean; overload;
176 procedure g_Net_UnbanNonPermHosts();
177 procedure g_Net_SaveBanList();
178
179 procedure g_Net_DumpStart();
180 procedure g_Net_DumpSendBuffer();
181 procedure g_Net_DumpRecvBuffer(Buf: penet_uint8; Len: LongWord);
182 procedure g_Net_DumpEnd();
183
184 implementation
185
186 uses
187 SysUtils,
188 e_input, g_nethandler, g_netmsg, g_netmaster, g_player, g_window, g_console,
189 g_main, g_game, g_language, g_weapons, utils;
190
191
192 { /// SERVICE FUNCTIONS /// }
193
194
195 function g_Net_FindSlot(): Integer;
196 var
197 I: Integer;
198 F: Boolean;
199 N, C: Integer;
200 begin
201 N := -1;
202 F := False;
203 C := 0;
204 for I := Low(NetClients) to High(NetClients) do
205 begin
206 if NetClients[I].Used then
207 Inc(C)
208 else
209 if not F then
210 begin
211 F := True;
212 N := I;
213 end;
214 end;
215 if C >= NetMaxClients then
216 begin
217 Result := -1;
218 Exit;
219 end;
220
221 if not F then
222 begin
223 if (Length(NetClients) >= NetMaxClients) then
224 N := -1
225 else
226 begin
227 SetLength(NetClients, Length(NetClients) + 1);
228 N := High(NetClients);
229 end;
230 end;
231
232 if N >= 0 then
233 begin
234 NetClients[N].Used := True;
235 NetClients[N].ID := N;
236 NetClients[N].RequestedFullUpdate := False;
237 NetClients[N].RCONAuth := False;
238 NetClients[N].Voted := False;
239 NetClients[N].Player := 0;
240 end;
241
242 Result := N;
243 end;
244
245 function g_Net_Init(): Boolean;
246 var
247 F: TextFile;
248 IPstr: string;
249 IP: LongWord;
250 begin
251 e_Buffer_Clear(@NetIn);
252 e_Buffer_Clear(@NetOut);
253 SetLength(NetClients, 0);
254 NetPeer := nil;
255 NetHost := nil;
256 NetMyID := -1;
257 NetPlrUID1 := -1;
258 NetPlrUID2 := -1;
259 NetAddr.port := 25666;
260 SetLength(NetBannedHosts, 0);
261 if FileExists(DataDir + BANLIST_FILENAME) then
262 begin
263 Assign(F, DataDir + BANLIST_FILENAME);
264 Reset(F);
265 while not EOF(F) do
266 begin
267 Readln(F, IPstr);
268 if StrToIp(IPstr, IP) then
269 g_Net_BanHost(IP);
270 end;
271 CloseFile(F);
272 g_Net_SaveBanList();
273 end;
274
275 Result := (enet_initialize() = 0);
276 end;
277
278 procedure g_Net_Flush();
279 begin
280 enet_host_flush(NetHost);
281 end;
282
283 procedure g_Net_Cleanup();
284 begin
285 e_Buffer_Clear(@NetIn);
286 e_Buffer_Clear(@NetOut);
287
288 SetLength(NetClients, 0);
289 NetClientCount := 0;
290
291 NetPeer := nil;
292 NetHost := nil;
293 NetMPeer := nil;
294 NetMHost := nil;
295 NetMyID := -1;
296 NetPlrUID1 := -1;
297 NetPlrUID2 := -1;
298 NetState := NET_STATE_NONE;
299
300 NetPongSock := ENET_SOCKET_NULL;
301
302 NetTimeToMaster := 0;
303 NetTimeToUpdate := 0;
304 NetTimeToReliable := 0;
305
306 NetMode := NET_NONE;
307
308 if NetDump then
309 g_Net_DumpEnd();
310 end;
311
312 procedure g_Net_Free();
313 begin
314 g_Net_Cleanup();
315
316 enet_deinitialize();
317 NetInitDone := False;
318 end;
319
320
321 { /// SERVER FUNCTIONS /// }
322
323
324 function g_Net_Host(IPAddr: LongWord; Port: enet_uint16; MaxClients: Cardinal = 16): Boolean;
325 begin
326 if NetMode <> NET_NONE then
327 begin
328 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_INGAME]);
329 Result := False;
330 Exit;
331 end;
332
333 Result := True;
334
335 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST], [Port]));
336 if not NetInitDone then
337 begin
338 if (not g_Net_Init()) then
339 begin
340 g_Console_Add(_lc[I_NET_MSG_FERROR] + _lc[I_NET_ERR_ENET]);
341 Result := False;
342 Exit;
343 end
344 else
345 NetInitDone := True;
346 end;
347
348 NetAddr.host := IPAddr;
349 NetAddr.port := Port;
350
351 NetHost := enet_host_create(@NetAddr, NET_MAXCLIENTS, NET_CHANS, 0, 0);
352
353 if (NetHost = nil) then
354 begin
355 g_Console_Add(_lc[I_NET_MSG_ERROR] + Format(_lc[I_NET_ERR_HOST], [Port]));
356 Result := False;
357 g_Net_Cleanup;
358 Exit;
359 end;
360
361 NetPongSock := enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM);
362 if NetPongSock <> ENET_SOCKET_NULL then
363 begin
364 NetPongAddr.host := IPAddr;
365 NetPongAddr.port := Port + 1;
366 if enet_socket_bind(NetPongSock, @NetPongAddr) < 0 then
367 begin
368 enet_socket_destroy(NetPongSock);
369 NetPongSock := ENET_SOCKET_NULL;
370 end
371 else
372 enet_socket_set_option(NetPongSock, ENET_SOCKOPT_NONBLOCK, 1);
373 end;
374
375 NetMode := NET_SERVER;
376 e_Buffer_Clear(@NetOut);
377
378 if NetDump then
379 g_Net_DumpStart();
380 end;
381
382 procedure g_Net_Host_Die();
383 var
384 I: Integer;
385 begin
386 if NetMode <> NET_SERVER then Exit;
387
388 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_DISCALL]);
389 for I := 0 to High(NetClients) do
390 if NetClients[I].Used then
391 enet_peer_disconnect(NetClients[I].Peer, NET_DISC_DOWN);
392
393 while enet_host_service(NetHost, @NetEvent, 1000) > 0 do
394 if NetEvent.kind = ENET_EVENT_TYPE_RECEIVE then
395 enet_packet_destroy(NetEvent.packet);
396
397 for I := 0 to High(NetClients) do
398 if NetClients[I].Used then
399 begin
400 FreeMemory(NetClients[I].Peer^.data);
401 NetClients[I].Peer^.data := nil;
402 enet_peer_reset(NetClients[I].Peer);
403 NetClients[I].Peer := nil;
404 NetClients[I].Used := False;
405 end;
406
407 if (NetMPeer <> nil) and (NetMHost <> nil) then g_Net_Slist_Disconnect;
408 if NetPongSock <> ENET_SOCKET_NULL then
409 enet_socket_destroy(NetPongSock);
410
411 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_DIE]);
412 enet_host_destroy(NetHost);
413
414 NetMode := NET_NONE;
415
416 g_Net_Cleanup;
417 e_WriteLog('NET: Server stopped', MSG_NOTIFY);
418 end;
419
420
421 procedure g_Net_Host_Send(ID: Integer; Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
422 var
423 P: pENetPacket;
424 F: enet_uint32;
425 begin
426 if (Reliable) then
427 F := LongWord(ENET_PACKET_FLAG_RELIABLE)
428 else
429 F := 0;
430
431 if (ID >= 0) then
432 begin
433 if ID > High(NetClients) then Exit;
434 if NetClients[ID].Peer = nil then Exit;
435
436 P := enet_packet_create(Addr(NetOut.Data), NetOut.Len, F);
437 if not Assigned(P) then Exit;
438
439 enet_peer_send(NetClients[ID].Peer, Chan, P);
440 end
441 else
442 begin
443 P := enet_packet_create(Addr(NetOut.Data), NetOut.Len, F);
444 if not Assigned(P) then Exit;
445
446 enet_host_broadcast(NetHost, Chan, P);
447 end;
448
449 if NetDump then g_Net_DumpSendBuffer();
450 g_Net_Flush();
451 e_Buffer_Clear(@NetOut);
452 end;
453
454 procedure g_Net_Host_CheckPings();
455 var
456 ClAddr: ENetAddress;
457 Buf: ENetBuffer;
458 Len: Integer;
459 ClTime: Int64;
460 Ping: array [0..9] of Byte;
461 NPl: Byte;
462 begin
463 if NetPongSock = ENET_SOCKET_NULL then Exit;
464
465 Buf.data := Addr(Ping[0]);
466 Buf.dataLength := 2+8;
467
468 Ping[0] := 0;
469
470 Len := enet_socket_receive(NetPongSock, @ClAddr, @Buf, 1);
471 if Len < 0 then Exit;
472
473 if (Ping[0] = Ord('D')) and (Ping[1] = Ord('F')) then
474 begin
475 ClTime := Int64(Addr(Ping[2])^);
476
477 e_Buffer_Clear(@NetOut);
478 e_Buffer_Write(@NetOut, Byte(Ord('D')));
479 e_Buffer_Write(@NetOut, Byte(Ord('F')));
480 e_Buffer_Write(@NetOut, ClTime);
481 g_Net_Slist_WriteInfo();
482 NPl := 0;
483 if gPlayer1 <> nil then Inc(NPl);
484 if gPlayer2 <> nil then Inc(NPl);
485 e_Buffer_Write(@NetOut, NPl);
486 e_Buffer_Write(@NetOut, gNumBots);
487
488 Buf.data := Addr(NetOut.Data[0]);
489 Buf.dataLength := NetOut.WritePos;
490 enet_socket_send(NetPongSock, @ClAddr, @Buf, 1);
491
492 e_Buffer_Clear(@NetOut);
493 end;
494 end;
495
496 function g_Net_Host_Update(): enet_size_t;
497 var
498 IP: string;
499 Port: Word;
500 ID: Integer;
501 TC: pTNetClient;
502 TP: TPlayer;
503 begin
504 IP := '';
505 Result := 0;
506
507 if NetUseMaster then
508 begin
509 g_Net_Slist_Check;
510 g_Net_Host_CheckPings;
511 end;
512
513 while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
514 begin
515 case (NetEvent.kind) of
516 ENET_EVENT_TYPE_CONNECT:
517 begin
518 IP := IpToStr(NetEvent.Peer^.address.host);
519 Port := NetEvent.Peer^.address.port;
520 g_Console_Add(_lc[I_NET_MSG] +
521 Format(_lc[I_NET_MSG_HOST_CONN], [IP, Port]));
522
523 if (NetEvent.data <> NET_PROTOCOL_VER) then
524 begin
525 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_REJECT] +
526 _lc[I_NET_DISC_PROTOCOL]);
527 NetEvent.peer^.data := GetMemory(SizeOf(Byte));
528 Byte(NetEvent.peer^.data^) := 255;
529 enet_peer_disconnect(NetEvent.peer, NET_DISC_PROTOCOL);
530 enet_host_flush(NetHost);
531 Exit;
532 end;
533
534 ID := g_Net_FindSlot();
535
536 if ID < 0 then
537 begin
538 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_REJECT] +
539 _lc[I_NET_DISC_FULL]);
540 NetEvent.Peer^.data := GetMemory(SizeOf(Byte));
541 Byte(NetEvent.peer^.data^) := 255;
542 enet_peer_disconnect(NetEvent.peer, NET_DISC_FULL);
543 enet_host_flush(NetHost);
544 Exit;
545 end;
546
547 NetClients[ID].Peer := NetEvent.peer;
548 NetClients[ID].Peer^.data := GetMemory(SizeOf(Byte));
549 Byte(NetClients[ID].Peer^.data^) := ID;
550 NetClients[ID].State := NET_STATE_AUTH;
551 NetClients[ID].RCONAuth := False;
552
553 enet_peer_timeout(NetEvent.peer, ENET_PEER_TIMEOUT_LIMIT * 2, ENET_PEER_TIMEOUT_MINIMUM * 2, ENET_PEER_TIMEOUT_MAXIMUM * 2);
554
555 Inc(NetClientCount);
556 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST_ADD], [ID]));
557 end;
558
559 ENET_EVENT_TYPE_RECEIVE:
560 begin
561 ID := Byte(NetEvent.peer^.data^);
562 if ID > High(NetClients) then Exit;
563 TC := @NetClients[ID];
564
565 if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
566 g_Net_HostMsgHandler(TC, NetEvent.packet);
567 end;
568
569 ENET_EVENT_TYPE_DISCONNECT:
570 begin
571 ID := Byte(NetEvent.peer^.data^);
572 if ID > High(NetClients) then Exit;
573 TC := @NetClients[ID];
574 if TC = nil then Exit;
575
576 if not (TC^.Used) then Exit;
577
578 TP := g_Player_Get(TC^.Player);
579
580 if TP <> nil then
581 begin
582 TP.Lives := 0;
583 TP.Kill(K_SIMPLEKILL, 0, HIT_DISCON);
584 g_Console_Add(Format(_lc[I_PLAYER_LEAVE], [TP.Name]), True);
585 e_WriteLog('NET: Client ' + TP.Name + ' [' + IntToStr(ID) + '] disconnected.', MSG_NOTIFY);
586 g_Player_Remove(TP.UID);
587 end;
588
589 TC^.Used := False;
590 TC^.State := NET_STATE_NONE;
591 TC^.Peer := nil;
592 TC^.Player := 0;
593 TC^.RequestedFullUpdate := False;
594
595 FreeMemory(NetEvent.peer^.data);
596 NetEvent.peer^.data := nil;
597 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST_DISC], [ID]));
598 Dec(NetClientCount);
599
600 if NetUseMaster then g_Net_Slist_Update;
601 end;
602 end;
603 end;
604 end;
605
606
607 { /// CLIENT FUNCTIONS /// }
608
609
610 procedure g_Net_Disconnect(Forced: Boolean = False);
611 begin
612 if NetMode <> NET_CLIENT then Exit;
613 if (NetHost = nil) or (NetPeer = nil) then Exit;
614
615 if not Forced then
616 begin
617 enet_peer_disconnect(NetPeer, NET_DISC_NONE);
618
619 while (enet_host_service(NetHost, @NetEvent, 1500) > 0) do
620 begin
621 if (NetEvent.kind = ENET_EVENT_TYPE_DISCONNECT) then
622 begin
623 NetPeer := nil;
624 break;
625 end;
626
627 if (NetEvent.kind = ENET_EVENT_TYPE_RECEIVE) then
628 enet_packet_destroy(NetEvent.packet);
629 end;
630
631 if NetPeer <> nil then
632 begin
633 enet_peer_reset(NetPeer);
634 NetPeer := nil;
635 end;
636 end
637 else
638 begin
639 e_WriteLog('NET: Kicked from server: ' + IntToStr(NetEvent.data), MSG_NOTIFY);
640 if (NetEvent.data <= NET_DISC_MAX) then
641 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_KICK] +
642 _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + NetEvent.data)], True);
643 end;
644
645 if NetHost <> nil then
646 begin
647 enet_host_destroy(NetHost);
648 NetHost := nil;
649 end;
650 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_CLIENT_DISC]);
651
652 g_Net_Cleanup;
653 e_WriteLog('NET: Disconnected', MSG_NOTIFY);
654 end;
655
656 procedure g_Net_Client_Send(Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
657 var
658 P: pENetPacket;
659 F: enet_uint32;
660 begin
661 if (Reliable) then
662 F := LongWord(ENET_PACKET_FLAG_RELIABLE)
663 else
664 F := 0;
665
666 P := enet_packet_create(Addr(NetOut.Data), NetOut.Len, F);
667 if not Assigned(P) then Exit;
668
669 enet_peer_send(NetPeer, Chan, P);
670 if NetDump then g_Net_DumpSendBuffer();
671 g_Net_Flush();
672 e_Buffer_Clear(@NetOut);
673 end;
674
675 function g_Net_Client_Update(): enet_size_t;
676 begin
677 Result := 0;
678 while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
679 begin
680 case NetEvent.kind of
681 ENET_EVENT_TYPE_RECEIVE:
682 begin
683 if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
684 g_Net_ClientMsgHandler(NetEvent.packet);
685 end;
686
687 ENET_EVENT_TYPE_DISCONNECT:
688 begin
689 g_Net_Disconnect(True);
690 Result := 1;
691 Exit;
692 end;
693 end;
694 end
695 end;
696
697 function g_Net_Client_UpdateWhileLoading(): enet_size_t;
698 begin
699 Result := 0;
700 while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
701 begin
702 case NetEvent.kind of
703 ENET_EVENT_TYPE_RECEIVE:
704 begin
705 if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
706 g_Net_ClientLightMsgHandler(NetEvent.packet);
707 end;
708
709 ENET_EVENT_TYPE_DISCONNECT:
710 begin
711 g_Net_Disconnect(True);
712 Result := 1;
713 Exit;
714 end;
715 end;
716 end;
717 g_Net_Flush();
718 end;
719
720 function g_Net_Connect(IP: string; Port: enet_uint16): Boolean;
721 var
722 OuterLoop: Boolean;
723 begin
724 if NetMode <> NET_NONE then
725 begin
726 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_ERR_INGAME], True);
727 Result := False;
728 Exit;
729 end;
730
731 Result := True;
732
733 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_CLIENT_CONN],
734 [IP, Port]));
735 if not NetInitDone then
736 begin
737 if (not g_Net_Init()) then
738 begin
739 g_Console_Add(_lc[I_NET_MSG_FERROR] + _lc[I_NET_ERR_ENET], True);
740 Result := False;
741 Exit;
742 end
743 else
744 NetInitDone := True;
745 end;
746
747 NetHost := enet_host_create(nil, 1, NET_CHANS, 0, 0);
748
749 if (NetHost = nil) then
750 begin
751 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT], True);
752 g_Net_Cleanup;
753 Result := False;
754 Exit;
755 end;
756
757 enet_address_set_host(@NetAddr, PChar(Addr(IP[1])));
758 NetAddr.port := Port;
759
760 NetPeer := enet_host_connect(NetHost, @NetAddr, NET_CHANS, NET_PROTOCOL_VER);
761
762 if (NetPeer = nil) then
763 begin
764 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT], True);
765 enet_host_destroy(NetHost);
766 g_Net_Cleanup;
767 Result := False;
768 Exit;
769 end;
770
771 OuterLoop := True;
772 while OuterLoop do
773 begin
774 while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
775 begin
776 if (NetEvent.kind = ENET_EVENT_TYPE_CONNECT) then
777 begin
778 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_CLIENT_DONE]);
779 NetMode := NET_CLIENT;
780 e_Buffer_Clear(@NetOut);
781 enet_peer_timeout(NetPeer, ENET_PEER_TIMEOUT_LIMIT * 2, ENET_PEER_TIMEOUT_MINIMUM * 2, ENET_PEER_TIMEOUT_MAXIMUM * 2);
782 NetClientIP := IP;
783 NetClientPort := Port;
784 if NetDump then
785 g_Net_DumpStart();
786 Exit;
787 end;
788 end;
789
790 ProcessLoading();
791
792 e_PollInput();
793
794 if e_KeyPressed(IK_ESCAPE) or e_KeyPressed(IK_SPACE) then
795 OuterLoop := False;
796 end;
797
798 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_TIMEOUT], True);
799 if NetPeer <> nil then enet_peer_reset(NetPeer);
800 if NetHost <> nil then
801 begin
802 enet_host_destroy(NetHost);
803 NetHost := nil;
804 end;
805 g_Net_Cleanup();
806 Result := False;
807 end;
808
809 function IpToStr(IP: LongWord): string;
810 var
811 Ptr: Pointer;
812 begin
813 Result := '';
814 Ptr := Addr(IP);
815
816 e_Raw_Seek(0);
817 Result := Result + IntToStr(e_Raw_Read_Byte(Ptr)) + '.';
818 Result := Result + IntToStr(e_Raw_Read_Byte(Ptr)) + '.';
819 Result := Result + IntToStr(e_Raw_Read_Byte(Ptr)) + '.';
820 Result := Result + IntToStr(e_Raw_Read_Byte(Ptr));
821 e_Raw_Seek(0);
822 end;
823
824 function StrToIp(IPstr: string; var IP: LongWord): Boolean;
825 var
826 EAddr: ENetAddress;
827 begin
828 Result := enet_address_set_host(@EAddr, PChar(@IPstr[1])) = 0;
829 IP := EAddr.host;
830 end;
831
832 function g_Net_Client_ByName(Name: string): pTNetClient;
833 var
834 a: Integer;
835 pl: TPlayer;
836 begin
837 Result := nil;
838 for a := Low(NetClients) to High(NetClients) do
839 if (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
840 begin
841 pl := g_Player_Get(NetClients[a].Player);
842 if pl = nil then continue;
843 if Copy(LowerCase(pl.Name), 1, Length(Name)) <> LowerCase(Name) then continue;
844 if NetClients[a].Peer <> nil then
845 begin
846 Result := @NetClients[a];
847 Exit;
848 end;
849 end;
850 end;
851
852 function g_Net_Client_ByPlayer(PID: Word): pTNetClient;
853 var
854 a: Integer;
855 begin
856 Result := nil;
857 for a := Low(NetClients) to High(NetClients) do
858 if (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
859 if NetClients[a].Player = PID then
860 begin
861 Result := @NetClients[a];
862 Exit;
863 end;
864 end;
865
866 function g_Net_ClientName_ByID(ID: Integer): string;
867 var
868 a: Integer;
869 pl: TPlayer;
870 begin
871 Result := '';
872 if ID = NET_EVERYONE then
873 Exit;
874 for a := Low(NetClients) to High(NetClients) do
875 if (NetClients[a].ID = ID) and (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
876 begin
877 pl := g_Player_Get(NetClients[a].Player);
878 if pl = nil then Exit;
879 Result := pl.Name;
880 end;
881 end;
882
883 procedure g_Net_SendData(Data:AByte; peer: pENetPeer; Reliable: Boolean; Chan: Byte = NET_CHAN_DOWNLOAD);
884 var
885 P: pENetPacket;
886 F: enet_uint32;
887 dataLength: Cardinal;
888 begin
889 dataLength := Length(Data);
890
891 if (Reliable) then
892 F := LongWord(ENET_PACKET_FLAG_RELIABLE)
893 else
894 F := 0;
895
896 if (peer <> nil) then
897 begin
898 P := enet_packet_create(@Data[0], dataLength, F);
899 if not Assigned(P) then Exit;
900 enet_peer_send(peer, Chan, P);
901 end
902 else
903 begin
904 P := enet_packet_create(@Data[0], dataLength, F);
905 if not Assigned(P) then Exit;
906 enet_host_broadcast(NetHost, Chan, P);
907 end;
908
909 enet_host_flush(NetHost);
910 end;
911
912 function g_Net_Wait_Event(msgId: Word): TMemoryStream;
913 var
914 downloadEvent: ENetEvent;
915 OuterLoop: Boolean;
916 MID: Byte;
917 Ptr: Pointer;
918 msgStream: TMemoryStream;
919 begin
920 FillChar(downloadEvent, SizeOf(downloadEvent), 0);
921 msgStream := nil;
922 OuterLoop := True;
923 while OuterLoop do
924 begin
925 while (enet_host_service(NetHost, @downloadEvent, 0) > 0) do
926 begin
927 if (downloadEvent.kind = ENET_EVENT_TYPE_RECEIVE) then
928 begin
929 Ptr := downloadEvent.packet^.data;
930
931 MID := Byte(Ptr^);
932
933 if (MID = msgId) then
934 begin
935 msgStream := TMemoryStream.Create;
936 msgStream.SetSize(downloadEvent.packet^.dataLength);
937 msgStream.WriteBuffer(Ptr^, downloadEvent.packet^.dataLength);
938 msgStream.Seek(0, soFromBeginning);
939
940 OuterLoop := False;
941 enet_packet_destroy(downloadEvent.packet);
942 break;
943 end
944 else begin
945 enet_packet_destroy(downloadEvent.packet);
946 end;
947 end
948 else
949 if (downloadEvent.kind = ENET_EVENT_TYPE_DISCONNECT) then
950 begin
951 if (downloadEvent.data <= NET_DISC_MAX) then
952 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' ' +
953 _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + downloadEvent.data)], True);
954 OuterLoop := False;
955 Break;
956 end;
957 end;
958
959 ProcessLoading();
960
961 e_PollInput();
962
963 if e_KeyPressed(IK_ESCAPE) or e_KeyPressed(IK_SPACE) then
964 break;
965 end;
966 Result := msgStream;
967 end;
968
969 function g_Net_IsHostBanned(IP: LongWord; Perm: Boolean = False): Boolean;
970 var
971 I: Integer;
972 begin
973 Result := False;
974 if NetBannedHosts = nil then
975 Exit;
976 for I := 0 to High(NetBannedHosts) do
977 if (NetBannedHosts[I].IP = IP) and ((not Perm) or (NetBannedHosts[I].Perm)) then
978 begin
979 Result := True;
980 break;
981 end;
982 end;
983
984 procedure g_Net_BanHost(IP: LongWord; Perm: Boolean = True); overload;
985 var
986 I, P: Integer;
987 begin
988 if IP = 0 then
989 Exit;
990 if g_Net_IsHostBanned(IP, Perm) then
991 Exit;
992
993 P := -1;
994 for I := Low(NetBannedHosts) to High(NetBannedHosts) do
995 if NetBannedHosts[I].IP = 0 then
996 begin
997 P := I;
998 break;
999 end;
1000
1001 if P < 0 then
1002 begin
1003 SetLength(NetBannedHosts, Length(NetBannedHosts) + 1);
1004 P := High(NetBannedHosts);
1005 end;
1006
1007 NetBannedHosts[P].IP := IP;
1008 NetBannedHosts[P].Perm := Perm;
1009 end;
1010
1011 procedure g_Net_BanHost(IP: string; Perm: Boolean = True); overload;
1012 var
1013 a: LongWord;
1014 b: Boolean;
1015 begin
1016 b := StrToIp(IP, a);
1017 if b then
1018 g_Net_BanHost(a, Perm);
1019 end;
1020
1021 procedure g_Net_UnbanNonPermHosts();
1022 var
1023 I: Integer;
1024 begin
1025 if NetBannedHosts = nil then
1026 Exit;
1027 for I := Low(NetBannedHosts) to High(NetBannedHosts) do
1028 if (NetBannedHosts[I].IP > 0) and not NetBannedHosts[I].Perm then
1029 begin
1030 NetBannedHosts[I].IP := 0;
1031 NetBannedHosts[I].Perm := True;
1032 end;
1033 end;
1034
1035 function g_Net_UnbanHost(IP: string): Boolean; overload;
1036 var
1037 a: LongWord;
1038 begin
1039 Result := StrToIp(IP, a);
1040 if Result then
1041 Result := g_Net_UnbanHost(a);
1042 end;
1043
1044 function g_Net_UnbanHost(IP: LongWord): Boolean; overload;
1045 var
1046 I: Integer;
1047 begin
1048 Result := False;
1049 if IP = 0 then
1050 Exit;
1051 if NetBannedHosts = nil then
1052 Exit;
1053 for I := 0 to High(NetBannedHosts) do
1054 if NetBannedHosts[I].IP = IP then
1055 begin
1056 NetBannedHosts[I].IP := 0;
1057 NetBannedHosts[I].Perm := True;
1058 Result := True;
1059 // no break here to clear all bans of this host, perm and non-perm
1060 end;
1061 end;
1062
1063 procedure g_Net_SaveBanList();
1064 var
1065 F: TextFile;
1066 I: Integer;
1067 begin
1068 Assign(F, DataDir + BANLIST_FILENAME);
1069 Rewrite(F);
1070 if NetBannedHosts <> nil then
1071 for I := 0 to High(NetBannedHosts) do
1072 if NetBannedHosts[I].Perm and (NetBannedHosts[I].IP > 0) then
1073 Writeln(F, IpToStr(NetBannedHosts[I].IP));
1074 CloseFile(F);
1075 end;
1076
1077 procedure g_Net_DumpStart();
1078 begin
1079 if NetMode = NET_SERVER then
1080 NetDumpFile := createDiskFile(NETDUMP_FILENAME + '_server')
1081 else
1082 NetDumpFile := createDiskFile(NETDUMP_FILENAME + '_client');
1083 end;
1084
1085 procedure g_Net_DumpSendBuffer();
1086 begin
1087 writeInt(NetDumpFile, gTime);
1088 writeInt(NetDumpFile, LongWord(NetOut.Len));
1089 writeInt(NetDumpFile, Byte(1));
1090 NetDumpFile.WriteBuffer(NetOut.Data[0], NetOut.Len);
1091 end;
1092
1093 procedure g_Net_DumpRecvBuffer(Buf: penet_uint8; Len: LongWord);
1094 begin
1095 if (Buf = nil) or (Len = 0) then Exit;
1096 writeInt(NetDumpFile, gTime);
1097 writeInt(NetDumpFile, Len);
1098 writeInt(NetDumpFile, Byte(0));
1099 NetDumpFile.WriteBuffer(Buf^, Len);
1100 end;
1101
1102 procedure g_Net_DumpEnd();
1103 begin
1104 NetDumpFile.Free();
1105 NetDumpFile := nil;
1106 end;
1107
1108 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024