DEADSOFTWARE

added ready to interscreen; fixed client strafe (?); bumped protocol ver
[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 = 180;
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_SPACE) or e_KeyPressed(IK_ESCAPE) or e_KeyPressed(VK_ESCAPE) or
826 e_KeyPressed(JOY0_JUMP) or e_KeyPressed(JOY1_JUMP) or e_KeyPressed(JOY2_JUMP) or e_KeyPressed(JOY3_JUMP) then
827 OuterLoop := False;
828 end;
830 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_TIMEOUT], True);
831 if NetPeer <> nil then enet_peer_reset(NetPeer);
832 if NetHost <> nil then
833 begin
834 enet_host_destroy(NetHost);
835 NetHost := nil;
836 end;
837 g_Net_Cleanup();
838 Result := False;
839 end;
841 function IpToStr(IP: LongWord): string;
842 var
843 Ptr: Pointer;
844 begin
845 Ptr := Addr(IP);
846 Result := IntToStr(PByte(Ptr + 0)^) + '.';
847 Result := Result + IntToStr(PByte(Ptr + 1)^) + '.';
848 Result := Result + IntToStr(PByte(Ptr + 2)^) + '.';
849 Result := Result + IntToStr(PByte(Ptr + 3)^);
850 end;
852 function StrToIp(IPstr: string; var IP: LongWord): Boolean;
853 var
854 EAddr: ENetAddress;
855 begin
856 Result := enet_address_set_host(@EAddr, PChar(@IPstr[1])) = 0;
857 IP := EAddr.host;
858 end;
860 function g_Net_Client_ByName(Name: string): pTNetClient;
861 var
862 a: Integer;
863 pl: TPlayer;
864 begin
865 Result := nil;
866 for a := Low(NetClients) to High(NetClients) do
867 if (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
868 begin
869 pl := g_Player_Get(NetClients[a].Player);
870 if pl = nil then continue;
871 if Copy(LowerCase(pl.Name), 1, Length(Name)) <> LowerCase(Name) then continue;
872 if NetClients[a].Peer <> nil then
873 begin
874 Result := @NetClients[a];
875 Exit;
876 end;
877 end;
878 end;
880 function g_Net_Client_ByPlayer(PID: Word): pTNetClient;
881 var
882 a: Integer;
883 begin
884 Result := nil;
885 for a := Low(NetClients) to High(NetClients) do
886 if (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
887 if NetClients[a].Player = PID then
888 begin
889 Result := @NetClients[a];
890 Exit;
891 end;
892 end;
894 function g_Net_ClientName_ByID(ID: Integer): string;
895 var
896 a: Integer;
897 pl: TPlayer;
898 begin
899 Result := '';
900 if ID = NET_EVERYONE then
901 Exit;
902 for a := Low(NetClients) to High(NetClients) do
903 if (NetClients[a].ID = ID) and (NetClients[a].Used) and (NetClients[a].State = NET_STATE_GAME) then
904 begin
905 pl := g_Player_Get(NetClients[a].Player);
906 if pl = nil then Exit;
907 Result := pl.Name;
908 end;
909 end;
911 procedure g_Net_SendData(Data: AByte; peer: pENetPeer; Reliable: Boolean; Chan: Byte = NET_CHAN_DOWNLOAD);
912 var
913 P: pENetPacket;
914 F: enet_uint32;
915 dataLength: Cardinal;
916 begin
917 dataLength := Length(Data);
919 if (Reliable) then
920 F := LongWord(ENET_PACKET_FLAG_RELIABLE)
921 else
922 F := 0;
924 if (peer <> nil) then
925 begin
926 P := enet_packet_create(@Data[0], dataLength, F);
927 if not Assigned(P) then Exit;
928 enet_peer_send(peer, Chan, P);
929 end
930 else
931 begin
932 P := enet_packet_create(@Data[0], dataLength, F);
933 if not Assigned(P) then Exit;
934 enet_host_broadcast(NetHost, Chan, P);
935 end;
937 enet_host_flush(NetHost);
938 end;
940 function g_Net_Wait_Event(msgId: Word): TMemoryStream;
941 var
942 downloadEvent: ENetEvent;
943 OuterLoop: Boolean;
944 MID: Byte;
945 Ptr: Pointer;
946 msgStream: TMemoryStream;
947 begin
948 FillChar(downloadEvent, SizeOf(downloadEvent), 0);
949 msgStream := nil;
950 OuterLoop := True;
951 while OuterLoop do
952 begin
953 while (enet_host_service(NetHost, @downloadEvent, 0) > 0) do
954 begin
955 if (downloadEvent.kind = ENET_EVENT_TYPE_RECEIVE) then
956 begin
957 Ptr := downloadEvent.packet^.data;
959 MID := Byte(Ptr^);
961 if (MID = msgId) then
962 begin
963 msgStream := TMemoryStream.Create;
964 msgStream.SetSize(downloadEvent.packet^.dataLength);
965 msgStream.WriteBuffer(Ptr^, downloadEvent.packet^.dataLength);
966 msgStream.Seek(0, soFromBeginning);
968 OuterLoop := False;
969 enet_packet_destroy(downloadEvent.packet);
970 break;
971 end
972 else begin
973 enet_packet_destroy(downloadEvent.packet);
974 end;
975 end
976 else
977 if (downloadEvent.kind = ENET_EVENT_TYPE_DISCONNECT) then
978 begin
979 if (downloadEvent.data <= NET_DISC_MAX) then
980 g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CONN] + ' ' +
981 _lc[TStrings_Locale(Cardinal(I_NET_DISC_NONE) + downloadEvent.data)], True);
982 OuterLoop := False;
983 Break;
984 end;
985 end;
987 ProcessLoading(true);
989 if e_KeyPressed(IK_SPACE) or e_KeyPressed(IK_ESCAPE) or e_KeyPressed(VK_ESCAPE) or
990 e_KeyPressed(JOY0_JUMP) or e_KeyPressed(JOY1_JUMP) or e_KeyPressed(JOY2_JUMP) or e_KeyPressed(JOY3_JUMP) then
991 break;
992 end;
993 Result := msgStream;
994 end;
996 function g_Net_IsHostBanned(IP: LongWord; Perm: Boolean = False): Boolean;
997 var
998 I: Integer;
999 begin
1000 Result := False;
1001 if NetBannedHosts = nil then
1002 Exit;
1003 for I := 0 to High(NetBannedHosts) do
1004 if (NetBannedHosts[I].IP = IP) and ((not Perm) or (NetBannedHosts[I].Perm)) then
1005 begin
1006 Result := True;
1007 break;
1008 end;
1009 end;
1011 procedure g_Net_BanHost(IP: LongWord; Perm: Boolean = True); overload;
1012 var
1013 I, P: Integer;
1014 begin
1015 if IP = 0 then
1016 Exit;
1017 if g_Net_IsHostBanned(IP, Perm) then
1018 Exit;
1020 P := -1;
1021 for I := Low(NetBannedHosts) to High(NetBannedHosts) do
1022 if NetBannedHosts[I].IP = 0 then
1023 begin
1024 P := I;
1025 break;
1026 end;
1028 if P < 0 then
1029 begin
1030 SetLength(NetBannedHosts, Length(NetBannedHosts) + 1);
1031 P := High(NetBannedHosts);
1032 end;
1034 NetBannedHosts[P].IP := IP;
1035 NetBannedHosts[P].Perm := Perm;
1036 end;
1038 procedure g_Net_BanHost(IP: string; Perm: Boolean = True); overload;
1039 var
1040 a: LongWord;
1041 b: Boolean;
1042 begin
1043 b := StrToIp(IP, a);
1044 if b then
1045 g_Net_BanHost(a, Perm);
1046 end;
1048 procedure g_Net_UnbanNonPermHosts();
1049 var
1050 I: Integer;
1051 begin
1052 if NetBannedHosts = nil then
1053 Exit;
1054 for I := Low(NetBannedHosts) to High(NetBannedHosts) do
1055 if (NetBannedHosts[I].IP > 0) and not NetBannedHosts[I].Perm then
1056 begin
1057 NetBannedHosts[I].IP := 0;
1058 NetBannedHosts[I].Perm := True;
1059 end;
1060 end;
1062 function g_Net_UnbanHost(IP: string): Boolean; overload;
1063 var
1064 a: LongWord;
1065 begin
1066 Result := StrToIp(IP, a);
1067 if Result then
1068 Result := g_Net_UnbanHost(a);
1069 end;
1071 function g_Net_UnbanHost(IP: LongWord): Boolean; overload;
1072 var
1073 I: Integer;
1074 begin
1075 Result := False;
1076 if IP = 0 then
1077 Exit;
1078 if NetBannedHosts = nil then
1079 Exit;
1080 for I := 0 to High(NetBannedHosts) do
1081 if NetBannedHosts[I].IP = IP then
1082 begin
1083 NetBannedHosts[I].IP := 0;
1084 NetBannedHosts[I].Perm := True;
1085 Result := True;
1086 // no break here to clear all bans of this host, perm and non-perm
1087 end;
1088 end;
1090 procedure g_Net_SaveBanList();
1091 var
1092 F: TextFile;
1093 I: Integer;
1094 begin
1095 Assign(F, DataDir + BANLIST_FILENAME);
1096 Rewrite(F);
1097 if NetBannedHosts <> nil then
1098 for I := 0 to High(NetBannedHosts) do
1099 if NetBannedHosts[I].Perm and (NetBannedHosts[I].IP > 0) then
1100 Writeln(F, IpToStr(NetBannedHosts[I].IP));
1101 CloseFile(F);
1102 end;
1104 procedure g_Net_DumpStart();
1105 begin
1106 if NetMode = NET_SERVER then
1107 NetDumpFile := createDiskFile(NETDUMP_FILENAME + '_server')
1108 else
1109 NetDumpFile := createDiskFile(NETDUMP_FILENAME + '_client');
1110 end;
1112 procedure g_Net_DumpSendBuffer();
1113 begin
1114 writeInt(NetDumpFile, gTime);
1115 writeInt(NetDumpFile, LongWord(NetOut.CurSize));
1116 writeInt(NetDumpFile, Byte(1));
1117 NetDumpFile.WriteBuffer(NetOut.Data^, NetOut.CurSize);
1118 end;
1120 procedure g_Net_DumpRecvBuffer(Buf: penet_uint8; Len: LongWord);
1121 begin
1122 if (Buf = nil) or (Len = 0) then Exit;
1123 writeInt(NetDumpFile, gTime);
1124 writeInt(NetDumpFile, Len);
1125 writeInt(NetDumpFile, Byte(0));
1126 NetDumpFile.WriteBuffer(Buf^, Len);
1127 end;
1129 procedure g_Net_DumpEnd();
1130 begin
1131 NetDumpFile.Free();
1132 NetDumpFile := nil;
1133 end;
1135 function g_Net_ForwardPorts(ForwardPongPort: Boolean = True): Boolean;
1136 {$IFDEF USE_MINIUPNPC}
1137 var
1138 DevList: PUPNPDev;
1139 Urls: TUPNPUrls;
1140 Data: TIGDDatas;
1141 LanAddr: array [0..255] of Char;
1142 StrPort: AnsiString;
1143 Err, I: Integer;
1144 begin
1145 Result := False;
1147 if NetPortForwarded = NetPort then
1148 begin
1149 Result := True;
1150 exit;
1151 end;
1153 NetPongForwarded := False;
1154 NetPortForwarded := 0;
1156 DevList := upnpDiscover(1000, nil, nil, 0, 0, 2, Addr(Err));
1157 if DevList = nil then
1158 begin
1159 conwritefln('port forwarding failed: upnpDiscover() failed: %d', [Err]);
1160 exit;
1161 end;
1163 I := UPNP_GetValidIGD(DevList, @Urls, @Data, Addr(LanAddr[0]), 256);
1165 if I = 0 then
1166 begin
1167 conwriteln('port forwarding failed: could not find an IGD device on this LAN');
1168 FreeUPNPDevList(DevList);
1169 FreeUPNPUrls(@Urls);
1170 exit;
1171 end;
1173 StrPort := IntToStr(NetPort);
1174 I := UPNP_AddPortMapping(
1175 Urls.controlURL, Addr(data.first.servicetype[1]),
1176 PChar(StrPort), PChar(StrPort), Addr(LanAddr[0]), PChar('D2DF'),
1177 PChar('UDP'), nil, PChar('0')
1178 );
1180 if I <> 0 then
1181 begin
1182 conwritefln('forwarding port %d failed: error %d', [NetPort, I]);
1183 FreeUPNPDevList(DevList);
1184 FreeUPNPUrls(@Urls);
1185 exit;
1186 end;
1188 if ForwardPongPort then
1189 begin
1190 StrPort := IntToStr(NET_PING_PORT);
1191 I := UPNP_AddPortMapping(
1192 Urls.controlURL, Addr(data.first.servicetype[1]),
1193 PChar(StrPort), PChar(StrPort), Addr(LanAddr[0]), PChar('D2DF'),
1194 PChar('UDP'), nil, PChar('0')
1195 );
1197 if I <> 0 then
1198 begin
1199 conwritefln('forwarding port %d failed: error %d', [NetPort + 1, I]);
1200 NetPongForwarded := False;
1201 end
1202 else
1203 begin
1204 conwritefln('forwarded port %d successfully', [NetPort + 1]);
1205 NetPongForwarded := True;
1206 end;
1207 end;
1209 conwritefln('forwarded port %d successfully', [NetPort]);
1210 NetIGDControl := AnsiString(Urls.controlURL);
1211 NetIGDService := data.first.servicetype;
1212 NetPortForwarded := NetPort;
1214 FreeUPNPDevList(DevList);
1215 FreeUPNPUrls(@Urls);
1216 Result := True;
1217 end;
1218 {$ELSE}
1219 begin
1220 Result := False;
1221 end;
1222 {$ENDIF}
1224 procedure g_Net_UnforwardPorts();
1225 {$IFDEF USE_MINIUPNPC}
1226 var
1227 I: Integer;
1228 StrPort: AnsiString;
1229 begin
1230 if NetPortForwarded = 0 then Exit;
1232 conwriteln('unforwarding ports...');
1234 StrPort := IntToStr(NetPortForwarded);
1235 I := UPNP_DeletePortMapping(
1236 PChar(NetIGDControl), Addr(NetIGDService[1]),
1237 PChar(StrPort), PChar('UDP'), nil
1238 );
1239 conwritefln(' port %d: %d', [NetPortForwarded, I]);
1241 if NetPongForwarded then
1242 begin
1243 NetPongForwarded := False;
1244 StrPort := IntToStr(NetPortForwarded + 1);
1245 I := UPNP_DeletePortMapping(
1246 PChar(NetIGDControl), Addr(NetIGDService[1]),
1247 PChar(StrPort), PChar('UDP'), nil
1248 );
1249 conwritefln(' port %d: %d', [NetPortForwarded + 1, I]);
1250 end;
1252 NetPortForwarded := 0;
1253 end;
1254 {$ELSE}
1255 begin
1256 end;
1257 {$ENDIF}
1259 initialization
1261 NetIn.Alloc(NET_BUFSIZE);
1262 NetOut.Alloc(NET_BUFSIZE);
1264 finalization
1266 NetIn.Free();
1267 NetOut.Free();
1269 end.