unit ServerContainerUnit1;
interface
uses
  System.SysUtils, System.Classes,
  Datasnap.DSServer, Datasnap.DSCommonServer,
  Datasnap.DSClientMetadata, Datasnap.DSHTTPServiceProxyDispatcher,
  Datasnap.DSProxyJavaAndroid, Datasnap.DSProxyJavaBlackBerry,
  Datasnap.DSProxyObjectiveCiOS, Datasnap.DSProxyCsharpSilverlight,
  Datasnap.DSProxyFreePascal_iOS,
  Datasnap.DSAuth,
  Data.DBXCommon, Data.DBCommonTypes;

type
  TServerContainer1 = class(TDataModule)
    DSServer1: TDSServer;
    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 DSServer1Disconnect(DSConnectEventObject: TDSConnectEventObject);
    procedure DSServer1Error(DSErrorEventObject: TDSErrorEventObject);
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

function DSServer: TDSServer;
function DSAuthenticationManager: TDSAuthenticationManager;

implementation
uses
  Winapi.Windows, ServerMethodsUnit1,
  CodeSiteLogging;

{$R *.dfm}

var
  FModule: TComponent;
  FDSServer: TDSServer;
  FDSAuthenticationManager: TDSAuthenticationManager;

function DSServer: TDSServer;
begin
  Result := FDSServer;
end;

function DSAuthenticationManager: TDSAuthenticationManager;
begin
  Result := FDSAuthenticationManager;
end;

constructor TServerContainer1.Create(AOwner: TComponent);
begin
  inherited;
  FDSServer := DSServer1;
  FDSAuthenticationManager := DSAuthenticationManager1;
end;

procedure TServerContainer1.DataModuleCreate(Sender: TObject);
begin
  CodeSite.Send('TServerContainer1.DataModuleCreate');
end;

procedure TServerContainer1.DataModuleDestroy(Sender: TObject);
begin
  CodeSite.Send('TServerContainer1.DataModuleDestroy');
end;

destructor TServerContainer1.Destroy;
begin
  inherited;
  FDSServer := nil;
  FDSAuthenticationManager := nil;
end;

procedure TServerContainer1.DSServer1Connect(
  DSConnectEventObject: TDSConnectEventObject);
var
  i: Integer;
begin
  CodeSite.EnterMethod('DSServer1.OnConnect');
  if Assigned(DSConnectEventObject.ConnectProperties) then
    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;

procedure TServerContainer1.DSServer1Disconnect(
  DSConnectEventObject: TDSConnectEventObject);
begin
  CodeSite.Send('DSServer1.OnDisconnect');
end;

procedure TServerContainer1.DSServer1Error(
  DSErrorEventObject: TDSErrorEventObject);
begin
  CodeSite.SendException(DSErrorEventObject.Error);
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
  CodeSite.EnterMethod('OnUserAuthenticate ' + User + #32 + Password + ' via ' + Protocol + #32 + Context);
  { Validate the client user and password.
    If role-based authorization is needed, add role names to the UserRoles parameter  }
//valid := LowerCase(Protocol) <> 'http'; // don't allow http

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

  CodeSite.ExitMethod('OnUserAuthenticate ' + BoolToStr(valid, True));
end;

procedure TServerContainer1.DSAuthenticationManager1UserAuthorize(
  Sender: TObject; EventObject: TDSAuthorizeEventObject;
  var valid: Boolean);
var
  UserRole: String;
begin
  CodeSite.EnterMethod('OnUserAuthorize');
  { 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. }
  CodeSite.Send('UserName: ' + EventObject.UserName);
  if Assigned(EventObject.UserRoles) then
    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);

  valid := True;
  if Assigned(EventObject.DeniedRoles) and Assigned(EventObject.UserRoles) then
    for UserRole in EventObject.UserRoles do
      if EventObject.DeniedRoles.IndexOf(UserRole) >= 0 then valid := False;

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


initialization
  FModule := TServerContainer1.Create(nil);
finalization
  FModule.Free;
end.

