DEADSOFTWARE

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


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