DEADSOFTWARE

render: use TPlayerModel for corpse drawing
[d2df-sdl.git] / src / game / g_netmaster.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, version 3 of the License ONLY.
6 *
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * GNU General Public License for more details.
11 *
12 * You should have received a copy of the GNU General Public License
13 * along with this program. If not, see <http://www.gnu.org/licenses/>.
14 *)
15 {$INCLUDE ../shared/a_modes.inc}
16 unit g_netmaster;
18 interface
20 uses
21 ENet, SysUtils, e_msg;
23 const
24 NET_MCHANS = 2;
26 NET_MCHAN_MAIN = 0;
27 NET_MCHAN_UPD = 1;
29 NET_MMSG_UPD = 200;
30 NET_MMSG_DEL = 201;
31 NET_MMSG_GET = 202;
33 const
34 // all timeouts in seconds
35 NMASTER_TIMEOUT_CONNECT = 3; // 3 seconds
36 NMASTER_TIMEOUT_RECONNECT = 5*60; // 5 minutes
37 //NMASTER_TIMEOUT_RECONNECT = 30; // 5 minutes
38 //NMASTER_FORCE_UPDATE_TIMEOUT = 20;
39 //NMASTER_FORCE_UPDATE_TIMEOUT = 0;
41 type
42 TNetServer = record
43 Number: Byte;
44 Protocol: Byte;
45 Name: AnsiString;
46 IP: AnsiString;
47 Port: Word;
48 Map: AnsiString;
49 Players, MaxPlayers, LocalPl, Bots: Byte;
50 Ping: Int64;
51 GameMode: Byte;
52 Password: Boolean;
53 PingAddr: ENetAddress;
54 end;
55 pTNetServer = ^TNetServer;
56 TNetServerRow = record
57 Indices: Array of Integer;
58 Current: Integer;
59 end;
61 TNetServerList = array of TNetServer;
62 pTNetServerList = ^TNetServerList;
63 TNetServerTable = array of TNetServerRow;
65 type
66 TMasterHost = record
67 public
68 hostName: AnsiString;
70 public
71 peer: pENetPeer;
72 enetAddr: ENetAddress;
73 // inside the game, calling `connect()` is disasterous, as it is blocking.
74 // so we'll use this variable to indicate if "connected" event is received.
75 NetHostConnected: Boolean;
76 NetHostConReqTime: Int64; // to timeout `connect`; -1 means "waiting for shutdown"
77 NetUpdatePending: Boolean; // should we send an update after connection completes?
78 lastDisconnectTime: Int64; // last real disconnect time; <0: do not reconnect
79 updateSent: Boolean; // was at least one update sent? (used to decide if we should call `remove()`)
80 lastUpdateTime: Int64;
81 // server list request working flags
82 srvAnswered: Integer;
83 srvAnswer: array of TNetServer;
84 slMOTD: AnsiString;
85 slUrgent: AnsiString;
86 slReadUrgent: Boolean;
87 // temporary mark
88 justAdded: Boolean;
89 connectCount: Integer;
91 private
92 netmsg: TMsg;
94 public
95 constructor Create (var ea: ENetAddress);
97 procedure clear ();
99 function setAddress (var ea: ENetAddress; hostStr: AnsiString): Boolean;
101 function isValid (): Boolean;
102 function isAlive (): Boolean; // not disconnected
103 function isConnecting (): Boolean; // is connection in progress?
104 function isConnected (): Boolean;
106 // call as often as you want, the object will do the rest
107 // but try to call this at least once in 100 msecs
108 procedure pulse ();
110 procedure disconnect (forced: Boolean);
111 function connect (): Boolean;
113 procedure update ();
114 procedure remove ();
116 class procedure writeInfo (var msg: TMsg); static;
118 procedure connectedEvent ();
119 procedure disconnectedEvent ();
120 procedure receivedEvent (pkt: pENetPacket); // `pkt` is never `nil`
121 end;
124 var
125 slCurrent: TNetServerList = nil;
126 slTable: TNetServerTable = nil;
127 slWaitStr: AnsiString = '';
128 slReturnPressed: Boolean = True;
130 slMOTD: AnsiString = '';
131 slUrgent: AnsiString = '';
133 NMASTER_FORCE_UPDATE_TIMEOUT: Integer = 0; // fuck you, fpc, and your idiotic "diagnostics"
136 procedure g_Net_Slist_Set (list: AnsiString);
137 function g_Net_Slist_Fetch (var SL: TNetServerList): Boolean;
139 // make this server private
140 procedure g_Net_Slist_Private ();
141 // make this server public
142 procedure g_Net_Slist_Public ();
144 // called while the server is running
145 procedure g_Net_Slist_ServerUpdate ();
146 // called when the server is started
147 procedure g_Net_Slist_ServerStarted ();
148 // called when the server is stopped
149 procedure g_Net_Slist_ServerClosed ();
151 // called when new netword player comes
152 procedure g_Net_Slist_ServerPlayerComes ();
153 // called when new netword player comes
154 procedure g_Net_Slist_ServerPlayerLeaves ();
155 // started new map
156 procedure g_Net_Slist_ServerMapStarted ();
157 // this server renamed (or password mode changed, or other params changed)
158 procedure g_Net_Slist_ServerRenamed ();
160 // non-zero timeout ignores current status (used to fetch server list)
161 procedure g_Net_Slist_Pulse (timeout: Integer=0);
163 procedure g_Net_Slist_ShutdownAll ();
165 procedure g_Serverlist_GenerateTable (SL: TNetServerList; var ST: TNetServerTable);
166 procedure g_Serverlist_Control (var SL: TNetServerList; var ST: TNetServerTable);
168 function GetServerFromTable (Index: Integer; SL: TNetServerList; ST: TNetServerTable): TNetServer;
170 function GetTimerMS (): Int64;
172 var (* private state *)
173 slSelection: Byte = 0;
174 slReadUrgent: Boolean = False;
176 implementation
178 uses
179 e_input, e_log, g_net, g_console,
180 g_map, g_game, g_sound, g_gui, g_menu, g_options, g_language, g_basic, r_game,
181 wadreader, g_system, utils, hashtable;
184 // ////////////////////////////////////////////////////////////////////////// //
185 var
186 NetMHost: pENetHost = nil;
187 NetMEvent: ENetEvent;
188 mlist: array of TMasterHost = nil;
190 slFetched: Boolean = False;
191 slDirPressed: Boolean = False;
193 reportsEnabled: Boolean = true;
196 //==========================================================================
197 //
198 // GetTimerMS
199 //
200 //==========================================================================
201 function GetTimerMS (): Int64;
202 begin
203 Result := GetTickCount64() {div 1000};
204 end;
207 //==========================================================================
208 //
209 // findByPeer
210 //
211 //==========================================================================
212 function findByPeer (peer: pENetPeer): Integer;
213 var
214 f: Integer;
215 begin
216 for f := 0 to High(mlist) do if (mlist[f].peer = peer) then begin result := f; exit; end;
217 result := -1;
218 end;
221 //==========================================================================
222 //
223 // ShutdownAll
224 //
225 //==========================================================================
226 procedure g_Net_Slist_ShutdownAll ();
227 var
228 f, sres, idx: Integer;
229 stt, ct: Int64;
230 activeCount: Integer = 0;
231 begin
232 if (NetMHost = nil) then exit;
233 for f := 0 to High(mlist) do
234 begin
235 if (mlist[f].isAlive()) then
236 begin
237 Inc(activeCount);
238 if (mlist[f].isConnected() and mlist[f].updateSent) then
239 begin
240 writeln('unregistering from [', mlist[f].hostName, ']');
241 mlist[f].remove();
242 end;
243 //mlist[f].disconnect(false);
244 enet_peer_disconnect_later(mlist[f].peer, 0);
245 end;
246 end;
247 if (activeCount = 0) then exit;
248 stt := GetTimerMS();
249 while (activeCount > 0) do
250 begin
251 ct := GetTimerMS();
252 if (ct < stt) or (ct-stt >= 1500) then break;
254 // fuck! https://www.mail-archive.com/enet-discuss@cubik.org/msg00852.html
255 // tl;dr: on shitdows, we can get -1 sometimes, and it is *NOT* a failure.
256 // thank you, enet. let's ignore failures altogether then.
257 sres := enet_host_service(NetMHost, @NetMEvent, 100);
258 // if (sres < 0) then break;
259 if (sres <= 0) then continue;
261 idx := findByPeer(NetMEvent.peer);
262 if (idx < 0) then
263 begin
264 if (NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE) then enet_packet_destroy(NetMEvent.packet);
265 continue;
266 end;
268 if (NetMEvent.kind = ENET_EVENT_TYPE_CONNECT) then
269 begin
270 mlist[idx].connectedEvent();
271 //mlist[idx].disconnect(false);
272 enet_peer_disconnect(mlist[f].peer, 0);
273 end
274 else if (NetMEvent.kind = ENET_EVENT_TYPE_DISCONNECT) then
275 begin
276 mlist[idx].disconnectedEvent();
277 Dec(activeCount);
278 end
279 else if (NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE) then
280 begin
281 mlist[idx].receivedEvent(NetMEvent.packet);
282 enet_packet_destroy(NetMEvent.packet);
283 end;
284 end;
285 enet_host_destroy(NetMHost);
286 NetMHost := nil;
287 end;
290 //==========================================================================
291 //
292 // DisconnectAll
293 //
294 //==========================================================================
295 procedure DisconnectAll (forced: Boolean=false);
296 var
297 f: Integer;
298 begin
299 for f := 0 to High(mlist) do
300 begin
301 if (mlist[f].isAlive()) then mlist[f].disconnect(forced);
302 end;
303 end;
306 //==========================================================================
307 //
308 // ConnectAll
309 //
310 //==========================================================================
311 procedure ConnectAll (sendUpdate: Boolean);
312 var
313 f: Integer;
314 begin
315 // set flags; pulse will take care of the rest
316 for f := 0 to High(mlist) do
317 begin
318 // force reconnect
319 mlist[f].lastDisconnectTime := 0;
320 // force updating
321 if (sendUpdate) then
322 begin
323 mlist[f].NetUpdatePending := true;
324 mlist[f].lastUpdateTime := 0;
325 end;
326 end;
327 end;
330 //==========================================================================
331 //
332 // UpdateAll
333 //
334 //==========================================================================
335 procedure UpdateAll (force: Boolean);
336 var
337 f: Integer;
338 begin
339 // set flags; pulse will take care of the rest
340 for f := 0 to High(mlist) do
341 begin
342 if (not mlist[f].isAlive()) then continue;
343 mlist[f].NetUpdatePending := true;
344 if (force) then mlist[f].lastUpdateTime := 0;
345 end;
346 end;
349 //**************************************************************************
350 //
351 // public api
352 //
353 //**************************************************************************
355 //==========================================================================
356 //
357 // g_Net_Slist_Private
358 //
359 // make this server private
360 //
361 //==========================================================================
362 procedure g_Net_Slist_Private ();
363 begin
364 DisconnectAll();
365 reportsEnabled := false;
366 end;
369 //==========================================================================
370 //
371 // g_Net_Slist_Public
372 //
373 // make this server public
374 //
375 //==========================================================================
376 procedure g_Net_Slist_Public ();
377 begin
378 if (not reportsEnabled) then
379 begin
380 reportsEnabled := true;
381 ConnectAll(true);
382 end;
383 end;
386 //==========================================================================
387 //
388 // g_Net_Slist_ServerUpdate
389 //
390 // called while the server is running
391 //
392 //==========================================================================
393 procedure g_Net_Slist_ServerUpdate ();
394 begin
395 UpdateAll(false);
396 end;
399 // called when the server is started
400 procedure g_Net_Slist_ServerStarted ();
401 begin
402 reportsEnabled := NetUseMaster;
403 if reportsEnabled and g_Game_IsServer() and g_Game_IsNet() then
404 begin
405 writeln('*** server started; reporting to master...');
406 ConnectAll(true);
407 end;
408 end;
411 //==========================================================================
412 //
413 // g_Net_Slist_ServerClosed
414 //
415 // called when the server is stopped
416 //
417 //==========================================================================
418 procedure g_Net_Slist_ServerClosed ();
419 var
420 f: Integer;
421 begin
422 if reportsEnabled then
423 begin
424 reportsEnabled := false;
425 for f := 0 to High(mlist) do
426 begin
427 if (mlist[f].isConnected()) then mlist[f].remove();
428 end;
429 end;
430 DisconnectAll();
431 end;
434 //==========================================================================
435 //
436 // g_Net_Slist_ServerPlayerComes
437 //
438 // called when new netword player comes
439 //
440 //==========================================================================
441 procedure g_Net_Slist_ServerPlayerComes ();
442 begin
443 UpdateAll(true);
444 end;
447 //==========================================================================
448 //
449 // g_Net_Slist_ServerPlayerLeaves
450 //
451 // called when new netword player comes
452 //
453 //==========================================================================
454 procedure g_Net_Slist_ServerPlayerLeaves ();
455 begin
456 UpdateAll(true);
457 end;
460 //==========================================================================
461 //
462 // g_Net_Slist_ServerMapStarted
463 //
464 // started new map
465 //
466 //==========================================================================
467 procedure g_Net_Slist_ServerMapStarted ();
468 begin
469 UpdateAll(true);
470 end;
473 //==========================================================================
474 //
475 // g_Net_Slist_ServerRenamed
476 //
477 // this server renamed (or password mode changed, or other params changed)
478 //
479 //==========================================================================
480 procedure g_Net_Slist_ServerRenamed ();
481 begin
482 UpdateAll(true);
483 end;
486 //**************************************************************************
487 //
488 // TMasterHost
489 //
490 //**************************************************************************
492 //==========================================================================
493 //
494 // TMasterHost.Create
495 //
496 //==========================================================================
497 constructor TMasterHost.Create (var ea: ENetAddress);
498 begin
499 peer := nil;
500 NetHostConnected := false;
501 NetHostConReqTime := 0;
502 NetUpdatePending := false;
503 lastDisconnectTime := 0;
504 updateSent := false;
505 lastUpdateTime := 0;
506 hostName := '';
507 ZeroMemory(@enetAddr, sizeof(enetAddr));
508 SetLength(srvAnswer, 0);
509 srvAnswered := 0;
510 slMOTD := '';
511 slUrgent := '';
512 slReadUrgent := true;
513 justAdded := false;
514 connectCount := 0;
515 netmsg.Alloc(NET_BUFSIZE);
516 setAddress(ea, '');
517 end;
520 //==========================================================================
521 //
522 // TMasterHost.clear
523 //
524 //==========================================================================
525 procedure TMasterHost.clear ();
526 begin
527 updateSent := false; // do not send 'remove'
528 disconnect(true);
529 hostName := '';
530 netmsg.Free();
531 SetLength(srvAnswer, 0);
532 srvAnswered := 0;
533 slMOTD := '';
534 slUrgent := '';
535 slReadUrgent := true;
536 ZeroMemory(@enetAddr, sizeof(enetAddr));
537 end;
540 //==========================================================================
541 //
542 // TMasterHost.setAddress
543 //
544 //==========================================================================
545 function TMasterHost.setAddress (var ea: ENetAddress; hostStr: AnsiString): Boolean;
546 begin
547 result := false;
548 SetLength(srvAnswer, 0);
549 srvAnswered := 0;
550 slMOTD := '';
551 slUrgent := '';
552 slReadUrgent := true;
553 updateSent := false; // do not send 'remove'
554 disconnect(true);
555 hostName := '';
557 if (not g_Net_IsNetworkAvailable()) then exit;
559 enetAddr := ea;
560 if (enetAddr.host = 0) or (enetAddr.port = 0) then exit;
562 if (length(hostStr) > 0) then hostName := hostStr else hostName := IntToStr(enetAddr.host)+':'+IntToStr(ea.port);
564 result := isValid();
565 end;
568 //==========================================================================
569 //
570 // TMasterHost.isValid
571 //
572 //==========================================================================
573 function TMasterHost.isValid (): Boolean;
574 begin
575 result := (enetAddr.host <> 0) and (enetAddr.port <> 0);
576 end;
579 //==========================================================================
580 //
581 // TMasterHost.isAlive
582 //
583 // not disconnected
584 //
585 //==========================================================================
586 function TMasterHost.isAlive (): Boolean;
587 begin
588 result := (NetMHost <> nil) and (peer <> nil);
589 end;
592 //==========================================================================
593 //
594 // TMasterHost.isConnecting
595 //
596 // is connection in progress?
597 //
598 //==========================================================================
599 function TMasterHost.isConnecting (): Boolean;
600 begin
601 result := isAlive() and (not NetHostConnected) and (NetHostConReqTime <> -1);
602 end;
605 //==========================================================================
606 //
607 // TMasterHost.isConnected
608 //
609 //==========================================================================
610 function TMasterHost.isConnected (): Boolean;
611 begin
612 result := isAlive() and (NetHostConnected) and (NetHostConReqTime <> -1);
613 end;
616 //==========================================================================
617 //
618 // TMasterHost.connectedEvent
619 //
620 //==========================================================================
621 procedure TMasterHost.connectedEvent ();
622 begin
623 if not isAlive() then exit;
624 if NetHostConnected then exit;
625 NetHostConnected := true;
626 NetHostConReqTime := 0; // just in case
627 e_LogWritefln('connected to master at [%s]', [hostName], TMsgType.Notify);
628 //g_Console_Add(Format(_lc[I_NET_MSG]+_lc[I_NET_SLIST_CONN], [mlist[f].hostName]));
629 end;
632 //==========================================================================
633 //
634 // TMasterHost.disconnectedEvent
635 //
636 //==========================================================================
637 procedure TMasterHost.disconnectedEvent ();
638 begin
639 if not isAlive() then exit;
640 e_LogWritefln('disconnected from master at [%s]', [hostName], TMsgType.Notify);
641 disconnect(true);
642 //if (spamConsole) then g_Console_Add(Format(_lc[I_NET_MSG]+_lc[I_NET_SLIST_DISC], [hostName]));
643 end;
646 //==========================================================================
647 //
648 // TMasterHost.receivedEvent
649 //
650 // `pkt` is never `nil`
651 //
652 //==========================================================================
653 procedure TMasterHost.receivedEvent (pkt: pENetPacket);
654 var
655 msg: TMsg;
656 MID: Byte;
657 Cnt: Byte;
658 f: Integer;
659 s: AnsiString;
660 begin
661 e_LogWritefln('received packed from master at [%s]', [hostName], TMsgType.Notify);
662 if not msg.Init(pkt^.data, pkt^.dataLength, True) then exit;
663 // packet type
664 MID := msg.ReadByte();
665 if (MID <> NET_MMSG_GET) then exit;
666 e_LogWritefln('received list packet from master at [%s]', [hostName], TMsgType.Notify);
667 SetLength(srvAnswer, 0);
668 if (srvAnswered > 0) then Inc(srvAnswered);
669 slMOTD := '';
670 //slUrgent := '';
671 slReadUrgent := true;
672 // number of items
673 Cnt := msg.ReadByte();
674 //g_Console_Add(_lc[I_NET_MSG]+Format(_lc[I_NET_SLIST_RETRIEVED], [Cnt, hostName]), True);
675 e_LogWritefln('got %u server(s) from master at [%s]', [Cnt, hostName], TMsgType.Notify);
676 if (Cnt > 0) then
677 begin
678 SetLength(srvAnswer, Cnt);
679 for f := 0 to Cnt-1 do
680 begin
681 srvAnswer[f].Number := f;
682 srvAnswer[f].IP := msg.ReadString();
683 srvAnswer[f].Port := msg.ReadWord();
684 srvAnswer[f].Name := msg.ReadString();
685 srvAnswer[f].Map := msg.ReadString();
686 srvAnswer[f].GameMode := msg.ReadByte();
687 srvAnswer[f].Players := msg.ReadByte();
688 srvAnswer[f].MaxPlayers := msg.ReadByte();
689 srvAnswer[f].Protocol := msg.ReadByte();
690 srvAnswer[f].Password := msg.ReadByte() = 1;
691 enet_address_set_host(Addr(srvAnswer[f].PingAddr), PChar(Addr(srvAnswer[f].IP[1])));
692 srvAnswer[f].Ping := -1;
693 srvAnswer[f].PingAddr.port := NET_PING_PORT;
694 end;
695 end;
697 if (msg.ReadCount < msg.CurSize) then
698 begin
699 // new master, supports version reports
700 s := msg.ReadString();
701 if (s <> {MyVer}GAME_VERSION) then
702 begin
703 { TODO }
704 g_Console_Add('!!! UpdVer = `'+s+'`');
705 end;
706 // even newer master, supports extra info
707 if (msg.ReadCount < msg.CurSize) then
708 begin
709 slMOTD := b_Text_Format(msg.ReadString());
710 if (slMOTD <> '') then e_LogWritefln('got MOTD from master at [%s]: %s', [hostName, slMOTD], TMsgType.Notify);
711 s := b_Text_Format(msg.ReadString());
712 // check if the message has updated and the user has to read it again
713 if (slUrgent <> s) then slReadUrgent := false;
714 slUrgent := s;
715 if (s <> '') then e_LogWritefln('got urgent from master at [%s]: %s', [hostName, s], TMsgType.Notify);
716 end;
717 end;
718 end;
721 //==========================================================================
722 //
723 // TMasterHost.disconnect
724 //
725 //==========================================================================
726 procedure TMasterHost.disconnect (forced: Boolean);
727 begin
728 if isAlive() then
729 begin
730 lastDisconnectTime := GetTimerMS();
731 if forced or (not NetHostConnected) or (NetHostConReqTime = -1) then
732 begin
733 enet_peer_reset(peer);
734 peer := nil;
735 NetHostConReqTime := 0;
736 updateSent := false;
737 end
738 else
739 begin
740 enet_peer_disconnect_later(peer, 0);
741 // main pulse will take care of the rest
742 NetHostConReqTime := -1;
743 end;
744 end
745 else
746 begin
747 // just in case
748 NetHostConReqTime := 0;
749 updateSent := false;
750 end;
752 NetHostConnected := false;
753 NetUpdatePending := false;
754 lastUpdateTime := 0;
755 //if (spamConsole) then g_Console_Add(Format(_lc[I_NET_MSG]+_lc[I_NET_SLIST_DISC], [hostName]));
756 end;
759 //==========================================================================
760 //
761 // TMasterHost.connect
762 //
763 //==========================================================================
764 function TMasterHost.connect (): Boolean;
765 begin
766 result := false;
767 if not isValid() then exit;
768 if (NetHostConReqTime = -1) then
769 begin
770 disconnect(true);
771 if (NetHostConReqTime = -1) then e_LogWritefln('ketmar broke master [%s] logic! (000)', [hostName], TMsgType.Notify);
772 if (isAlive()) then e_LogWritefln('ketmar broke master [%s] logic! (001)', [hostName], TMsgType.Notify);
773 end
774 else
775 begin
776 if isAlive() then begin result := true; exit; end;
777 end;
779 lastDisconnectTime := GetTimerMS(); // why not?
780 SetLength(srvAnswer, 0);
781 srvAnswered := 0;
782 NetHostConnected := false;
783 NetHostConReqTime := 0;
784 NetUpdatePending := false;
785 updateSent := false;
786 lastUpdateTime := 0;
787 Inc(connectCount);
789 peer := enet_host_connect(NetMHost, @enetAddr, NET_MCHANS, 0);
790 if (peer = nil) then
791 begin
792 g_Console_Add(_lc[I_NET_MSG_ERROR]+_lc[I_NET_ERR_CLIENT], true);
793 exit;
794 end;
796 NetHostConReqTime := lastDisconnectTime;
797 e_LogWritefln('connecting to master at [%s]', [hostName], TMsgType.Notify);
798 end;
801 //==========================================================================
802 //
803 // TMasterHost.writeInfo
804 //
805 //==========================================================================
806 class procedure TMasterHost.writeInfo (var msg: TMsg);
807 var
808 wad, map: AnsiString;
809 begin
810 wad := g_ExtractWadNameNoPath(gMapInfo.Map);
811 map := g_ExtractFileName(gMapInfo.Map);
813 msg.Write(NetServerName);
815 msg.Write(wad+':/'+map);
816 msg.Write(gGameSettings.GameMode);
818 msg.Write(Byte(NetClientCount));
820 msg.Write(NetMaxClients);
822 msg.Write(Byte(NET_PROTOCOL_VER));
823 msg.Write(Byte(NetPassword <> ''));
824 end;
827 //==========================================================================
828 //
829 // TMasterHost.update
830 //
831 //==========================================================================
832 procedure TMasterHost.update ();
833 var
834 pkt: pENetPacket;
835 begin
836 if not isAlive() then exit;
837 if not isConnected() then
838 begin
839 NetUpdatePending := isConnecting();
840 exit;
841 end;
843 netmsg.Clear();
845 if reportsEnabled and g_Game_IsServer() and g_Game_IsNet() and NetUseMaster then
846 begin
847 try
848 netmsg.Write(Byte(NET_MMSG_UPD));
849 netmsg.Write(NetAddr.port);
850 //writeln(formatstrf('%08x', [NetAddr.host]), ' : ', NetAddr.host);
852 writeInfo(netmsg);
854 pkt := enet_packet_create(netmsg.Data, netmsg.CurSize, ENET_PACKET_FLAG_RELIABLE);
855 if assigned(pkt) then
856 begin
857 if (enet_peer_send(peer, NET_MCHAN_UPD, pkt) = 0) then
858 begin
859 e_LogWritefln('sent update to master at [%s]', [hostName], TMsgType.Notify);
860 NetUpdatePending := false;
861 updateSent := true;
862 end;
863 end;
864 finally
865 netmsg.Clear();
866 end;
867 end
868 else
869 begin
870 NetUpdatePending := false;
871 end;
872 end;
875 //==========================================================================
876 //
877 // TMasterHost.remove
878 //
879 //==========================================================================
880 procedure TMasterHost.remove ();
881 var
882 pkt: pENetPacket;
883 begin
884 NetUpdatePending := false;
885 lastUpdateTime := 0;
886 updateSent := false;
887 if not isAlive() then exit;
888 if not isConnected() then exit;
890 netmsg.Clear();
891 try
892 netmsg.Write(Byte(NET_MMSG_DEL));
893 netmsg.Write(NetAddr.port);
895 pkt := enet_packet_create(netmsg.Data, netmsg.CurSize, ENET_PACKET_FLAG_RELIABLE);
896 if assigned(pkt) then
897 begin
898 enet_peer_send(peer, NET_MCHAN_MAIN, pkt);
899 end;
900 finally
901 netmsg.Clear();
902 end;
903 end;
906 //==========================================================================
907 //
908 // TMasterHost.pulse
909 //
910 // this performs various scheduled tasks, if necessary
911 //
912 //==========================================================================
913 procedure TMasterHost.pulse ();
914 var
915 ct: Int64;
916 mrate: Cardinal;
917 begin
918 if not isAlive() then exit;
919 if (NetHostConReqTime = -1) then exit; // waiting for shutdown (disconnect in progress)
920 ct := GetTimerMS();
921 // process pending connection timeout
922 if (not NetHostConnected) then
923 begin
924 if (ct < NetHostConReqTime) or (ct-NetHostConReqTime >= 1000*NMASTER_TIMEOUT_CONNECT) then
925 begin
926 e_LogWritefln('failed to connect to master at [%s]', [hostName], TMsgType.Notify);
927 // do not spam with error messages, it looks like the master is down
928 //g_Console_Add(_lc[I_NET_MSG_ERROR] + _lc[I_NET_SLIST_ERROR], True);
929 disconnect(true);
930 end;
931 exit;
932 end;
933 // send update, if necessary
934 if (NetUpdatePending) then
935 begin
936 mrate := NetMasterRate;
937 if (mrate < 10000) then mrate := 10000
938 else if (mrate > 1000*60*10) then mrate := 1000*60*10;
939 if (NMASTER_FORCE_UPDATE_TIMEOUT > 0) then mrate := NMASTER_FORCE_UPDATE_TIMEOUT*1000;
940 if (lastUpdateTime = 0) or (ct < lastUpdateTime) or (ct-lastUpdateTime >= mrate) then
941 begin
942 //e_LogWritefln('update timeout: %d', [Integer(mrate)], TMsgType.Notify);
943 lastUpdateTime := ct;
944 update();
945 end;
946 end;
947 end;
950 //**************************************************************************
951 //
952 // other functions
953 //
954 //**************************************************************************
955 type
956 THashStrDWord = specialize THashBase<AnsiString, LongWord, THashKeyStrAnsiCI>;
958 var
959 knownHosts: THashStrDWord = nil;
962 //==========================================================================
963 //
964 // parseAddressPort
965 //
966 //==========================================================================
967 function parseAddressPort (var ea: ENetAddress; hostandport: AnsiString): Boolean;
968 var
969 cp, port: Integer;
970 hostName: AnsiString;
971 ip: LongWord;
972 begin
973 result := false;
974 if (not g_Net_IsNetworkAvailable()) then exit;
976 hostandport := Trim(hostandport);
977 if (length(hostandport) = 0) then exit;
979 hostName := hostandport;
980 port := 25665;
982 cp := Pos(':', hostandport);
983 if (cp > 0) then
984 begin
985 hostName := Trim(Copy(hostandport, 1, cp-1));
986 Delete(hostandport, 1, cp);
987 hostandport := Trim(hostandport);
988 if (length(hostandport) > 0) then
989 begin
990 try
991 port := StrToInt(hostandport);
992 except
993 port := -1;
994 end;
995 end;
996 end;
998 if (length(hostName) = 0) then exit;
999 if (port < 1) or (port > 65535) then exit;
1001 if not assigned(knownHosts) then knownHosts := THashStrDWord.Create();
1003 if knownHosts.get(hostName, ip) then
1004 begin
1005 ea.host := ip;
1006 end
1007 else
1008 begin
1009 if (enet_address_set_host(@ea, PChar(Addr(hostName[1]))) <> 0) then
1010 begin
1011 knownHosts.put(hostName, 0);
1012 exit;
1013 end;
1014 knownHosts.put(hostName, ea.host);
1015 end;
1016 ea.Port := port;
1017 result := true;
1018 end;
1021 //==========================================================================
1022 //
1023 // addMasterRecord
1024 //
1025 //==========================================================================
1026 procedure addMasterRecord (var ea: ENetAddress; sa: AnsiString);
1027 var
1028 f: Integer;
1029 freeIdx: Integer;
1030 begin
1031 freeIdx := -1;
1032 for f := 0 to High(mlist) do
1033 begin
1034 if (mlist[f].enetAddr.host = ea.host) and (mlist[f].enetAddr.port = ea.port) then
1035 begin
1036 mlist[f].justAdded := true;
1037 exit;
1038 end;
1039 if (freeIdx < 0) and (not mlist[f].isValid()) then freeIdx := f;
1040 end;
1041 if (freeIdx < 0) then
1042 begin
1043 freeIdx := length(mlist);
1044 SetLength(mlist, freeIdx+1);
1045 mlist[freeIdx].Create(ea);
1046 end;
1047 mlist[freeIdx].justAdded := true;
1048 mlist[freeIdx].setAddress(ea, sa);
1049 e_LogWritefln('added masterserver with address [%s]', [sa], TMsgType.Notify);
1050 end;
1053 //==========================================================================
1054 //
1055 // g_Net_Slist_Set
1056 //
1057 //==========================================================================
1058 procedure g_Net_Slist_Set (list: AnsiString);
1059 var
1060 f, dest: Integer;
1061 sa: AnsiString;
1062 ea: ENetAddress;
1063 pp: Integer;
1064 begin
1065 if (not g_Net_IsNetworkAvailable()) then exit;
1067 for f := 0 to High(mlist) do mlist[f].justAdded := false;
1069 list := Trim(list);
1070 //writeln('list=[', list, ']');
1071 while (length(list) > 0) do
1072 begin
1073 pp := Pos(',', list);
1074 if (pp < 1) then pp := length(list)+1;
1075 sa := Trim(Copy(list, 1, pp-1));
1076 Delete(list, 1, pp);
1077 //writeln(' sa=[', sa, ']');
1078 if (length(sa) > 0) and parseAddressPort(ea, sa) then addMasterRecord(ea, sa);
1079 end;
1081 // remove unknown master servers
1082 dest := 0;
1083 for f := 0 to High(mlist) do
1084 begin
1085 if (not mlist[f].justAdded) then mlist[f].clear();
1086 if (mlist[f].isValid()) then
1087 begin
1088 if (dest <> f) then mlist[dest] := mlist[f];
1089 Inc(dest);
1090 end;
1091 end;
1092 if (dest <> length(mlist)) then SetLength(mlist, dest);
1093 end;
1096 //**************************************************************************
1097 //
1098 // main pulse
1099 //
1100 //**************************************************************************
1102 //==========================================================================
1103 //
1104 // isMasterReportsEnabled
1105 //
1106 //==========================================================================
1107 function isMasterReportsEnabled (): Boolean;
1108 begin
1109 result := (reportsEnabled and g_Game_IsServer() and g_Game_IsNet() and NetUseMaster);
1110 end;
1113 //==========================================================================
1114 //
1115 // g_Net_Slist_Pulse
1116 //
1117 // non-zero timeout ignores current status (used to fetch server list)
1118 //
1119 //==========================================================================
1120 procedure g_Net_Slist_Pulse (timeout: Integer=0);
1121 var
1122 f: Integer;
1123 sres: Integer;
1124 idx: Integer;
1125 ct: Int64;
1126 isListQuery: Boolean;
1127 count: Integer;
1128 begin
1129 if (not g_Net_IsNetworkAvailable()) then exit;
1131 if (length(mlist) = 0) then
1132 begin
1133 if (NetMHost <> nil) then
1134 begin
1135 enet_host_destroy(NetMHost);
1136 NetMHost := nil;
1137 exit;
1138 end;
1139 end;
1141 if (NetMHost = nil) then
1142 begin
1143 NetMHost := enet_host_create(nil, 64, NET_MCHANS, 1024*1024, 1024*1024);
1144 if (NetMHost = nil) then
1145 begin
1146 e_LogWriteln(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT] + ' (host_create)', TMsgType.Notify);
1147 for f := 0 to High(mlist) do mlist[f].clear();
1148 SetLength(mlist, 0);
1149 Exit;
1150 end;
1151 end;
1153 isListQuery := (timeout > 0);
1154 ct := GetTimerMS();
1155 // reconnect/disconnect/pulse for each master
1156 for f := 0 to High(mlist) do
1157 begin
1158 if (not mlist[f].isValid()) then continue;
1159 if (not mlist[f].isAlive()) then
1160 begin
1161 // not connected; try to reconnect if we're asking for a host list, or we are in netgame, and we are the host
1162 if (not isListQuery) and isMasterReportsEnabled() then
1163 begin
1164 if (mlist[f].lastDisconnectTime = 0) or (ct < mlist[f].lastDisconnectTime) or (ct-mlist[f].lastDisconnectTime >= 1000*NMASTER_TIMEOUT_RECONNECT) then
1165 begin
1166 e_LogWritefln('reconnecting to master [%s]', [mlist[f].hostName], TMsgType.Notify);
1167 mlist[f].connect();
1168 end
1169 else
1170 begin
1171 //e_LogWritefln('DEAD master [%s]: ct=%d; ldt=%d; diff=%d', [mlist[f].hostName, Integer(ct), Integer(mlist[f].lastDisconnectTime), Integer(ct-mlist[f].lastDisconnectTime)], TMsgType.Notify);
1172 end;
1173 end;
1174 end
1175 else
1176 begin
1177 // if we're not in slist query, and not in netgame (or not a host), disconnect
1178 if (not isListQuery) and (not isMasterReportsEnabled()) then
1179 begin
1180 if (mlist[f].isConnected()) and (mlist[f].updateSent) then
1181 begin
1182 e_LogWritefln('removing from master [%s]', [mlist[f].hostName], TMsgType.Notify);
1183 mlist[f].remove();
1184 end;
1185 e_LogWritefln('disconnecting from master [%s]', [mlist[f].hostName], TMsgType.Notify);
1186 mlist[f].disconnect(false);
1187 end;
1188 end;
1189 mlist[f].pulse();
1190 end;
1192 // fuck! https://www.mail-archive.com/enet-discuss@cubik.org/msg00852.html
1193 // tl;dr: on shitdows, we can get -1 sometimes, and it is *NOT* a failure.
1194 // thank you, enet. let's ignore failures altogether then.
1195 count := 10; // no more than ten events in a row
1196 sres := enet_host_service(NetMHost, @NetMEvent, timeout);
1197 while (sres > 0) do
1198 begin
1200 if (sres < 0) then
1201 begin
1202 e_LogWriteln(_lc[I_NET_MSG_ERROR] + _lc[I_NET_ERR_CLIENT] + ' (host_service)', TMsgType.Notify);
1203 for f := 0 to High(mlist) do mlist[f].clear();
1204 SetLength(mlist, 0);
1205 enet_host_destroy(NetMHost);
1206 NetMHost := nil;
1207 exit;
1208 end;
1211 idx := findByPeer(NetMEvent.peer);
1212 if (idx < 0) then
1213 begin
1214 e_LogWriteln('network event from unknown master host. ignored.', TMsgType.Warning);
1215 if (NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE) then enet_packet_destroy(NetMEvent.packet);
1216 end
1217 else
1218 begin
1219 if (NetMEvent.kind = ENET_EVENT_TYPE_CONNECT) then
1220 begin
1221 mlist[idx].connectedEvent();
1222 end
1223 else if (NetMEvent.kind = ENET_EVENT_TYPE_DISCONNECT) then
1224 begin
1225 mlist[idx].disconnectedEvent();
1226 end
1227 else if (NetMEvent.kind = ENET_EVENT_TYPE_RECEIVE) then
1228 begin
1229 mlist[idx].receivedEvent(NetMEvent.packet);
1230 enet_packet_destroy(NetMEvent.packet);
1231 end;
1232 end;
1234 Dec(count);
1235 if (count = 0) then break;
1236 sres := enet_host_service(NetMHost, @NetMEvent, 0);
1237 end;
1238 end;
1241 //**************************************************************************
1242 //
1243 // gui and server list
1244 //
1245 //**************************************************************************
1247 //==========================================================================
1248 //
1249 // PingServer
1250 //
1251 //==========================================================================
1252 procedure PingServer (var S: TNetServer; Sock: ENetSocket);
1253 var
1254 Buf: ENetBuffer;
1255 Ping: array [0..9] of Byte;
1256 ClTime: Int64;
1257 begin
1258 ClTime := GetTimerMS();
1260 Buf.data := Addr(Ping[0]);
1261 Buf.dataLength := 2+8;
1263 Ping[0] := Ord('D');
1264 Ping[1] := Ord('F');
1265 Int64(Addr(Ping[2])^) := ClTime;
1267 enet_socket_send(Sock, Addr(S.PingAddr), @Buf, 1);
1268 end;
1271 //==========================================================================
1272 //
1273 // PingBcast
1274 //
1275 //==========================================================================
1276 procedure PingBcast (Sock: ENetSocket);
1277 var
1278 S: TNetServer;
1279 begin
1280 S.IP := '255.255.255.255';
1281 S.Port := NET_PING_PORT;
1282 enet_address_set_host(Addr(S.PingAddr), PChar(Addr(S.IP[1])));
1283 S.Ping := -1;
1284 S.PingAddr.port := S.Port;
1285 PingServer(S, Sock);
1286 end;
1289 //==========================================================================
1290 //
1291 // g_Net_Slist_Fetch
1292 //
1293 //==========================================================================
1294 function g_Net_Slist_Fetch (var SL: TNetServerList): Boolean;
1295 var
1296 Cnt: Byte;
1297 pkt: pENetPacket;
1298 I, RX: Integer;
1299 T: Int64;
1300 Sock: ENetSocket;
1301 Buf: ENetBuffer;
1302 InMsg: TMsg;
1303 SvAddr: ENetAddress;
1304 FromSL: Boolean;
1305 MyVer: AnsiString;
1307 procedure ProcessLocal ();
1308 begin
1309 I := Length(SL);
1310 SetLength(SL, I + 1);
1311 with SL[I] do
1312 begin
1313 IP := DecodeIPV4(SvAddr.host);
1314 Port := InMsg.ReadWord();
1315 Ping := InMsg.ReadInt64();
1316 Ping := GetTimerMS() - Ping;
1317 Name := InMsg.ReadString();
1318 Map := InMsg.ReadString();
1319 GameMode := InMsg.ReadByte();
1320 Players := InMsg.ReadByte();
1321 MaxPlayers := InMsg.ReadByte();
1322 Protocol := InMsg.ReadByte();
1323 Password := InMsg.ReadByte() = 1;
1324 LocalPl := InMsg.ReadByte();
1325 Bots := InMsg.ReadWord();
1326 end;
1327 end;
1329 procedure CheckLocalServers ();
1330 begin
1331 SetLength(SL, 0);
1333 Sock := enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM);
1334 if Sock = ENET_SOCKET_NULL then Exit;
1335 enet_socket_set_option(Sock, ENET_SOCKOPT_NONBLOCK, 1);
1336 enet_socket_set_option(Sock, ENET_SOCKOPT_BROADCAST, 1);
1337 PingBcast(Sock);
1339 T := GetTimerMS();
1341 InMsg.Alloc(NET_BUFSIZE);
1342 Buf.data := InMsg.Data;
1343 Buf.dataLength := InMsg.MaxSize;
1344 while GetTimerMS() - T <= 500 do
1345 begin
1346 InMsg.Clear();
1348 RX := enet_socket_receive(Sock, @SvAddr, @Buf, 1);
1349 if RX <= 0 then continue;
1350 InMsg.CurSize := RX;
1352 InMsg.BeginReading();
1354 if InMsg.ReadChar() <> 'D' then continue;
1355 if InMsg.ReadChar() <> 'F' then continue;
1357 ProcessLocal();
1358 end;
1360 InMsg.Free();
1361 enet_socket_destroy(Sock);
1363 if Length(SL) = 0 then SL := nil;
1364 end;
1366 var
1367 f, c, n, pos: Integer;
1368 aliveCount: Integer;
1369 hasUnanswered: Boolean;
1370 stt, ct: Int64;
1371 tmpsv: TNetServer;
1372 begin
1373 result := false;
1374 SL := nil;
1376 if (not g_Net_IsNetworkAvailable()) then
1377 begin
1378 SetLength(SL, 0);
1379 exit;
1380 end;
1382 g_Net_Slist_Pulse(); // this will create mhost
1384 DisconnectAll(true); // forced disconnect
1386 for f := 0 to High(mlist) do
1387 begin
1388 mlist[f].connectCount := 0;
1389 mlist[f].srvAnswered := 0;
1390 end;
1392 NetOut.Clear();
1393 NetOut.Write(Byte(NET_MMSG_GET));
1395 // TODO: what should we identify the build with?
1396 MyVer := GAME_VERSION;
1397 NetOut.Write(MyVer);
1399 try
1400 e_WriteLog('Fetching serverlist...', TMsgType.Notify);
1401 g_Console_Add(_lc[I_NET_MSG]+_lc[I_NET_SLIST_FETCH]);
1403 // wait until all servers connected and answered
1404 stt := GetTimerMS();
1405 while true do
1406 begin
1407 aliveCount := 0;
1408 hasUnanswered := false;
1409 for f := 0 to High(mlist) do
1410 begin
1412 e_LogWritefln(' master #%d: [%s] valid=%d; alive=%d; connected=%d; connecting=%d',
1413 [f, mlist[f].hostName, Integer(mlist[f].isValid()), Integer(mlist[f].isAlive()),
1414 Integer(mlist[f].isConnected()), Integer(mlist[f].isConnecting())], TMsgType.Notify);
1416 if (not mlist[f].isValid()) then continue;
1417 if (not mlist[f].isAlive()) then
1418 begin
1419 if (mlist[f].connectCount = 0) then
1420 begin
1421 mlist[f].connect();
1422 if (mlist[f].isAlive()) then
1423 begin
1424 //g_Console_Add(Format(_lc[I_NET_MSG]+_lc[I_NET_SLIST_WCONN], [mlist[f].hostName]));
1425 hasUnanswered := true;
1426 stt := GetTimerMS();
1427 end;
1428 end
1429 else if (mlist[f].srvAnswered > 1) then
1430 begin
1431 Inc(aliveCount);
1432 end;
1433 end
1434 else if (mlist[f].isConnected()) then
1435 begin
1436 //g_Console_Add(Format(_lc[I_NET_MSG]+_lc[I_NET_SLIST_CONN], [mlist[f].hostName]));
1437 if (mlist[f].srvAnswered = 0) then
1438 begin
1439 pkt := enet_packet_create(NetOut.Data, NetOut.CurSize, Cardinal(ENET_PACKET_FLAG_RELIABLE));
1440 if assigned(pkt) then
1441 begin
1442 if (enet_peer_send(mlist[f].peer, NET_MCHAN_MAIN, pkt) = 0) then
1443 begin
1444 hasUnanswered := true;
1445 mlist[f].srvAnswered := 1;
1446 stt := GetTimerMS();
1447 end;
1448 end;
1449 end
1450 else if (mlist[f].srvAnswered = 1) then
1451 begin
1452 hasUnanswered := true;
1453 end
1454 else if (mlist[f].srvAnswered > 1) then
1455 begin
1456 Inc(aliveCount);
1457 mlist[f].disconnect(false); // not forced
1458 end;
1459 end
1460 else if (mlist[f].isConnecting()) then
1461 begin
1462 hasUnanswered := true;
1463 end;
1464 end;
1465 if (not hasUnanswered) then break;
1466 // check for timeout
1467 ct := GetTimerMS();
1468 if (ct < stt) or (ct-stt > 4000) then break;
1469 g_Net_Slist_Pulse(300);
1470 end;
1472 if (aliveCount = 0) then
1473 begin
1474 DisconnectAll();
1475 CheckLocalServers();
1476 exit;
1477 end;
1479 slMOTD := '';
1481 slUrgent := '';
1482 slReadUrgent := true;
1485 SetLength(SL, 0);
1486 for f := 0 to High(mlist) do
1487 begin
1488 if (mlist[f].srvAnswered < 2) then continue;
1489 for n := 0 to High(mlist[f].srvAnswer) do
1490 begin
1491 pos := -1;
1492 for c := 0 to High(SL) do
1493 begin
1494 if (SL[c].IP = mlist[f].srvAnswer[n].IP) and (SL[c].Port = mlist[f].srvAnswer[n].Port) then
1495 begin
1496 pos := c;
1497 break;
1498 end;
1499 end;
1500 if (pos < 0) then
1501 begin
1502 pos := length(SL);
1503 SetLength(SL, pos+1);
1504 SL[pos] := mlist[f].srvAnswer[n];
1505 SL[pos].Number := pos;
1506 end;
1507 end;
1508 if (not mlist[f].slReadUrgent) and (mlist[f].slUrgent <> '') then
1509 begin
1510 if (mlist[f].slUrgent <> slUrgent) then
1511 begin
1512 slUrgent := mlist[f].slUrgent;
1513 slReadUrgent := false;
1514 end;
1515 end;
1516 if (slMOTD <> '') and (mlist[f].slMOTD <> '') then
1517 begin
1518 slMOTD := mlist[f].slMOTD;
1519 end;
1520 end;
1522 DisconnectAll();
1524 if (length(SL) = 0) then
1525 begin
1526 CheckLocalServers();
1527 exit;
1528 end;
1530 Sock := enet_socket_create(ENET_SOCKET_TYPE_DATAGRAM);
1531 if Sock = ENET_SOCKET_NULL then Exit;
1532 enet_socket_set_option(Sock, ENET_SOCKOPT_NONBLOCK, 1);
1534 for I := Low(SL) to High(SL) do PingServer(SL[I], Sock);
1536 enet_socket_set_option(Sock, ENET_SOCKOPT_BROADCAST, 1);
1537 PingBcast(Sock);
1539 T := GetTimerMS();
1541 InMsg.Alloc(NET_BUFSIZE);
1542 Buf.data := InMsg.Data;
1543 Buf.dataLength := InMsg.MaxSize;
1544 Cnt := 0;
1545 while GetTimerMS() - T <= 500 do
1546 begin
1547 InMsg.Clear();
1549 RX := enet_socket_receive(Sock, @SvAddr, @Buf, 1);
1550 if RX <= 0 then continue;
1551 InMsg.CurSize := RX;
1553 InMsg.BeginReading();
1555 if InMsg.ReadChar() <> 'D' then continue;
1556 if InMsg.ReadChar() <> 'F' then continue;
1558 with tmpsv do
1559 begin
1560 Port := InMsg.ReadWord();
1561 Ping := InMsg.ReadInt64();
1562 Ping := GetTimerMS() - Ping;
1563 Name := InMsg.ReadString();
1564 Map := InMsg.ReadString();
1565 GameMode := InMsg.ReadByte();
1566 Players := InMsg.ReadByte();
1567 MaxPlayers := InMsg.ReadByte();
1568 Protocol := InMsg.ReadByte();
1569 Password := InMsg.ReadByte() = 1;
1570 LocalPl := InMsg.ReadByte();
1571 Bots := InMsg.ReadWord();
1572 PingAddr := SvAddr;
1573 end;
1575 FromSL := False;
1576 for I := Low(SL) to High(SL) do
1577 if (SL[I].PingAddr.host = SvAddr.host) and
1578 (SL[I].PingAddr.port = SvAddr.port) and
1579 (SL[I].Port = tmpsv.Port) and
1580 (SL[I].Name = tmpsv.Name) then
1581 begin
1582 tmpsv.IP := SL[I].IP;
1583 SL[I] := tmpsv;
1584 FromSL := True;
1585 Inc(Cnt);
1586 break;
1587 end;
1589 if not FromSL then
1590 begin
1591 I := Length(SL);
1592 SetLength(SL, I + 1);
1593 tmpsv.IP := DecodeIPV4(SvAddr.host);
1594 SL[I] := tmpsv;
1595 end;
1596 end;
1598 InMsg.Free();
1599 enet_socket_destroy(Sock);
1600 finally
1601 NetOut.Clear();
1602 end;
1603 end;
1606 //==========================================================================
1607 //
1608 // GetServerFromTable
1609 //
1610 //==========================================================================
1611 function GetServerFromTable (Index: Integer; SL: TNetServerList; ST: TNetServerTable): TNetServer;
1612 begin
1613 Result.Number := 0;
1614 Result.Protocol := 0;
1615 Result.Name := '';
1616 Result.IP := '';
1617 Result.Port := 0;
1618 Result.Map := '';
1619 Result.Players := 0;
1620 Result.MaxPlayers := 0;
1621 Result.LocalPl := 0;
1622 Result.Bots := 0;
1623 Result.Ping := 0;
1624 Result.GameMode := 0;
1625 Result.Password := false;
1626 FillChar(Result.PingAddr, SizeOf(ENetAddress), 0);
1627 if ST = nil then
1628 Exit;
1629 if (Index < 0) or (Index >= Length(ST)) then
1630 Exit;
1631 Result := SL[ST[Index].Indices[ST[Index].Current]];
1632 end;
1635 //==========================================================================
1636 //
1637 // g_Serverlist_GenerateTable
1638 //
1639 //==========================================================================
1640 procedure g_Serverlist_GenerateTable (SL: TNetServerList; var ST: TNetServerTable);
1641 var
1642 i, j: Integer;
1644 function FindServerInTable(Name: AnsiString; Port: Word): Integer;
1645 var
1646 i: Integer;
1647 begin
1648 Result := -1;
1649 if ST = nil then
1650 Exit;
1651 for i := Low(ST) to High(ST) do
1652 begin
1653 if Length(ST[i].Indices) = 0 then
1654 continue;
1655 if (SL[ST[i].Indices[0]].Name = Name) and (SL[ST[i].Indices[0]].Port = Port) then
1656 begin
1657 Result := i;
1658 Exit;
1659 end;
1660 end;
1661 end;
1662 function ComparePing(i1, i2: Integer): Boolean;
1663 var
1664 p1, p2: Int64;
1665 begin
1666 p1 := SL[i1].Ping;
1667 p2 := SL[i2].Ping;
1668 if (p1 < 0) then p1 := 999;
1669 if (p2 < 0) then p2 := 999;
1670 Result := p1 > p2;
1671 end;
1672 procedure SortIndices(var ind: Array of Integer);
1673 var
1674 I, J: Integer;
1675 T: Integer;
1676 begin
1677 for I := High(ind) downto Low(ind) do
1678 for J := Low(ind) to High(ind) - 1 do
1679 if ComparePing(ind[j], ind[j+1]) then
1680 begin
1681 T := ind[j];
1682 ind[j] := ind[j+1];
1683 ind[j+1] := T;
1684 end;
1685 end;
1686 procedure SortRows();
1687 var
1688 I, J: Integer;
1689 T: TNetServerRow;
1690 begin
1691 for I := High(ST) downto Low(ST) do
1692 for J := Low(ST) to High(ST) - 1 do
1693 if ComparePing(ST[j].Indices[0], ST[j+1].Indices[0]) then
1694 begin
1695 T := ST[j];
1696 ST[j] := ST[j+1];
1697 ST[j+1] := T;
1698 end;
1699 end;
1700 begin
1701 ST := nil;
1702 if SL = nil then
1703 Exit;
1705 for i := Low(SL) to High(SL) do
1706 begin
1707 j := FindServerInTable(SL[i].Name, SL[i].Port);
1708 if j = -1 then
1709 begin
1710 j := Length(ST);
1711 SetLength(ST, j + 1);
1712 ST[j].Current := 0;
1713 SetLength(ST[j].Indices, 1);
1714 ST[j].Indices[0] := i;
1715 end
1716 else
1717 begin
1718 SetLength(ST[j].Indices, Length(ST[j].Indices) + 1);
1719 ST[j].Indices[High(ST[j].Indices)] := i;
1720 end;
1721 end;
1723 for i := Low(ST) to High(ST) do
1724 SortIndices(ST[i].Indices);
1726 SortRows();
1727 end;
1730 //==========================================================================
1731 //
1732 // g_Serverlist_Control
1733 //
1734 //==========================================================================
1735 procedure g_Serverlist_Control (var SL: TNetServerList; var ST: TNetServerTable);
1736 var
1737 qm: Boolean;
1738 Srv: TNetServer;
1739 begin
1740 g_Net_Slist_Pulse();
1742 if gConsoleShow or gChatShow then
1743 Exit;
1745 qm := sys_HandleInput(); // this updates kbd
1747 if qm or e_KeyPressed(IK_ESCAPE) or e_KeyPressed(VK_ESCAPE) or
1748 e_KeyPressed(JOY0_JUMP) or e_KeyPressed(JOY1_JUMP) or
1749 e_KeyPressed(JOY2_JUMP) or e_KeyPressed(JOY3_JUMP) then
1750 begin
1751 SL := nil;
1752 ST := nil;
1753 gState := STATE_MENU;
1754 g_GUI_ShowWindow('MainMenu');
1755 g_GUI_ShowWindow('NetGameMenu');
1756 g_GUI_ShowWindow('NetClientMenu');
1757 g_Sound_PlayEx(WINDOW_CLOSESOUND);
1758 Exit;
1759 end;
1761 // if there's a message on the screen,
1762 if not slReadUrgent and (slUrgent <> '') then
1763 begin
1764 if e_KeyPressed(IK_RETURN) or e_KeyPressed(IK_KPRETURN) or e_KeyPressed(VK_FIRE) or e_KeyPressed(VK_OPEN) or
1765 e_KeyPressed(JOY0_ATTACK) or e_KeyPressed(JOY1_ATTACK) or e_KeyPressed(JOY2_ATTACK) or e_KeyPressed(JOY3_ATTACK) then
1766 slReadUrgent := True;
1767 Exit;
1768 end;
1770 if e_KeyPressed(IK_SPACE) or e_KeyPressed(VK_JUMP) or
1771 e_KeyPressed(JOY0_ACTIVATE) or e_KeyPressed(JOY1_ACTIVATE) or e_KeyPressed(JOY2_ACTIVATE) or e_KeyPressed(JOY3_ACTIVATE) then
1772 begin
1773 if not slFetched then
1774 begin
1775 slWaitStr := _lc[I_NET_SLIST_WAIT];
1777 r_Game_Draw;
1778 sys_Repaint;
1780 if g_Net_Slist_Fetch(SL) then
1781 begin
1782 if SL = nil then
1783 slWaitStr := _lc[I_NET_SLIST_NOSERVERS];
1784 end
1785 else
1786 if SL = nil then
1787 slWaitStr := _lc[I_NET_SLIST_ERROR];
1788 slFetched := True;
1789 slSelection := 0;
1790 g_Serverlist_GenerateTable(SL, ST);
1791 end;
1792 end
1793 else
1794 slFetched := False;
1796 if SL = nil then Exit;
1798 if e_KeyPressed(IK_RETURN) or e_KeyPressed(IK_KPRETURN) or e_KeyPressed(VK_FIRE) or e_KeyPressed(VK_OPEN) or
1799 e_KeyPressed(JOY0_ATTACK) or e_KeyPressed(JOY1_ATTACK) or e_KeyPressed(JOY2_ATTACK) or e_KeyPressed(JOY3_ATTACK) then
1800 begin
1801 if not slReturnPressed then
1802 begin
1803 Srv := GetServerFromTable(slSelection, SL, ST);
1804 if Srv.Password then
1805 begin
1806 PromptIP := Srv.IP;
1807 PromptPort := Srv.Port;
1808 gState := STATE_MENU;
1809 g_GUI_ShowWindow('ClientPasswordMenu');
1810 SL := nil;
1811 ST := nil;
1812 slReturnPressed := True;
1813 Exit;
1814 end
1815 else
1816 g_Game_StartClient(Srv.IP, Srv.Port, '');
1817 SL := nil;
1818 ST := nil;
1819 slReturnPressed := True;
1820 Exit;
1821 end;
1822 end
1823 else
1824 slReturnPressed := False;
1826 if e_KeyPressed(IK_DOWN) or e_KeyPressed(IK_KPDOWN) or e_KeyPressed(VK_DOWN) or
1827 e_KeyPressed(JOY0_DOWN) or e_KeyPressed(JOY1_DOWN) or e_KeyPressed(JOY2_DOWN) or e_KeyPressed(JOY3_DOWN) then
1828 begin
1829 if not slDirPressed then
1830 begin
1831 Inc(slSelection);
1832 if slSelection > High(ST) then slSelection := 0;
1833 slDirPressed := True;
1834 end;
1835 end;
1837 if e_KeyPressed(IK_UP) or e_KeyPressed(IK_KPUP) or e_KeyPressed(VK_UP) or
1838 e_KeyPressed(JOY0_UP) or e_KeyPressed(JOY1_UP) or e_KeyPressed(JOY2_UP) or e_KeyPressed(JOY3_UP) then
1839 begin
1840 if not slDirPressed then
1841 begin
1842 if slSelection = 0 then slSelection := Length(ST);
1843 Dec(slSelection);
1845 slDirPressed := True;
1846 end;
1847 end;
1849 if e_KeyPressed(IK_RIGHT) or e_KeyPressed(IK_KPRIGHT) or e_KeyPressed(VK_RIGHT) or
1850 e_KeyPressed(JOY0_RIGHT) or e_KeyPressed(JOY1_RIGHT) or e_KeyPressed(JOY2_RIGHT) or e_KeyPressed(JOY3_RIGHT) then
1851 begin
1852 if not slDirPressed then
1853 begin
1854 Inc(ST[slSelection].Current);
1855 if ST[slSelection].Current > High(ST[slSelection].Indices) then ST[slSelection].Current := 0;
1856 slDirPressed := True;
1857 end;
1858 end;
1860 if e_KeyPressed(IK_LEFT) or e_KeyPressed(IK_KPLEFT) or e_KeyPressed(VK_LEFT) or
1861 e_KeyPressed(JOY0_LEFT) or e_KeyPressed(JOY1_LEFT) or e_KeyPressed(JOY2_LEFT) or e_KeyPressed(JOY3_LEFT) then
1862 begin
1863 if not slDirPressed then
1864 begin
1865 if ST[slSelection].Current = 0 then ST[slSelection].Current := Length(ST[slSelection].Indices);
1866 Dec(ST[slSelection].Current);
1868 slDirPressed := True;
1869 end;
1870 end;
1872 if (not e_KeyPressed(IK_DOWN)) and
1873 (not e_KeyPressed(IK_UP)) and
1874 (not e_KeyPressed(IK_RIGHT)) and
1875 (not e_KeyPressed(IK_LEFT)) and
1876 (not e_KeyPressed(IK_KPDOWN)) and
1877 (not e_KeyPressed(IK_KPUP)) and
1878 (not e_KeyPressed(IK_KPRIGHT)) and
1879 (not e_KeyPressed(IK_KPLEFT)) and
1880 (not e_KeyPressed(VK_DOWN)) and
1881 (not e_KeyPressed(VK_UP)) and
1882 (not e_KeyPressed(VK_RIGHT)) and
1883 (not e_KeyPressed(VK_LEFT)) and
1884 (not e_KeyPressed(JOY0_UP)) and (not e_KeyPressed(JOY1_UP)) and (not e_KeyPressed(JOY2_UP)) and (not e_KeyPressed(JOY3_UP)) and
1885 (not e_KeyPressed(JOY0_DOWN)) and (not e_KeyPressed(JOY1_DOWN)) and (not e_KeyPressed(JOY2_DOWN)) and (not e_KeyPressed(JOY3_DOWN)) and
1886 (not e_KeyPressed(JOY0_LEFT)) and (not e_KeyPressed(JOY1_LEFT)) and (not e_KeyPressed(JOY2_LEFT)) and (not e_KeyPressed(JOY3_LEFT)) and
1887 (not e_KeyPressed(JOY0_RIGHT)) and (not e_KeyPressed(JOY1_RIGHT)) and (not e_KeyPressed(JOY2_RIGHT)) and (not e_KeyPressed(JOY3_RIGHT))
1888 then
1889 slDirPressed := False;
1890 end;
1893 end.