unit ServerContainerUnit1;
interface
uses
  System.SysUtils, System.Classes,
  Datasnap.DSTCPServerTransport,
  Datasnap.DSHTTPCommon, Datasnap.DSHTTP,
  Datasnap.DSServer, Datasnap.DSCommonServer,
  Datasnap.DSAuth, IndyPeerImpl, DbxSocketChannelNative, DbxCompressionFilter,
  Data.DBXCommon, Data.DBCommonTypes;

type
  TServerContainer1 = class(TDataModule)
    DSServer1: TDSServer;
    DSTCPServerTransport1: TDSTCPServerTransport;
    DSHTTPService1: TDSHTTPService;
    DSAuthenticationManager1: TDSAuthenticationManager;
    DSServerClass1: TDSServerClass;
    procedure DSServerClass1GetClass(DSServerClass: TDSServerClass;
      var PersistentClass: TPersistentClass);
    procedure DSAuthenticationManager1UserAuthorize(Sender: TObject;
      EventObject: TDSAuthorizeEventObject; var valid: Boolean);
    procedure DSAuthenticationManager1UserAuthenticate(Sender: TObject;
      const Protocol, Context, User, Password: string; var valid: Boolean;
      UserRoles: TStrings);
    procedure DSServer1Connect(DSConnectEventObject: TDSConnectEventObject);
    function DSServer1Trace(TraceInfo: TDBXTraceInfo): CBRType;
    procedure DSHTTPService1Trace(Sender: TObject; AContext: TDSHTTPContext;
      ARequest: TDSHTTPRequest; AResponse: TDSHTTPResponse);
  private
    { Private declarations }
  public
  end;

var
  ServerContainer1: TServerContainer1;

implementation
uses
  Winapi.Windows, ServerMethodsUnit1,
  CodeSiteLogging;

{$R *.dfm}

procedure TServerContainer1.DSServer1Connect(
  DSConnectEventObject: TDSConnectEventObject);
var
  i: Integer;
begin
  CodeSite.EnterMethod('DSServer1.OnConnect');
  CodeSite.Send('ConnectProperties: ' +
    DSConnectEventObject.ConnectProperties.Properties.Text);

  if Assigned(DSConnectEventObject.ChannelInfo) then
  begin
    CodeSite.Send('ChannelInfo.Id: ' + IntToStr(DSConnectEventObject.ChannelInfo.Id));
    CodeSite.Send('ChannelInfo.Info: ' +  DSConnectEventObject.ChannelInfo.Info);
  end;

  if Assigned(DSConnectEventObject.Transport) then
  begin
    CodeSite.Send('Transport: ' + DSConnectEventObject.Transport.ToString);
    CodeSite.Send('Transport.BufferKBSize: ' +
      IntToStr(DSConnectEventObject.Transport.BufferKBSize));

    for i:=0 to DSConnectEventObject.Transport.Filters.Count-1 do
      CodeSite.Send('Transport.Filter: ' +
        DSConnectEventObject.Transport.Filters.GetFilter(i).Id);
  end;
  CodeSite.ExitMethod('DSServer1.OnConnect');
end;

function TServerContainer1.DSServer1Trace(TraceInfo: TDBXTraceInfo): CBRType;
begin
  CodeSite.EnterMethod('DSServer1.OnTrace');
  CodeSite.Send('Trace Category: ' + TraceInfo.CustomCategory);
  CodeSite.Send('Trace Message: ' + TraceInfo.Message);
  Result := cbrUSEDEF; // take default action
  CodeSite.ExitMethod('DSServer1.OnTrace');
end;

procedure TServerContainer1.DSServerClass1GetClass(
  DSServerClass: TDSServerClass; var PersistentClass: TPersistentClass);
begin
  PersistentClass := ServerMethodsUnit1.TMyServerMethods;
end;

procedure TServerContainer1.DSAuthenticationManager1UserAuthenticate(
  Sender: TObject; const Protocol, Context, User, Password: string;
  var valid: Boolean; UserRoles: TStrings);
begin
  { Validate the client user and password.
    If role-based authorization is needed, add role names to the UserRoles parameter  }
  CodeSite.EnterMethod('OnUserAuthenticate');
  try
    CodeSite.Send('User: ' + User);
    CodeSite.Send('Password: ' + Password);
    CodeSite.Send('Protocol: ' + Protocol);
    CodeSite.Send('Context: ' + Context);

    valid := True; // TODO: check for User and Password

    if LowerCase(User) = 'bob' then
      UserRoles.Add('admin')
    else UserRoles.Add('guest');

  except
    on E: Exception do
      CodeSite.SendException(E);
  end;
  CodeSite.ExitMethod('OnUserAuthenticate ' + BoolToStr(valid));
end;

procedure TServerContainer1.DSAuthenticationManager1UserAuthorize(
  Sender: TObject; EventObject: TDSAuthorizeEventObject;
  var valid: Boolean);
var
  UserRole: String;
begin
  CodeSite.EnterMethod('OnUserAuthorize');

  CodeSite.Send('UserName: ' + EventObject.UserName);
  CodeSite.Send('UserRoles: ' +  EventObject.UserRoles.Text);
  if Assigned(EventObject.DeniedRoles) then
    CodeSite.Send('DeniedRoles: ' + EventObject.DeniedRoles.Text);
  if Assigned(EventObject.AuthorizedRoles) then
    CodeSite.Send('AuthorizedRoles: ' +  EventObject.AuthorizedRoles.Text);

  { Authorize a user to execute a method.
    Use values from EventObject such as UserName, UserRoles, AuthorizedRoles and DeniedRoles.
    Use DSAuthenticationManager1.Roles to define Authorized and Denied roles
    for particular server methods. }
  valid := True;
  if Assigned(EventObject.DeniedRoles) then
    for UserRole in EventObject.UserRoles do
      if EventObject.DeniedRoles.IndexOf(UserRole) >= 0 then valid := False;

  CodeSite.ExitMethod('OnUserAuthorize ' + BoolToStr(valid));
end;


procedure TServerContainer1.DSHTTPService1Trace(Sender: TObject;
  AContext: TDSHTTPContext; ARequest: TDSHTTPRequest;
  AResponse: TDSHTTPResponse);
begin
  CodeSite.EnterMethod('DSHTTPService1Trace');
  CodeSite.Send(AContext.ToString);
  CodeSite.Send(ARequest.Document);
  CodeSite.Send(AResponse.ResponseText);
  CodeSite.ExitMethod('DSHTTPService1Trace');
end;

end.

