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