DEADSOFTWARE

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