CentrED/Client/UdmNetwork.pas

(*
 * CDDL HEADER START
 *
 * The contents of this file are subject to the terms of the
 * Common Development and Distribution License, Version 1.0 only
 * (the "License").  You may not use this file except in compliance
 * with the License.
 *
 * You can obtain a copy of the license at
 * http://www.opensource.org/licenses/cddl1.php.
 * See the License for the specific language governing permissions
 * and limitations under the License.
 *
 * When distributing Covered Code, include this CDDL HEADER in each
 * file and include the License file at
 * http://www.opensource.org/licenses/cddl1.php.  If applicable,
 * add the following below this CDDL HEADER, with the fields enclosed
 * by brackets "[]" replaced with your own identifying * information:
 *      Portions Copyright [yyyy] [name of copyright owner]
 *
 * CDDL HEADER END
 *
 *
 *      Portions Copyright 2009 Andreas Schneider
 *)
unit UdmNetwork;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Dialogs, lNetComponents, lNet,
  UEnhancedMemoryStream, UPacket, UEnums, ExtCtrls, dateutils;

type

  { TdmNetwork }

  TdmNetwork = class(TDataModule)
    TCPClient: TLTCPComponent;
    tmNoOp: TTimer;
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
    procedure TCPClientConnect(aSocket: TLSocket);
    procedure TCPClientDisconnect(aSocket: TLSocket);
    procedure TCPClientError(const msg: string; aSocket: TLSocket);
    procedure TCPClientReceive(aSocket: TLSocket);
    procedure tmNoOpStartTimer(Sender: TObject);
    procedure tmNoOpTimer(Sender: TObject);
  protected
    FSendQueue: TEnhancedMemoryStream;
    FReceiveQueue: TEnhancedMemoryStream;
    FUsername: string;
    FPassword: string;
    FAccessLevel: TAccessLevel;
    FDataDir: string;
    FLastPacket: TDateTime;
    procedure OnCanSend(ASocket: TLSocket);
    procedure OnConnectionHandlingPacket(ABuffer: TEnhancedMemoryStream);
    procedure ProcessQueue;
    procedure DoLogin;
  public
    property Username: string read FUsername;
    property AccessLevel: TAccessLevel read FAccessLevel write FAccessLevel;
    procedure Send(APacket: TPacket);
    procedure Disconnect;
    procedure CheckClose(ASender: TForm);
  end; 

var
  dmNetwork: TdmNetwork;

implementation

uses
  UPacketHandlers, UPackets, UfrmMain, UfrmLogin, UfrmInitialize,
  UGameResources, UfrmAccountControl, UfrmEditAccount, UfrmDrawSettings,
  UfrmBoundaries, UfrmElevateSettings, UfrmConfirmation, UfrmMoveSettings,
  UfrmAbout, UfrmHueSettings, UfrmRadar, UfrmLargeScaleCommand,
  UfrmVirtualLayer, UfrmFilter, UfrmRegionControl, UfrmLightlevel,
  UfrmChangePassword;
  
{$I version.inc}

{ TdmNetwork }

procedure TdmNetwork.DataModuleCreate(Sender: TObject);
begin
  FSendQueue := TEnhancedMemoryStream.Create;
  FReceiveQueue := TEnhancedMemoryStream.Create;
  TCPClient.OnCanSend := @OnCanSend;
  PacketHandlers[$02] := TPacketHandler.Create(0, @OnConnectionHandlingPacket);
  DoLogin;
end;

procedure TdmNetwork.DataModuleDestroy(Sender: TObject);
begin
  FreeAndNil(FSendQueue);
  FreeAndNil(FReceiveQueue);
  FreeAndNil(PacketHandlers[$02]);
end;

procedure TdmNetwork.TCPClientConnect(aSocket: TLSocket);
begin
  FSendQueue.Clear;
  FReceiveQueue.Clear;
end;

procedure TdmNetwork.TCPClientDisconnect(aSocket: TLSocket);
begin
  FSendQueue.Clear;
  FReceiveQueue.Clear;
  DoLogin;
end;

procedure TdmNetwork.TCPClientError(const msg: string; aSocket: TLSocket);
begin
  MessageDlg('Connection error', msg, mtError, [mbOK], 0);
  if not TCPClient.Connected then
    TCPClientDisconnect(aSocket);
end;

procedure TdmNetwork.TCPClientReceive(aSocket: TLSocket);
var
  buffer: array[0..4095] of byte;
  size: Integer;
begin
  repeat
    size := TCPClient.Get(buffer, 4096);
    if size > 0 then
      FReceiveQueue.Enqueue(buffer, size);
  until size <= 0;
  ProcessQueue;
end;

procedure TdmNetwork.tmNoOpStartTimer(Sender: TObject);
begin
  FLastPacket := Now;
end;

procedure TdmNetwork.tmNoOpTimer(Sender: TObject);
begin
  if SecondsBetween(FLastPacket, Now) > 25 then
    Send(TNoOpPacket.Create);
end;

procedure TdmNetwork.OnCanSend(ASocket: TLSocket);
var
  size: Integer;
begin
  while FSendQueue.Size > 0 do
  begin
    FLastPacket := Now;
    size := TCPClient.Send(FSendQueue.Memory^, FSendQueue.Size);
    if size > 0 then
      FSendQueue.Dequeue(size)
    else
      Break;
  end;
end;

procedure TdmNetwork.OnConnectionHandlingPacket(ABuffer: TEnhancedMemoryStream);
var
  subID: Byte;
  loginState: TLoginState;
  width, height: Word;
  serverState: TServerState;
begin
  subID := ABuffer.ReadByte;
  case subID of
    $01:
      begin
        if ABuffer.ReadCardinal = ProtocolVersion then
        begin
          frmInitialize.lblStatus.Caption := 'Authenticating';
          Send(TLoginRequestPacket.Create(FUsername, FPassword));
        end else
        begin
          MessageDlg('Error', 'Invalid protocol version. Maybe your client is outdated.', mtError, [mbOK], 0);
          Disconnect;
        end;
      end;
    $03:
      begin
        loginState := TLoginState(ABuffer.ReadByte);
        if loginState = lsOK then
        begin
          frmInitialize.lblStatus.Caption := 'Initializing';
          frmInitialize.Repaint;
          frmInitialize.lblStatus.Repaint;
          Application.ProcessMessages;
          FAccessLevel := TAccessLevel(ABuffer.ReadByte);
          InitGameResourceManager(FDataDir);
          width := ABuffer.ReadWord;
          height := ABuffer.ReadWord;
          ResMan.InitLandscape(width, height);
          ResMan.Landscape.UpdateWriteMap(ABuffer);

          frmMain := TfrmMain.Create(dmNetwork);
          frmRadarMap := TfrmRadarMap.Create(frmMain);
          frmLargeScaleCommand := TfrmLargeScaleCommand.Create(frmMain);
          frmRegionControl := TfrmRegionControl.Create(frmMain);
          frmAccountControl := TfrmAccountControl.Create(frmMain);
          frmEditAccount := TfrmEditAccount.Create(frmAccountControl);
          frmConfirmation := TfrmConfirmation.Create(frmMain);
          frmDrawSettings := TfrmDrawSettings.Create(frmMain);
          frmMoveSettings := TfrmMoveSettings.Create(frmMain);
          frmElevateSettings := TfrmElevateSettings.Create(frmMain);
          frmHueSettings := TfrmHueSettings.Create(frmMain);
          frmBoundaries := TfrmBoundaries.Create(frmMain);
          frmFilter := TfrmFilter.Create(frmMain);
          frmVirtualLayer := TfrmVirtualLayer.Create(frmMain);
          frmLightlevel := TfrmLightlevel.Create(frmMain);
          frmAbout := TfrmAbout.Create(frmMain);
          frmChangePassword := TfrmChangePassword.Create(frmMain);
          frmMain.Show;
          frmInitialize.Hide;
          tmNoOp.Enabled := True;
        end else
        begin
          if loginState = lsInvalidUser then
            MessageDlg('Error', 'The username you specified is incorrect.', mtWarning, [mbOK], 0)
          else if loginState = lsInvalidPassword then
            MessageDlg('Error', 'The password you specified is incorrect.', mtWarning, [mbOK], 0)
          else if loginState = lsAlreadyLoggedIn then
            MessageDlg('Error', 'There is already a client logged in using that account.', mtWarning, [mbOK], 0)
          else if loginState = lsNoAccess then
            MessageDlg('Error', 'This account has no access.', mtWarning, [mbOK], 0);
        end;
      end;
    $04: //Server state
      begin
        serverState := TServerState(ABuffer.ReadByte);
        if serverState = ssRunning then
        begin
          frmInitialize.UnsetModal;
          frmInitialize.Hide;
          tmNoOp.Enabled := True;
        end else
        begin
          case serverState of
            ssFrozen: frmInitialize.lblStatus.Caption := 'The server is currently paused.';
            ssOther: frmInitialize.lblStatus.Caption := ABuffer.ReadStringNull
          end;
          tmNoOp.Enabled := False;
          frmInitialize.Show;
          frmInitialize.SetModal;
        end;
      end;
  end;
end;

procedure TdmNetwork.ProcessQueue;
var
  packetHandler: TPacketHandler;
  size: Cardinal;
begin
  FReceiveQueue.Position := 0;
  while FReceiveQueue.Size >= 1 do
  begin
    packetHandler := PacketHandlers[FReceiveQueue.ReadByte];
    if packetHandler <> nil then
    begin
      size := packetHandler.PacketLength;
      if size = 0 then
      begin
        if FReceiveQueue.Size > 5 then
          size := FReceiveQueue.ReadCardinal
        else
          Break; //wait for more data
      end;

      if FReceiveQueue.Size >= size then
      begin
        FReceiveQueue.Lock(FReceiveQueue.Position, size - FReceiveQueue.Position); //prevent handler from reading too much
        packetHandler.Process(FReceiveQueue);
        FReceiveQueue.Unlock;
        FReceiveQueue.Dequeue(size);
      end else
        Break; //wait for more data
    end else
    begin
      {Writeln('Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress);}
      Disconnect;
      FReceiveQueue.Clear;
    end;
  end;
end;

procedure TdmNetwork.DoLogin;
begin
  tmNoOp.Enabled := False;
  frmLogin := TfrmLogin.Create(dmNetwork);
  if frmInitialize = nil then
    frmInitialize := TfrmInitialize.Create(dmNetwork);

  FreeAndNil(frmEditAccount);
  FreeAndNil(frmAccountControl);
  FreeAndNil(frmConfirmation);
  FreeAndNil(frmDrawSettings);
  FreeAndNil(frmMoveSettings);
  FreeAndNil(frmElevateSettings);
  FreeAndNil(frmHueSettings);
  FreeAndNil(frmBoundaries);
  FreeAndNil(frmFilter);
  FreeAndNil(frmVirtualLayer);
  FreeAndNil(frmAbout);
  FreeAndNil(frmRegionControl);
  FreeAndNil(frmLargeScaleCommand);
  FreeAndNil(frmRadarMap);
  FreeAndNil(frmLightlevel);
  FreeAndNil(frmChangePassword);

  if frmMain <> nil then
  begin
    frmMain.ApplicationProperties1.OnIdle := nil;
    FreeAndNil(frmMain);
  end;

  FreeAndNil(GameResourceManager);

  frmInitialize.Hide;
  while frmLogin.ShowModal = mrOK do
  begin
    if TCPClient.Connect(frmLogin.edHost.Text, frmLogin.edPort.Value) then
    begin
      FUsername := frmLogin.edUsername.Text;
      FPassword := frmLogin.edPassword.Text;
      FDataDir := frmLogin.edData.Text;
      frmInitialize.lblStatus.Caption := 'Connecting';
      frmInitialize.Show;
      Break;
    end else
      MessageDlg('Error', 'Cannot connect to the specified server.', mtError, [mbOK], 0);
  end;
  frmLogin.Close;
  FreeAndNil(frmLogin);
end;

procedure TdmNetwork.Send(APacket: TPacket);
var
  source: TEnhancedMemoryStream;
begin
  if TCPClient.Connected then
  begin
    FSendQueue.Seek(0, soFromEnd);
    source := APacket.Stream;
    FSendQueue.CopyFrom(source, 0);
    OnCanSend(nil);
  end;
  APacket.Free;
end;

procedure TdmNetwork.Disconnect;
begin
  Send(TQuitPacket.Create);
end;

procedure TdmNetwork.CheckClose(ASender: TForm);
begin
  if ((frmLogin = nil) or (ASender = frmLogin)) and
     ((frmMain = nil) or (ASender = frmMain)) and
     ((frmInitialize = nil) or (not frmInitialize.Visible)) then
  begin
    Application.Terminate;
  end;
end;

initialization
  {$I UdmNetwork.lrs}

end.