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