kam-mobile/vendor/kam_remake/src/net/KM_NetDedicatedServer.pas

unit KM_NetDedicatedServer;
{$I KaM_Remake.inc}
interface
uses
  SysUtils, Classes, Math,
  {$IFDEF MSWindows}Windows,{$ENDIF}
  KM_NetServer, KM_NetServerLocator, KM_NetUDP, KM_CommonTypes;


type
  TKMNetDedicatedServer = class
  private
    fLastPing, fLastAnnounce: cardinal;
    fNetServer: TKMNetServer;
    fServerLocator: TKMNetServerLocator;
    fUDPAnnounce: TKMNetUDPAnnounce;
    fOnMessage: TUnicodeStringEvent;
    fPublishServer: Boolean;
    fAnnounceInterval: Word;
    fPingInterval: Word;
    fServerName: AnsiString;
    fPort: Word;
    fAnnounceUDP: Boolean;
    procedure StatusMessage(const aData: string);
    procedure MasterServerError(const aData: string);
  public
    constructor Create(aMaxRooms, aKickTimeout, aPingInterval, aAnnounceInterval, aServerUDPScanPort: Word;
                       const aMasterServerAddress: String; const aHTMLStatusFile: String;
                       const aWelcomeMessage: UnicodeString; const aPacketsAccDelay: Integer; aDedicated: Boolean);
    destructor Destroy; override;

    procedure Start(const aServerName: AnsiString; const aPort: Word; aPublishServer, aAnnounceUDP: Boolean);
    procedure Stop;
    procedure UpdateState;
    procedure UpdateSettings(const aServerName: AnsiString; aPublishServer, aAnnounceUDP: Boolean;
                             aKickTimeout, aPingInterval, aAnnounceInterval, aServerUDPScanPort: Word;
                             const aMasterServerAddress: string; const aHTMLStatusFile: string;
                             const aWelcomeMessage: UnicodeString; const aServerPacketsAccDelay: Integer);
    property OnMessage: TUnicodeStringEvent write fOnMessage;
    
    procedure GetServerInfo(aList: TList);
    function IsListening: Boolean;

    property Server: TKMNetServer read fNetServer;
  end;


implementation
uses
  KM_CommonUtils;

const
  // Enforce a minimum so our master server doesn't get spammed
  MINIMUM_ANNOUNCE_INTERVAL = 180;


{ TKMDedicatedServer }
constructor TKMNetDedicatedServer.Create(aMaxRooms, aKickTimeout, aPingInterval, aAnnounceInterval, aServerUDPScanPort: Word;
                                      const aMasterServerAddress: String; const aHTMLStatusFile: String;
                                      const aWelcomeMessage: UnicodeString; const aPacketsAccDelay: Integer; aDedicated: Boolean);
begin
  inherited Create;

  fNetServer := TKMNetServer.Create(aMaxRooms, aKickTimeout, aHTMLStatusFile, aWelcomeMessage, aPacketsAccDelay);
  fServerLocator := TKMNetServerLocator.Create(aMasterServerAddress, aDedicated);
  fServerLocator.OnError := MasterServerError;
  fUDPAnnounce := TKMNetUDPAnnounce.Create(aServerUDPScanPort);
  fUDPAnnounce.OnError := StatusMessage;

  fAnnounceInterval := Max(MINIMUM_ANNOUNCE_INTERVAL, aAnnounceInterval);
  fPingInterval := aPingInterval;
  fLastPing := 0;
  fLastAnnounce := 0;
end;


destructor TKMNetDedicatedServer.Destroy;
begin
  FreeAndNil(fNetServer);
  FreeAndNil(fServerLocator);
  FreeAndNil(fUDPAnnounce);
  StatusMessage('Server destroyed');

  inherited;
end;


procedure TKMNetDedicatedServer.Start(const aServerName: AnsiString; const aPort: Word; aPublishServer, aAnnounceUDP: Boolean);
begin
  fPort := aPort;
  fServerName := aServerName;
  fPublishServer := aPublishServer;
  fAnnounceUDP := aAnnounceUDP;
  fNetServer.OnStatusMessage := StatusMessage;
  fNetServer.StartListening(fPort, fServerName);
  fUDPAnnounce.StartAnnouncing(fPort, fServerName, fAnnounceUDP);
end;


procedure TKMNetDedicatedServer.Stop;
begin
  fNetServer.StopListening;
  fNetServer.ClearClients;
  fUDPAnnounce.StopAnnouncing;
  StatusMessage('Stopped listening');
end;


procedure TKMNetDedicatedServer.UpdateState;
var
  tickCount:Cardinal;
begin
  fNetServer.UpdateStateIdle;
  fServerLocator.UpdateStateIdle;
  fUDPAnnounce.UpdateStateIdle;

  if not fNetServer.Listening then Exit; //Do not measure pings or announce the server if we are not listening

  tickCount := TimeGet;
  if TimeSince(fLastPing) >= fPingInterval then
  begin
    fNetServer.MeasurePings;
    fLastPing := tickCount;
  end;

  if fPublishServer and (TimeSince(fLastAnnounce) >= fAnnounceInterval*1000) then
  begin
    fServerLocator.AnnounceServer(UnicodeString(fServerName), fPort, fNetServer.GetPlayerCount, fAnnounceInterval + 20);
    fLastAnnounce := tickCount;
  end;
end;


procedure TKMNetDedicatedServer.UpdateSettings(const aServerName: AnsiString; aPublishServer, aAnnounceUDP: Boolean;
                                            aKickTimeout, aPingInterval, aAnnounceInterval, aServerUDPScanPort: Word;
                                            const aMasterServerAddress: String; const aHTMLStatusFile: String;
                                            const aWelcomeMessage: UnicodeString;
                                            const aServerPacketsAccDelay: Integer);
begin
  fAnnounceInterval := Max(MINIMUM_ANNOUNCE_INTERVAL, aAnnounceInterval);
  fPingInterval := aPingInterval;
  fServerLocator.MasterServerAddress := aMasterServerAddress;
  fServerName := aServerName;
  fPublishServer := aPublishServer;
  fAnnounceUDP := aAnnounceUDP;

  fNetServer.UpdateSettings(aKickTimeout, aHTMLStatusFile, aWelcomeMessage, aServerName, aServerPacketsAccDelay);
  fUDPAnnounce.UpdateSettings(aServerName, aServerUDPScanPort);

  fLastAnnounce := 0; //Make the server announce itself next update so the changes are sent to the master server ASAP
end;


procedure TKMNetDedicatedServer.StatusMessage(const aData: string);
begin
  if Assigned(fOnMessage) then fOnMessage(aData);
end;


procedure TKMNetDedicatedServer.MasterServerError(const aData: string);
begin
  StatusMessage('HTTP Master Server: ' + aData);
end;


procedure TKMNetDedicatedServer.GetServerInfo(aList: TList);
begin
  fNetServer.GetServerInfo(aList);
end;


function TKMNetDedicatedServer.IsListening: Boolean;
begin
  Result := fNetServer.Listening;
end;


end.