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