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