unit uRORemoteDataModule;

{----------------------------------------------------------------------------}
{ RemObjects SDK Library - Core Library                                      }
{                                                                            }
{ compiler: Delphi 5 and up, Kylix 2 and up                                  }
{ platform: Win32, Linux                                                     }
{                                                                            }
{ (c)opyright RemObjects Software. all rights reserved.                      }
{                                                                            }
{ Using this code requires a valid license of the RemObjects SDK             }
{ which can be obtained at http://www.remobjects.com.                        }
{----------------------------------------------------------------------------}

{$I RemObjects.inc}

interface

uses
  Classes,
  {$IFDEF MSWINDOWS}Windows,{$ENDIF}
  {$IFDEF DELPHI5}Forms,{$ENDIF}
//  {$IFDEF FPC}Forms,{$ENDIF}
  uROServerIntf, uROClientIntf, uROSessions, uROClasses, uROTypes, uROEventRepository, uROClient;

type { Events }
     TActivateEvent = procedure(const aClientID : TGUID; aSession : TROSession; const aMessage : IROMessage) of object;
     TDeactivateEvent = procedure(const aClientID : TGUID; aSession : TROSession) of object;
     TGetDispatchInfoEvent = procedure(const aTransport : IROTransport; const aMessage : IROMessage) of object;
     TValidateRolesEvent = procedure(aRoles: array of string; var aAllow: Boolean) of object;
     TRegisterEventClientEvent = procedure(const aClientID : TGUID; const EventTypes : Ansistring) of object;

     { TRORemoteDataModule }
     TRORemoteDataModule = class(TDataModule, IROObjectActivation, IRODispatchNotifier, IROServerEventsBroker, IInterface, IROObjectRetainer, IRORolesAwareService)
     private
       fRefCount : integer;
       fClientID: TGUID;
       fOnActivate: TActivateEvent;
       fOnDeactivate: TDeactivateEvent;
       fSessionManager : TROCustomSessionManager;
       fSession: TROSession;
       fNewSession,
       fRequiresSession,
       fDestroySession : boolean;
       fOnGetDispatchInfo: TGetDispatchInfoEvent;
       fEventRepository: TROEventRepository;
       fOnBeforeUnregisterEventClient: TRegisterEventClientEvent;
       fOnBeforeRegisterEventClient: TRegisterEventClientEvent;
       fOnValidateRoles: TValidateRolesEvent;
       fTransport: IROTransport;

       fRetainedObjects : TList;

       procedure SetSessionManager(const Value: TROCustomSessionManager);
       procedure SetEventRepository(const Value: TROEventRepository);
       function GetSession: TROSession;
       function GetEventRepository: TROEventRepository;

     protected
       { IInterface }
       function QueryInterface(const IID: TGUID; out Obj): HResult; reintroduce; virtual; stdcall;
       function _AddRef: Integer; virtual; stdcall;
       function _Release: Integer; virtual; stdcall;

       { IRODispatchNotifier }
       procedure GetDispatchInfo(const aTransport : IROTransport; const aMessage : IROMessage); virtual;

       { IROObjectActivation }
       procedure _OnActivate(aClientID: TGUID; const aMessage : IROMessage);
       procedure _OnDeactivate(aClientID: TGUID);
       procedure IROObjectActivation.OnActivate = _OnActivate;
       procedure IROObjectActivation.OnDeactivate = _OnDeactivate;

       { IROServerEventsBroker }
       procedure RegisterEventClient(const ClientID, EventTypes : Ansistring);
       procedure UnregisterEventClient(const ClientID, EventTypes : Ansistring);
       function GetEventsData(const ClientID : Ansistring; out EventsData : Binary) : integer;

       { IROObjectRetainer  }
       procedure RetainObject(const anObject : TObject);
       function IsRetained(const anObject : TObject) : boolean;
       procedure ReleaseObject(const anObject: TObject);

       { IRORolesAwareService }
       procedure ServiceValidateRoles(aRequiredRoles: array of String);

       { Internal }
       procedure DoOnActivate(aClientID: TGUID; const aMessage : IROMessage); virtual;
       procedure DoOnDeactivate(aClientID: TGUID); virtual;
       procedure Notification(AComponent: TComponent; Operation: TOperation); override;
       function CustomRequireSession(const aMessage : IROMessage) : boolean; virtual;


      {$IFDEF DELPHI7UP}
      procedure Synchronize(aMethod: TThreadMethod);
      {$ENDIF DELPHI7UP}
     public
       constructor Create(aOwner : TComponent); override;
       destructor Destroy; override;
       procedure Assign(Source: TPersistent); override;
       procedure DestroySession;

       property RefCount : integer read fRefCount;
       property ClientID : TGUID read fClientID write fClientID;
       property Transport: IROTransport read fTransport;
       property Session : TROSession read GetSession;
       property NewSession : boolean read fNewSession;
     published
       property RequiresSession : boolean read fRequiresSession write fRequiresSession default FALSE;
       property SessionManager : TROCustomSessionManager read fSessionManager write SetSessionManager;
       property EventRepository : TROEventRepository read GetEventRepository write SetEventRepository;

       property OnActivate : TActivateEvent read fOnActivate write fOnActivate;
       property OnDeactivate : TDeactivateEvent read fOnDeactivate write fOnDeactivate;

       property OnBeforeRegisterEventClient : TRegisterEventClientEvent read fOnBeforeRegisterEventClient write fOnBeforeRegisterEventClient;
       property OnBeforeUnregisterEventClient : TRegisterEventClientEvent read fOnBeforeUnregisterEventClient write fOnBeforeUnregisterEventClient;

       property OnGetDispatchInfo : TGetDispatchInfoEvent read fOnGetDispatchInfo write fOnGetDispatchInfo;
       property OnValidateRoles: TValidateRolesEvent read fOnValidateRoles write fOnValidateRoles;
     end;

     TRORemoteDataModuleClass = class of TRORemoteDataModule;

implementation

uses
  SysUtils,
  {$IFDEF DELPHI5}ComObj,{$ENDIF DELPHI5}
  uRORes;

procedure TRORemoteDataModule.Assign(Source: TPersistent);
var
  lSource: TRORemoteDataModule;
begin
  inherited;
  if Source is TRORemoteDataModule then begin
    lSource := TRORemoteDataModule(Source);

    EventRepository := lSource.EventRepository;
    RequiresSession := lSource.RequiresSession;
    SessionManager := lSource.SessionManager;

    OnActivate := lSource.OnActivate;
    OnBeforeRegisterEventClient := lSource.OnBeforeRegisterEventClient;
    OnBeforeUnregisterEventClient := lSource.OnBeforeUnregisterEventClient;
    OnDeactivate := lSource.OnDeactivate;
    OnGetDispatchInfo := lSource.OnGetDispatchInfo;
    OnValidateRoles := lSource.OnValidateRoles;
  end;
end;

constructor TRORemoteDataModule.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
end;

destructor TRORemoteDataModule.Destroy;
begin
  SessionManager := nil;
  EventRepository := nil;
  FreeAndNIL(fRetainedObjects);
  inherited;
end;

function TRORemoteDataModule._AddRef: Integer;
begin
  if (csDesigning in ComponentState) then
    result := -1
  else
    result := InterlockedIncrement(fRefCount);
end;

function TRORemoteDataModule._Release: Integer;
begin
  if (csDesigning in ComponentState) then begin
    result := -1
  end
  else begin
    result := InterlockedDecrement(fRefCount);
    if (result=0)
      then Destroy;
  end;
end;

function TRORemoteDataModule.QueryInterface(const IID: TGUID;
  out Obj): HResult;
begin
  result := inherited QueryInterface(IID, Obj);
end;

procedure TRORemoteDataModule._OnActivate(aClientID: TGUID; const aMessage : IROMessage);
begin
  fClientID := aClientID;

  DoOnActivate(aClientID, aMessage); // Loads the session if a session manager is assigned

  if Assigned(fOnActivate)
    then fOnActivate(aClientID, fSession, aMessage);
end;

procedure TRORemoteDataModule._OnDeactivate(aClientID: TGUID);
begin
  if Assigned(fOnDeactivate)
    then fOnDeactivate(aClientID, fSession);

  DoOnDeactivate(aClientID); // Releases the session
end;

procedure TRORemoteDataModule.DoOnActivate(aClientID: TGUID; const aMessage : IROMessage);
begin
  if (csDesigning in ComponentState) then Exit;

  fSession := NIL;
  if not CustomRequireSession(aMessage) then Exit;

  if Assigned(fSessionManager) then begin
    fNewSession := FALSE;
    fDestroySession := FALSE; // Resets the flags

    fSession := fSessionManager.FindSession(aClientID);

    if (fSession=NIL) then begin

      if RequiresSession
        then RaiseError(err_SessionNotFound, [GUIDToString(aClientID)], EROSessionNotFound)
        else begin
         // fSession := fSessionManager.CreateSession(aClientID);
          fNewSession := TRUE;
        end;
    end;
  end
  else begin
    if RequiresSession then
      RaiseError('SessionManager required, but not assigned');
  end;
end;

procedure TRORemoteDataModule.DoOnDeactivate(aClientID: TGUID);
var
  lSessionID: TGUID;
begin
  if (csDesigning in ComponentState) then Exit;

  if Assigned(fSessionManager) and (fSession<>NIL) then begin

    if fDestroySession then begin
      if fNewSession then begin
        fSessionManager.DeleteTemporarySession(fSession)
      end
      else begin
        lSessionID := fSession.SessionID;
        fSessionManager.ReleaseSession(fSession, false);
        fSessionManager.DeleteSession(lSessionID, false);
        fSession := nil;
      end;
    end
    else begin
      fSessionManager.ReleaseSession(fSession, fNewSession);
    end;

  end;
  fTransport := nil;
end;

procedure TRORemoteDataModule.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;

  if (Operation=opRemove) then begin
    if (AComponent=fSessionManager) then SessionManager := NIL
    else if (AComponent=fEventRepository) then EventRepository := NIL;
  end;
end;

procedure TRORemoteDataModule.DestroySession;
begin
  fDestroySession := TRUE;
end;

procedure TRORemoteDataModule.GetDispatchInfo(const aTransport: IROTransport; const aMessage: IROMessage);
begin
  if Assigned(fOnGetDispatchInfo) then
    fOnGetDispatchInfo(aTransport, aMessage);
  fTransport := aTransport;
end;

function TRORemoteDataModule.CustomRequireSession(const aMessage: IROMessage): boolean;
begin
  result := not Assigned(aMessage) or not SameText(aMessage.MessageName, 'GetDescriptor');
end;

procedure TRORemoteDataModule.SetSessionManager(
  const Value: TROCustomSessionManager);
begin
  if (fSessionManager <> Value) then begin
    if (fSessionManager <> NIL) then fSessionManager.RORemoveFreeNotification(Self);
    fSessionManager := Value;
    if (fSessionManager<>NIL) then fSessionManager.ROFreeNotification(Self);
  end;
end;

{$IFDEF DELPHI7UP}
procedure TRORemoteDataModule.Synchronize(aMethod: TThreadMethod);
begin
  TThread.Synchronize(nil, aMethod);
end;
{$ENDIF DELPHI7UP}

function TRORemoteDataModule.GetEventsData(const ClientID: Ansistring; out EventsData: Binary): integer;
begin
  result := 0;
  if (fEventRepository=NIL) then Exit;

  EventsData := Binary.Create;
  result := EventRepository.GetEventData(Session.SessionID, EventsData);
end;

procedure TRORemoteDataModule.RegisterEventClient(const ClientID, EventTypes: Ansistring);
var
  lActive: IROActiveEventServer;
  lGuid: TGuid;
begin
  if Assigned(fOnBeforeRegisterEventClient) or Assigned(fEventRepository) then
    lGuid := StringToGUID({$IFDEF UNICODE}AnsiStringToWideString{$ENDIF}(ClientID));
  if Assigned(fOnBeforeRegisterEventClient) then
    fOnBeforeRegisterEventClient(lGuid, EventTypes);

  if assigned(fEventRepository) then begin
    if Supports(fTransport, IROActiveEventServer, lActive) then
      fEventRepository.AddSession(lGuid, lActive)
    else
      fEventRepository.AddSession(lGuid);
  end;
end;

procedure TRORemoteDataModule.UnregisterEventClient(const ClientID, EventTypes: Ansistring);
var
  lGuid: TGuid;
begin
  if Assigned(fOnBeforeUnregisterEventClient) or Assigned(fEventRepository) then
    lGuid := StringToGUID({$IFDEF UNICODE}AnsiStringToWideString{$ENDIF}(ClientID));
  if Assigned(fOnBeforeUnregisterEventClient) then
    fOnBeforeUnregisterEventClient(lGuid, EventTypes);

  if assigned(fEventRepository) then
    fEventRepository.RemoveSession(lGuid);
end;

procedure TRORemoteDataModule.SetEventRepository(const Value: TROEventRepository);
begin
  if (fEventRepository <>Value) then begin
    if (fEventRepository<>NIL) then fEventRepository.RORemoveFreeNotification(Self);
    fEventRepository := Value;
    if (fEventRepository<>NIL) then fEventRepository.ROFreeNotification(Self);
  end;
end;

function TRORemoteDataModule.GetSession: TROSession;
var errmsg : string;
begin
  if not (csDesigning in ComponentState) then begin
    if (fSession = nil) and (not RequiresSession) and (SessionManager<>NIL) then
       fSession:= fSessionManager.CreateSession(ClientID);
    if (fSession=NIL) then begin
      errmsg := 'The session has not been initialized.';
      if SessionManager=NIL then errmsg := errmsg+' '+Name+'''s SessionManager property is set to NIL.';
      raise EROException.Create(errmsg);
    end;
  end;

  result := fSession;
end;

function TRORemoteDataModule.GetEventRepository: TROEventRepository;
var errmsg : string;
begin
  if not (csDesigning in ComponentState) then begin
    if (fEventRepository=NIL) then begin
      errmsg := Name+'''s EventRepository property is not assigned';
      raise EROException.Create(errmsg);
    end;
  end;

  result := fEventRepository;
end;

function TRORemoteDataModule.IsRetained(const anObject: TObject): boolean;
begin
  result := (fRetainedObjects<>NIL) and (fRetainedObjects.IndexOf(anObject)>=0)
end;

procedure TRORemoteDataModule.RetainObject(const anObject: TObject);
begin
  // Only creates it if necessary
  if (fRetainedObjects=NIL) then
    fRetainedObjects := TList.Create;

  fRetainedObjects.Add(anObject);
end;

procedure TRORemoteDataModule.ReleaseObject(const anObject: TObject);
var idx : integer;
begin
  // Only creates it if necessary
  if (fRetainedObjects=NIL) then Exit;

  idx := fRetainedObjects.IndexOf(anObject);
  if (idx>=0) then fRetainedObjects.Delete(idx);
end;

procedure TRORemoteDataModule.ServiceValidateRoles(
  aRequiredRoles: array of String);
var
  i, j: Integer;
  lResult, lWant, lHave: Boolean;
  lRole: string;
  lRoles: TStringArray;
begin
  if Length(aRequiredRoles) = 0 then begin
    lRoles := nil;
    lResult := true;
  end else
  if fSession = nil then begin
    lRoles := nil;
    lResult := false;
  end else begin
    lRoles := fSession.Roles;
    lResult := true;
    for i := 0 to Length(aRequiredRoles) -1 do begin
      lRole := Trim(aRequiredRoles[i]);
      if lRole = '' then continue;
      if lRole[1] = '!' then begin
        lWant := false;
        delete(lRole, 1, 1);
        lRole := TrimLeft(lRole);
      end else lWant := true;
      lHave := false;
      for j := 0 to Length(lRoles) -1 do begin
        if SameText(lRoles[j], lRole) then begin
          lHave := true;
          break;
        end;
      end;
      if lHave <> lWant then begin lResult := false; break; end;
    end;
  end;

  if Assigned(fOnValidateRoles) then fOnValidateRoles(aRequiredRoles, lResult);
  if not lResult then raise SessionDoesNotHaveRequiredRolesException.Create(Err_SessionDoesNotHaveAllRequiredRoles);
end;

end.