DEADSOFTWARE

Player: Twice delay for weapon switch by number
[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 ../shared/a_modes.inc}
17 unit g_net;
19 interface
21 uses
22 e_log, e_msg, ENet, Classes, MAPDEF{$IFDEF USE_MINIUPNPC}, miniupnpc;{$ELSE};{$ENDIF}
24 const
25 NET_PROTOCOL_VER = 178;
27 NET_MAXCLIENTS = 24;
28 NET_CHANS = 11;
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;
42 NET_NONE = 0;
43 NET_SERVER = 1;
44 NET_CLIENT = 2;
46 NET_BUFSIZE = $FFFF;
47 NET_PING_PORT = $DF2D;
49 NET_EVERYONE = -1;
51 NET_DISC_NONE: enet_uint32 = 0;
52 NET_DISC_PROTOCOL: enet_uint32 = 1;
53 NET_DISC_VERSION: enet_uint32 = 2;
54 NET_DISC_FULL: enet_uint32 = 3;
55 NET_DISC_KICK: enet_uint32 = 4;
56 NET_DISC_DOWN: enet_uint32 = 5;
57 NET_DISC_PASSWORD: enet_uint32 = 6;
58 NET_DISC_TEMPBAN: enet_uint32 = 7;
59 NET_DISC_BAN: enet_uint32 = 8;
60 NET_DISC_MAX: enet_uint32 = 8;
62 NET_STATE_NONE = 0;
63 NET_STATE_AUTH = 1;
64 NET_STATE_GAME = 2;
66 BANLIST_FILENAME = 'banlist.txt';
67 NETDUMP_FILENAME = 'netdump';
69 {$IFDEF FREEBSD}
70 NilThreadId = nil;
71 {$ELSE}
72 NilThreadId = 0;
73 {$ENDIF}
75 type
76 TNetClient = record
77 ID: Byte;
78 Used: Boolean;
79 State: Byte;
80 Peer: pENetPeer;
81 Player: Word;
82 RequestedFullUpdate: Boolean;
83 RCONAuth: Boolean;
84 Voted: Boolean;
85 end;
86 TBanRecord = record
87 IP: LongWord;
88 Perm: Boolean;
89 end;
90 pTNetClient = ^TNetClient;
92 AByte = array of Byte;
94 var
95 NetInitDone: Boolean = False;
96 NetMode: Byte = NET_NONE;
97 NetDump: Boolean = False;
99 NetServerName: string = 'Unnamed Server';
100 NetPassword: string = '';
101 NetPort: Word = 25666;
103 NetAllowRCON: Boolean = False;
104 NetRCONPassword: string = '';
106 NetTimeToUpdate: Cardinal = 0;
107 NetTimeToReliable: Cardinal = 0;
108 NetTimeToMaster: Cardinal = 0;
110 NetHost: pENetHost = nil;
111 NetPeer: pENetPeer = nil;
112 NetEvent: ENetEvent;
113 NetAddr: ENetAddress;
115 NetPongAddr: ENetAddress;
116 NetPongSock: ENetSocket = ENET_SOCKET_NULL;
118 NetUseMaster: Boolean = True;
119 NetSlistAddr: ENetAddress;
120 NetSlistIP: string = 'mpms.doom2d.org';
121 NetSlistPort: Word = 25665;
123 NetClientIP: string = '127.0.0.1';
124 NetClientPort: Word = 25666;
126 NetIn, NetOut: TMsg;
128 NetClients: array of TNetClient;
129 NetClientCount: Byte = 0;
130 NetMaxClients: Byte = 255;
131 NetBannedHosts: array of TBanRecord;
133 NetState: Integer = NET_STATE_NONE;
135 NetMyID: Integer = -1;
136 NetPlrUID1: Integer = -1;
137 NetPlrUID2: Integer = -1;
139 NetInterpLevel: Integer = 1;
140 NetUpdateRate: Cardinal = 0; // as soon as possible
141 NetRelupdRate: Cardinal = 18; // around two times a second
142 NetMasterRate: Cardinal = 60000;
144 NetForcePlayerUpdate: Boolean = False;
145 NetPredictSelf: Boolean = True;
146 NetForwardPorts: Boolean = False;
148 NetGotEverything: Boolean = False;
149 NetGotKeys: Boolean = False;
151 {$IFDEF USE_MINIUPNPC}
152 NetPortForwarded: Word = 0;
153 NetPongForwarded: Boolean = False;
154 NetIGDControl: AnsiString;
155 NetIGDService: TURLStr;
156 {$ENDIF}
158 NetPortThread: TThreadID = NilThreadId;
160 NetDumpFile: TStream;
162 function g_Net_Init(): Boolean;
163 procedure g_Net_Cleanup();
164 procedure g_Net_Free();
165 procedure g_Net_Flush();
167 function g_Net_Host(IPAddr: LongWord; Port: enet_uint16; MaxClients: Cardinal = 16): Boolean;
168 procedure g_Net_Host_Die();
169 procedure g_Net_Host_Send(ID: Integer; Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
170 function g_Net_Host_Update(): enet_size_t;
172 function g_Net_Connect(IP: string; Port: enet_uint16): Boolean;
173 procedure g_Net_Disconnect(Forced: Boolean = False);
174 procedure g_Net_Client_Send(Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
175 function g_Net_Client_Update(): enet_size_t;
176 function g_Net_Client_UpdateWhileLoading(): enet_size_t;
178 function g_Net_Client_ByName(Name: string): pTNetClient;
179 function g_Net_Client_ByPlayer(PID: Word): pTNetClient;
180 function g_Net_ClientName_ByID(ID: Integer): string;
182 procedure g_Net_SendData(Data: AByte; peer: pENetPeer; Reliable: Boolean; Chan: Byte = NET_CHAN_DOWNLOAD);
183 function g_Net_Wait_Event(msgId: Word): TMemoryStream;
185 function IpToStr(IP: LongWord): string;
186 function StrToIp(IPstr: string; var IP: LongWord): Boolean;
188 function g_Net_IsHostBanned(IP: LongWord; Perm: Boolean = False): Boolean;
189 procedure g_Net_BanHost(IP: LongWord; Perm: Boolean = True); overload;
190 procedure g_Net_BanHost(IP: string; Perm: Boolean = True); overload;
191 function g_Net_UnbanHost(IP: string): Boolean; overload;
192 function g_Net_UnbanHost(IP: LongWord): Boolean; overload;
193 procedure g_Net_UnbanNonPermHosts();
194 procedure g_Net_SaveBanList();
196 procedure g_Net_DumpStart();
197 procedure g_Net_DumpSendBuffer();
198 procedure g_Net_DumpRecvBuffer(Buf: penet_uint8; Len: LongWord);
199 procedure g_Net_DumpEnd();
201 function g_Net_ForwardPorts(ForwardPongPort: Boolean = True): Boolean;
202 procedure g_Net_UnforwardPorts();
204 implementation
206 uses
207 SysUtils,
208 e_input, g_nethandler, g_netmsg, g_netmaster, g_player, g_window, g_console,
209 g_main, g_game, g_language, g_weapons, utils;
212 { /// SERVICE FUNCTIONS /// }
215 function g_Net_FindSlot(): Integer;
216 var
217 I: Integer;
218 F: Boolean;
219 N, C: Integer;
220 begin
221 N := -1;
222 F := False;
223 C := 0;
224 for I := Low(NetClients) to High(NetClients) do
225 begin
226 if NetClients[I].Used then
227 Inc(C)
228 else
229 if not F then
230 begin
231 F := True;
232 N := I;
233 end;
234 end;
235 if C >= NetMaxClients then
236 begin
237 Result := -1;
238 Exit;
239 end;
241 if not F then
242 begin
243 if (Length(NetClients) >= NetMaxClients) then
244 N := -1
245 else
246 begin
247 SetLength(NetClients, Length(NetClients) + 1);
248 N := High(NetClients);
249 end;
250 end;
252 if N >= 0 then
253 begin
254 NetClients[N].Used := True;
255 NetClients[N].ID := N;
256 NetClients[N].RequestedFullUpdate := False;
257 NetClients[N].RCONAuth := False;
258 NetClients[N].Voted := False;
259 NetClients[N].Player := 0;
260 end;
262 Result := N;
263 end;
265 function g_Net_Init(): Boolean;
266 var
267 F: TextFile;
268 IPstr: string;
269 IP: LongWord;
270 begin
271 NetIn.Clear();
272 NetOut.Clear();
273 SetLength(NetClients, 0);
274 NetPeer := nil;
275 NetHost := nil;
276 NetMyID := -1;
277 NetPlrUID1 := -1;
278 NetPlrUID2 := -1;
279 NetAddr.port := 25666;
280 SetLength(NetBannedHosts, 0);
281 if FileExists(DataDir + BANLIST_FILENAME) then
282 begin
283 Assign(F, DataDir + BANLIST_FILENAME);
284 Reset(F);
285 while not EOF(F) do
286 begin
287 Readln(F, IPstr);
288 if StrToIp(IPstr, IP) then
289 g_Net_BanHost(IP);
290 end;
291 CloseFile(F);
292 g_Net_SaveBanList();
293 end;
295 Result := (enet_initialize() = 0);
296 end;
298 procedure g_Net_Flush();
299 begin
300 enet_host_flush(NetHost);
301 end;
303 procedure g_Net_Cleanup();
304 begin
305 NetIn.Clear();
306 NetOut.Clear();
308 SetLength(NetClients, 0);
309 NetClientCount := 0;
311 NetPeer := nil;
312 NetHost := nil;
313 NetMPeer := nil;
314 NetMHost := nil;
315 NetMyID := -1;
316 NetPlrUID1 := -1;
317 NetPlrUID2 := -1;
318 NetState := NET_STATE_NONE;
320 NetPongSock := ENET_SOCKET_NULL;
322 NetTimeToMaster := 0;
323 NetTimeToUpdate := 0;
324 NetTimeToReliable := 0;
326 NetMode := NET_NONE;
328 if NetPortThread <> NilThreadId then
329 WaitForThreadTerminate(NetPortThread, 66666);
331 NetPortThread := NilThreadId;
332 g_Net_UnforwardPorts();
334 if NetDump then
335 g_Net_DumpEnd();
336 end;
338 procedure g_Net_Free();
339 begin
340 g_Net_Cleanup();
342 enet_deinitialize();
343 NetInitDone := False;
344 end;
347 { /// SERVER FUNCTIONS /// }
350 function ForwardThread(Param: Pointer): PtrInt;
351 begin
352 Result := 0;
353 if not g_Net_ForwardPorts() then Result := -1;
354 end;
356 function g_Net_Host(IPAddr: LongWord; Port: enet_uint16; MaxClients: Cardinal = 16): Boolean;
357 begin
358 if NetMode <> NET_NONE then
359 begin
360 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_INGAME]);
361 Result := False;
362 Exit;
363 end;
365 Result := True;
367 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST], [Port]));
368 if not NetInitDone then
369 begin
370 if (not g_Net_Init()) then
371 begin
372 g_Console_Add(_lc[I_NET_MSG_FERROR] + _lc[I_NET_ERR_ENET]);
373 Result := False;
374 Exit;
375 end
376 else
377 NetInitDone := True;
378 end;
380 NetAddr.host := IPAddr;
381 NetAddr.port := Port;
383 if NetForwardPorts then NetPortThread := BeginThread(ForwardThread);
385 NetHost := enet_host_create(@NetAddr, NET_MAXCLIENTS, NET_CHANS, 0, 0);
387 if (NetHost = nil) then
388 begin
389 g_Console_Add(_lc[I_NET_MSG_ERROR] + Format(_lc[I_NET_ERR_HOST], [Port]));
390 Result := False;
391 g_Net_Cleanup;
392 Exit;
393 end;
395 NetPongSock := enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM);
396 if NetPongSock <> ENET_SOCKET_NULL then
397 begin
398 NetPongAddr.host := IPAddr;
399 NetPongAddr.port := NET_PING_PORT;
400 if enet_socket_bind(NetPongSock, @NetPongAddr) < 0 then
401 begin
402 enet_socket_destroy(NetPongSock);
403 NetPongSock := ENET_SOCKET_NULL;
404 end
405 else
406 enet_socket_set_option(NetPongSock, ENET_SOCKOPT_NONBLOCK, 1);
407 end;
409 NetMode := NET_SERVER;
410 NetOut.Clear();
412 if NetDump then
413 g_Net_DumpStart();
414 end;
416 procedure g_Net_Host_Die();
417 var
418 I: Integer;
419 begin
420 if NetMode <> NET_SERVER then Exit;
422 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_DISCALL]);
423 for I := 0 to High(NetClients) do
424 if NetClients[I].Used then
425 enet_peer_disconnect(NetClients[I].Peer, NET_DISC_DOWN);
427 while enet_host_service(NetHost, @NetEvent, 1000) > 0 do
428 if NetEvent.kind = ENET_EVENT_TYPE_RECEIVE then
429 enet_packet_destroy(NetEvent.packet);
431 for I := 0 to High(NetClients) do
432 if NetClients[I].Used then
433 begin
434 FreeMemory(NetClients[I].Peer^.data);
435 NetClients[I].Peer^.data := nil;
436 enet_peer_reset(NetClients[I].Peer);
437 NetClients[I].Peer := nil;
438 NetClients[I].Used := False;
439 end;
441 if (NetMPeer <> nil) and (NetMHost <> nil) then g_Net_Slist_Disconnect;
442 if NetPongSock <> ENET_SOCKET_NULL then
443 enet_socket_destroy(NetPongSock);
445 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_DIE]);
446 enet_host_destroy(NetHost);
448 NetMode := NET_NONE;
450 g_Net_Cleanup;
451 e_WriteLog('NET: Server stopped', TMsgType.Notify);
452 end;
455 procedure g_Net_Host_Send(ID: Integer; Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
456 var
457 P: pENetPacket;
458 F: enet_uint32;
459 begin
460 if (Reliable) then
461 F := LongWord(ENET_PACKET_FLAG_RELIABLE)
462 else
463 F := 0;
465 if (ID >= 0) then
466 begin
467 if ID > High(NetClients) then Exit;
468 if NetClients[ID].Peer = nil then Exit;
470 P := enet_packet_create(NetOut.Data, NetOut.CurSize, F);
471 if not Assigned(P) then Exit;
473 enet_peer_send(NetClients[ID].Peer, Chan, P);
474 end
475 else
476 begin
477 P := enet_packet_create(NetOut.Data, NetOut.CurSize, F);
478 if not Assigned(P) then Exit;
480 enet_host_broadcast(NetHost, Chan, P);
481 end;
483 if NetDump then g_Net_DumpSendBuffer();
484 g_Net_Flush();
485 NetOut.Clear();
486 end;
488 procedure g_Net_Host_CheckPings();
489 var
490 ClAddr: ENetAddress;
491 Buf: ENetBuffer;
492 Len: Integer;
493 ClTime: Int64;
494 Ping: array [0..9] of Byte;
495 NPl: Byte;
496 begin
497 if NetPongSock = ENET_SOCKET_NULL then Exit;
499 Buf.data := Addr(Ping[0]);
500 Buf.dataLength := 2+8;
502 Ping[0] := 0;
504 Len := enet_socket_receive(NetPongSock, @ClAddr, @Buf, 1);
505 if Len < 0 then Exit;
507 if (Ping[0] = Ord('D')) and (Ping[1] = Ord('F')) then
508 begin
509 ClTime := Int64(Addr(Ping[2])^);
511 NetOut.Clear();
512 NetOut.Write(Byte(Ord('D')));
513 NetOut.Write(Byte(Ord('F')));
514 NetOut.Write(NetPort);
515 NetOut.Write(ClTime);
516 g_Net_Slist_WriteInfo();
517 NPl := 0;
518 if gPlayer1 <> nil then Inc(NPl);
519 if gPlayer2 <> nil then Inc(NPl);
520 NetOut.Write(NPl);
521 NetOut.Write(gNumBots);
523 Buf.data := NetOut.Data;
524 Buf.dataLength := NetOut.CurSize;
525 enet_socket_send(NetPongSock, @ClAddr, @Buf, 1);
527 NetOut.Clear();
528 end;
529 end;
531 function g_Net_Host_Update(): enet_size_t;
532 var
533 IP: string;
534 Port: Word;
535 ID: Integer;
536 TC: pTNetClient;
537 TP: TPlayer;
538 begin
539 IP := '';
540 Result := 0;
542 if NetUseMaster then
543 g_Net_Slist_Check;
544 g_Net_Host_CheckPings;
546 while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
547 begin
548 case (NetEvent.kind) of
549 ENET_EVENT_TYPE_CONNECT:
550 begin
551 IP := IpToStr(NetEvent.Peer^.address.host);
552 Port := NetEvent.Peer^.address.port;
553 g_Console_Add(_lc[I_NET_MSG] +
554 Format(_lc[I_NET_MSG_HOST_CONN], [IP, Port]));
556 if (NetEvent.data <> NET_PROTOCOL_VER) then
557 begin
558 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_REJECT] +
559 _lc[I_NET_DISC_PROTOCOL]);
560 NetEvent.peer^.data := GetMemory(SizeOf(Byte));
561 Byte(NetEvent.peer^.data^) := 255;
562 enet_peer_disconnect(NetEvent.peer, NET_DISC_PROTOCOL);
563 enet_host_flush(NetHost);
564 Exit;
565 end;
567 ID := g_Net_FindSlot();
569 if ID < 0 then
570 begin
571 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_HOST_REJECT] +
572 _lc[I_NET_DISC_FULL]);
573 NetEvent.Peer^.data := GetMemory(SizeOf(Byte));
574 Byte(NetEvent.peer^.data^) := 255;
575 enet_peer_disconnect(NetEvent.peer, NET_DISC_FULL);
576 enet_host_flush(NetHost);
577 Exit;
578 end;
580 NetClients[ID].Peer := NetEvent.peer;
581 NetClients[ID].Peer^.data := GetMemory(SizeOf(Byte));
582 Byte(NetClients[ID].Peer^.data^) := ID;
583 NetClients[ID].State := NET_STATE_AUTH;
584 NetClients[ID].RCONAuth := False;
586 enet_peer_timeout(NetEvent.peer, ENET_PEER_TIMEOUT_LIMIT * 2, ENET_PEER_TIMEOUT_MINIMUM * 2, ENET_PEER_TIMEOUT_MAXIMUM * 2);
588 Inc(NetClientCount);
589 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST_ADD], [ID]));
590 end;
592 ENET_EVENT_TYPE_RECEIVE:
593 begin
594 ID := Byte(NetEvent.peer^.data^);
595 if ID > High(NetClients) then Exit;
596 TC := @NetClients[ID];
598 if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
599 g_Net_HostMsgHandler(TC, NetEvent.packet);
600 end;
602 ENET_EVENT_TYPE_DISCONNECT:
603 begin
604 ID := Byte(NetEvent.peer^.data^);
605 if ID > High(NetClients) then Exit;
606 TC := @NetClients[ID];
607 if TC = nil then Exit;
609 if not (TC^.Used) then Exit;
611 TP := g_Player_Get(TC^.Player);
613 if TP <> nil then
614 begin
615 TP.Lives := 0;
616 TP.Kill(K_SIMPLEKILL, 0, HIT_DISCON);
617 g_Console_Add(Format(_lc[I_PLAYER_LEAVE], [TP.Name]), True);
618 e_WriteLog('NET: Client ' + TP.Name + ' [' + IntToStr(ID) + '] disconnected.', TMsgType.Notify);
619 g_Player_Remove(TP.UID);
620 end;
622 TC^.Used := False;
623 TC^.State := NET_STATE_NONE;
624 TC^.Peer := nil;
625 TC^.Player := 0;
626 TC^.RequestedFullUpdate := False;
628 FreeMemory(NetEvent.peer^.data);
629 NetEvent.peer^.data := nil;
630 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_HOST_DISC], [ID]));
631 Dec(NetClientCount);
633 if NetUseMaster then g_Net_Slist_Update;
634 end;
635 end;
636 end;
637 end;
640 { /// CLIENT FUNCTIONS /// }
643 procedure g_Net_Disconnect(Forced: Boolean = False);
644 begin
645 if NetMode <> NET_CLIENT then Exit;
646 if (NetHost = nil) or (NetPeer = nil) then Exit;
648 if not Forced then
649 begin
650 enet_peer_disconnect(NetPeer, NET_DISC_NONE);
652 while (enet_host_service(NetHost, @NetEvent, 1500) > 0) do
653 begin
654 if (NetEvent.kind = ENET_EVENT_TYPE_DISCONNECT) then
655 begin
656 NetPeer := nil;
657 break;
658 end;
660 if (NetEvent.kind = ENET_EVENT_TYPE_RECEIVE) then
661 enet_packet_destroy(NetEvent.packet);
662 end;
664 if NetPeer <> nil then
665 begin
666 enet_peer_reset(NetPeer);
667 NetPeer := nil;
668 end;
669 end
670 else
671 begin
672 e_WriteLog('NET: Kicked from server: ' + IntToStr(NetEvent.data), TMsgType.Notify);
673 if (NetEvent.data <= NET_DISC_MAX) then
674 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_KICK] +
675 _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + NetEvent.data)], True);
676 end;
678 if NetHost <> nil then
679 begin
680 enet_host_destroy(NetHost);
681 NetHost := nil;
682 end;
683 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_CLIENT_DISC]);
685 g_Net_Cleanup;
686 e_WriteLog('NET: Disconnected', TMsgType.Notify);
687 end;
689 procedure g_Net_Client_Send(Reliable: Boolean; Chan: Byte = NET_CHAN_GAME);
690 var
691 P: pENetPacket;
692 F: enet_uint32;
693 begin
694 if (Reliable) then
695 F := LongWord(ENET_PACKET_FLAG_RELIABLE)
696 else
697 F := 0;
699 P := enet_packet_create(NetOut.Data, NetOut.CurSize, F);
700 if not Assigned(P) then Exit;
702 enet_peer_send(NetPeer, Chan, P);
703 if NetDump then g_Net_DumpSendBuffer();
704 g_Net_Flush();
705 NetOut.Clear();
706 end;
708 function g_Net_Client_Update(): enet_size_t;
709 begin
710 Result := 0;
711 while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
712 begin
713 case NetEvent.kind of
714 ENET_EVENT_TYPE_RECEIVE:
715 begin
716 if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
717 g_Net_ClientMsgHandler(NetEvent.packet);
718 end;
720 ENET_EVENT_TYPE_DISCONNECT:
721 begin
722 g_Net_Disconnect(True);
723 Result := 1;
724 Exit;
725 end;
726 end;
727 end
728 end;
730 function g_Net_Client_UpdateWhileLoading(): enet_size_t;
731 begin
732 Result := 0;
733 while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
734 begin
735 case NetEvent.kind of
736 ENET_EVENT_TYPE_RECEIVE:
737 begin
738 if NetDump then g_Net_DumpRecvBuffer(NetEvent.packet^.data, NetEvent.packet^.dataLength);
739 g_Net_ClientLightMsgHandler(NetEvent.packet);
740 end;
742 ENET_EVENT_TYPE_DISCONNECT:
743 begin
744 g_Net_Disconnect(True);
745 Result := 1;
746 Exit;
747 end;
748 end;
749 end;
750 g_Net_Flush();
751 end;
753 function g_Net_Connect(IP: string; Port: enet_uint16): Boolean;
754 var
755 OuterLoop: Boolean;
756 begin
757 if NetMode <> NET_NONE then
758 begin
759 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_ERR_INGAME], True);
760 Result := False;
761 Exit;
762 end;
764 Result := True;
766 g_Console_Add(_lc[I_NET_MSG] + Format(_lc[I_NET_MSG_CLIENT_CONN],
767 [IP, Port]));
768 if not NetInitDone then
769 begin
770 if (not g_Net_Init()) then
771 begin
772 g_Console_Add(_lc[I_NET_MSG_FERROR] + _lc[I_NET_ERR_ENET], True);
773 Result := False;
774 Exit;
775 end
776 else
777 NetInitDone := True;
778 end;
780 NetHost := enet_host_create(nil, 1, NET_CHANS, 0, 0);
782 if (NetHost = nil) then
783 begin
784 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT], True);
785 g_Net_Cleanup;
786 Result := False;
787 Exit;
788 end;
790 enet_address_set_host(@NetAddr, PChar(Addr(IP[1])));
791 NetAddr.port := Port;
793 NetPeer := enet_host_connect(NetHost, @NetAddr, NET_CHANS, NET_PROTOCOL_VER);
795 if (NetPeer = nil) then
796 begin
797 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT], True);
798 enet_host_destroy(NetHost);
799 g_Net_Cleanup;
800 Result := False;
801 Exit;
802 end;
804 OuterLoop := True;
805 while OuterLoop do
806 begin
807 while (enet_host_service(NetHost, @NetEvent, 0) > 0) do
808 begin
809 if (NetEvent.kind = ENET_EVENT_TYPE_CONNECT) then
810 begin
811 g_Console_Add(_lc[I_NET_MSG] + _lc[I_NET_MSG_CLIENT_DONE]);
812 NetMode := NET_CLIENT;
813 NetOut.Clear();
814 enet_peer_timeout(NetPeer, ENET_PEER_TIMEOUT_LIMIT * 2, ENET_PEER_TIMEOUT_MINIMUM * 2, ENET_PEER_TIMEOUT_MAXIMUM * 2);
815 NetClientIP := IP;
816 NetClientPort := Port;
817 if NetDump then
818 g_Net_DumpStart();
819 Exit;
820 end;
821 end;
823 ProcessLoading(true);
825 if e_KeyPressed(IK_ESCAPE) or e_KeyPressed(IK_SPACE) or e_KeyPressed(VK_ESCAPE) then
826 OuterLoop := False;
827 end;
829 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_TIMEOUT], True);
830 if NetPeer <> nil then enet_peer_reset(NetPeer);
831 if NetHost <> nil then
832 begin
833 enet_host_destroy(NetHost);
834 NetHost := nil;
835 end;
836 g_Net_Cleanup();
837 Result := False;
838 end;
840 function IpToStr(IP: LongWord): string;
841 var
842 Ptr: Pointer;
843 begin
844 Ptr := Addr(IP);
845 Result := IntToStr(PByte(Ptr + 0)^) + '.';
846 Result := Result + IntToStr(PByte(Ptr + 1)^) + '.';
847 Result := Result + IntToStr(PByte(Ptr + 2)^) + '.';
848 Result := Result + IntToStr(PByte(Ptr + 3)^);
849 end;
851 function StrToIp(IPstr: string; var IP: LongWord): Boolean;
852 var
853 EAddr: ENetAddress;
854 begin
855 Result := enet_address_set_host(@EAddr, PChar(@IPstr[1])) = 0;
856 IP := EAddr.host;
857 end;
859 function g_Net_Client_ByName(Name: string): pTNetClient;
860 var
861 a: Integer;
862 pl: TPlayer;
863 begin
864 Result := nil;
865 for a := Low(NetClients) to High(NetClients) do
866 if (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
867 begin
868 pl := g_Player_Get(NetClients[a].Player);
869 if pl = nil then continue;
870 if Copy(LowerCase(pl.Name), 1, Length(Name)) <> LowerCase(Name) then continue;
871 if NetClients[a].Peer <> nil then
872 begin
873 Result := @NetClients[a];
874 Exit;
875 end;
876 end;
877 end;
879 function g_Net_Client_ByPlayer(PID: Word): pTNetClient;
880 var
881 a: Integer;
882 begin
883 Result := nil;
884 for a := Low(NetClients) to High(NetClients) do
885 if (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
886 if NetClients[a].Player = PID then
887 begin
888 Result := @NetClients[a];
889 Exit;
890 end;
891 end;
893 function g_Net_ClientName_ByID(ID: Integer): string;
894 var
895 a: Integer;
896 pl: TPlayer;
897 begin
898 Result := '';
899 if ID = NET_EVERYONE then
900 Exit;
901 for a := Low(NetClients) to High(NetClients) do
902 if (NetClients[a].ID = ID) and (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
903 begin
904 pl := g_Player_Get(NetClients[a].Player);
905 if pl = nil then Exit;
906 Result := pl.Name;
907 end;
908 end;
910 procedure g_Net_SendData(Data: AByte; peer: pENetPeer; Reliable: Boolean; Chan: Byte = NET_CHAN_DOWNLOAD);
911 var
912 P: pENetPacket;
913 F: enet_uint32;
914 dataLength: Cardinal;
915 begin
916 dataLength := Length(Data);
918 if (Reliable) then
919 F := LongWord(ENET_PACKET_FLAG_RELIABLE)
920 else
921 F := 0;
923 if (peer <> nil) then
924 begin
925 P := enet_packet_create(@Data[0], dataLength, F);
926 if not Assigned(P) then Exit;
927 enet_peer_send(peer, Chan, P);
928 end
929 else
930 begin
931 P := enet_packet_create(@Data[0], dataLength, F);
932 if not Assigned(P) then Exit;
933 enet_host_broadcast(NetHost, Chan, P);
934 end;
936 enet_host_flush(NetHost);
937 end;
939 function g_Net_Wait_Event(msgId: Word): TMemoryStream;
940 var
941 downloadEvent: ENetEvent;
942 OuterLoop: Boolean;
943 MID: Byte;
944 Ptr: Pointer;
945 msgStream: TMemoryStream;
946 begin
947 FillChar(downloadEvent, SizeOf(downloadEvent), 0);
948 msgStream := nil;
949 OuterLoop := True;
950 while OuterLoop do
951 begin
952 while (enet_host_service(NetHost, @downloadEvent, 0) > 0) do
953 begin
954 if (downloadEvent.kind = ENET_EVENT_TYPE_RECEIVE) then
955 begin
956 Ptr := downloadEvent.packet^.data;
958 MID := Byte(Ptr^);
960 if (MID = msgId) then
961 begin
962 msgStream := TMemoryStream.Create;
963 msgStream.SetSize(downloadEvent.packet^.dataLength);
964 msgStream.WriteBuffer(Ptr^, downloadEvent.packet^.dataLength);
965 msgStream.Seek(0, soFromBeginning);
967 OuterLoop := False;
968 enet_packet_destroy(downloadEvent.packet);
969 break;
970 end
971 else begin
972 enet_packet_destroy(downloadEvent.packet);
973 end;
974 end
975 else
976 if (downloadEvent.kind = ENET_EVENT_TYPE_DISCONNECT) then
977 begin
978 if (downloadEvent.data <= NET_DISC_MAX) then
979 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' ' +
980 _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + downloadEvent.data)], True);
981 OuterLoop := False;
982 Break;
983 end;
984 end;
986 ProcessLoading(true);
988 if e_KeyPressed(IK_ESCAPE) or e_KeyPressed(IK_SPACE) or e_KeyPressed(VK_ESCAPE) then
989 break;
990 end;
991 Result := msgStream;
992 end;
994 function g_Net_IsHostBanned(IP: LongWord; Perm: Boolean = False): Boolean;
995 var
996 I: Integer;
997 begin
998 Result := False;
999 if NetBannedHosts = nil then
1000 Exit;
1001 for I := 0 to High(NetBannedHosts) do
1002 if (NetBannedHosts[I].IP = IP) and ((not Perm) or (NetBannedHosts[I].Perm)) then
1003 begin
1004 Result := True;
1005 break;
1006 end;
1007 end;
1009 procedure g_Net_BanHost(IP: LongWord; Perm: Boolean = True); overload;
1010 var
1011 I, P: Integer;
1012 begin
1013 if IP = 0 then
1014 Exit;
1015 if g_Net_IsHostBanned(IP, Perm) then
1016 Exit;
1018 P := -1;
1019 for I := Low(NetBannedHosts) to High(NetBannedHosts) do
1020 if NetBannedHosts[I].IP = 0 then
1021 begin
1022 P := I;
1023 break;
1024 end;
1026 if P < 0 then
1027 begin
1028 SetLength(NetBannedHosts, Length(NetBannedHosts) + 1);
1029 P := High(NetBannedHosts);
1030 end;
1032 NetBannedHosts[P].IP := IP;
1033 NetBannedHosts[P].Perm := Perm;
1034 end;
1036 procedure g_Net_BanHost(IP: string; Perm: Boolean = True); overload;
1037 var
1038 a: LongWord;
1039 b: Boolean;
1040 begin
1041 b := StrToIp(IP, a);
1042 if b then
1043 g_Net_BanHost(a, Perm);
1044 end;
1046 procedure g_Net_UnbanNonPermHosts();
1047 var
1048 I: Integer;
1049 begin
1050 if NetBannedHosts = nil then
1051 Exit;
1052 for I := Low(NetBannedHosts) to High(NetBannedHosts) do
1053 if (NetBannedHosts[I].IP > 0) and not NetBannedHosts[I].Perm then
1054 begin
1055 NetBannedHosts[I].IP := 0;
1056 NetBannedHosts[I].Perm := True;
1057 end;
1058 end;
1060 function g_Net_UnbanHost(IP: string): Boolean; overload;
1061 var
1062 a: LongWord;
1063 begin
1064 Result := StrToIp(IP, a);
1065 if Result then
1066 Result := g_Net_UnbanHost(a);
1067 end;
1069 function g_Net_UnbanHost(IP: LongWord): Boolean; overload;
1070 var
1071 I: Integer;
1072 begin
1073 Result := False;
1074 if IP = 0 then
1075 Exit;
1076 if NetBannedHosts = nil then
1077 Exit;
1078 for I := 0 to High(NetBannedHosts) do
1079 if NetBannedHosts[I].IP = IP then
1080 begin
1081 NetBannedHosts[I].IP := 0;
1082 NetBannedHosts[I].Perm := True;
1083 Result := True;
1084 // no break here to clear all bans of this host, perm and non-perm
1085 end;
1086 end;
1088 procedure g_Net_SaveBanList();
1089 var
1090 F: TextFile;
1091 I: Integer;
1092 begin
1093 Assign(F, DataDir + BANLIST_FILENAME);
1094 Rewrite(F);
1095 if NetBannedHosts <> nil then
1096 for I := 0 to High(NetBannedHosts) do
1097 if NetBannedHosts[I].Perm and (NetBannedHosts[I].IP > 0) then
1098 Writeln(F, IpToStr(NetBannedHosts[I].IP));
1099 CloseFile(F);
1100 end;
1102 procedure g_Net_DumpStart();
1103 begin
1104 if NetMode = NET_SERVER then
1105 NetDumpFile := createDiskFile(NETDUMP_FILENAME + '_server')
1106 else
1107 NetDumpFile := createDiskFile(NETDUMP_FILENAME + '_client');
1108 end;
1110 procedure g_Net_DumpSendBuffer();
1111 begin
1112 writeInt(NetDumpFile, gTime);
1113 writeInt(NetDumpFile, LongWord(NetOut.CurSize));
1114 writeInt(NetDumpFile, Byte(1));
1115 NetDumpFile.WriteBuffer(NetOut.Data^, NetOut.CurSize);
1116 end;
1118 procedure g_Net_DumpRecvBuffer(Buf: penet_uint8; Len: LongWord);
1119 begin
1120 if (Buf = nil) or (Len = 0) then Exit;
1121 writeInt(NetDumpFile, gTime);
1122 writeInt(NetDumpFile, Len);
1123 writeInt(NetDumpFile, Byte(0));
1124 NetDumpFile.WriteBuffer(Buf^, Len);
1125 end;
1127 procedure g_Net_DumpEnd();
1128 begin
1129 NetDumpFile.Free();
1130 NetDumpFile := nil;
1131 end;
1133 function g_Net_ForwardPorts(ForwardPongPort: Boolean = True): Boolean;
1134 {$IFDEF USE_MINIUPNPC}
1135 var
1136 DevList: PUPNPDev;
1137 Urls: TUPNPUrls;
1138 Data: TIGDDatas;
1139 LanAddr: array [0..255] of Char;
1140 StrPort: AnsiString;
1141 Err, I: Integer;
1142 begin
1143 Result := False;
1145 if NetPortForwarded = NetPort then
1146 begin
1147 Result := True;
1148 exit;
1149 end;
1151 NetPongForwarded := False;
1152 NetPortForwarded := 0;
1154 DevList := upnpDiscover(1000, nil, nil, 0, 0, 2, Addr(Err));
1155 if DevList = nil then
1156 begin
1157 conwritefln('port forwarding failed: upnpDiscover() failed: %d', [Err]);
1158 exit;
1159 end;
1161 I := UPNP_GetValidIGD(DevList, @Urls, @Data, Addr(LanAddr[0]), 256);
1163 if I = 0 then
1164 begin
1165 conwriteln('port forwarding failed: could not find an IGD device on this LAN');
1166 FreeUPNPDevList(DevList);
1167 FreeUPNPUrls(@Urls);
1168 exit;
1169 end;
1171 StrPort := IntToStr(NetPort);
1172 I := UPNP_AddPortMapping(
1173 Urls.controlURL, Addr(data.first.servicetype[1]),
1174 PChar(StrPort), PChar(StrPort), Addr(LanAddr[0]), PChar('D2DF'),
1175 PChar('UDP'), nil, PChar('0')
1176 );
1178 if I <> 0 then
1179 begin
1180 conwritefln('forwarding port %d failed: error %d', [NetPort, I]);
1181 FreeUPNPDevList(DevList);
1182 FreeUPNPUrls(@Urls);
1183 exit;
1184 end;
1186 if ForwardPongPort then
1187 begin
1188 StrPort := IntToStr(NET_PING_PORT);
1189 I := UPNP_AddPortMapping(
1190 Urls.controlURL, Addr(data.first.servicetype[1]),
1191 PChar(StrPort), PChar(StrPort), Addr(LanAddr[0]), PChar('D2DF'),
1192 PChar('UDP'), nil, PChar('0')
1193 );
1195 if I <> 0 then
1196 begin
1197 conwritefln('forwarding port %d failed: error %d', [NetPort + 1, I]);
1198 NetPongForwarded := False;
1199 end
1200 else
1201 begin
1202 conwritefln('forwarded port %d successfully', [NetPort + 1]);
1203 NetPongForwarded := True;
1204 end;
1205 end;
1207 conwritefln('forwarded port %d successfully', [NetPort]);
1208 NetIGDControl := AnsiString(Urls.controlURL);
1209 NetIGDService := data.first.servicetype;
1210 NetPortForwarded := NetPort;
1212 FreeUPNPDevList(DevList);
1213 FreeUPNPUrls(@Urls);
1214 Result := True;
1215 end;
1216 {$ELSE}
1217 begin
1218 Result := False;
1219 end;
1220 {$ENDIF}
1222 procedure g_Net_UnforwardPorts();
1223 {$IFDEF USE_MINIUPNPC}
1224 var
1225 I: Integer;
1226 StrPort: AnsiString;
1227 begin
1228 if NetPortForwarded = 0 then Exit;
1230 conwriteln('unforwarding ports...');
1232 StrPort := IntToStr(NetPortForwarded);
1233 I := UPNP_DeletePortMapping(
1234 PChar(NetIGDControl), Addr(NetIGDService[1]),
1235 PChar(StrPort), PChar('UDP'), nil
1236 );
1237 conwritefln(' port %d: %d', [NetPortForwarded, I]);
1239 if NetPongForwarded then
1240 begin
1241 NetPongForwarded := False;
1242 StrPort := IntToStr(NetPortForwarded + 1);
1243 I := UPNP_DeletePortMapping(
1244 PChar(NetIGDControl), Addr(NetIGDService[1]),
1245 PChar(StrPort), PChar('UDP'), nil
1246 );
1247 conwritefln(' port %d: %d', [NetPortForwarded + 1, I]);
1248 end;
1250 NetPortForwarded := 0;
1251 end;
1252 {$ELSE}
1253 begin
1254 end;
1255 {$ENDIF}
1257 initialization
1259 NetIn.Alloc(NET_BUFSIZE);
1260 NetOut.Alloc(NET_BUFSIZE);
1262 finalization
1264 NetIn.Free();
1265 NetOut.Free();
1267 end.