unit uROSessions;

{----------------------------------------------------------------------------}
{ 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
  {$IFDEF VER140UP}Variants,{$ENDIF}
  Classes, SysUtils, SyncObjs, uROClientIntf,
  uROClient, uROClasses, uROTypes, Contnrs;

const DEFBUFFSIZE = 4096;

type { Misc }
     TROCustomSessionManager = class;

     PVariantItem = ^TVariantItem;
     TVariantItem = record
       Name : string;
       Value : Variant;
     end;

     { TROVariantList }
     TROVariantList = class(TStringList)
     private
       function GetValueNames(Index: integer): string;
       function GetValues(const aName: string): Variant;
       procedure SetValues(const aName: string; const Value: Variant);
       function GetItems(Index: integer): PVariantItem;
       procedure SetValueNames(Index: integer; const Value: string);

     protected
     public
       constructor Create;
       destructor Destroy; override;

       procedure Clear; override;
       procedure Add(const aName : string; const aValue : Variant); reintroduce;

       procedure Delete(const aName : string); reintroduce; overload;
       procedure Delete(Index : integer); reintroduce; overload; 

       property Values[const aName : string] : Variant read GetValues write SetValues; default;
       property ValueNames[Index : integer] : string read GetValueNames write SetValueNames;
       property Items[Index : integer] : PVariantItem read GetItems;
     end;

     { ToDo -cRO3: Add an *optional* Critical Section object to the session so the user
       can easily make Sessions threadsafe (for access to the SAME session by multiple
       threads/client-requests) if needed. This should remain turned off by default. }

     { TROSession }
     TROSession = class
     private
       fCreated: TDateTime;
       fLastAccessed: TDateTime;
       fSessionID: TGUID;
       fValues : TROVariantList;

     protected
       function GetCount: integer; virtual;
       function GetNames(Index: integer): string; virtual;
       function GetValues(const Name: string): Variant; virtual;
       procedure SetNames(Index: integer; const Value: string); virtual;
       procedure SetValues(const Name: string; const Value: Variant); virtual;

     public
       constructor Create(const aSessionID : TGUID); virtual;
       destructor Destroy; override;

       procedure LoadFromStream(aStream : TStream; OnlyValues : boolean = FALSE); virtual;
       procedure SaveToStream(aStream : TStream; OnlyValues : boolean = FALSE); virtual;

       procedure SaveStruct(aStruct : TROComplexType);

       property SessionID : TGUID read fSessionID;
       property Created : TDateTime read fCreated write fCreated;
       property LastAccessed : TDateTime read fLastAccessed write fLastAccessed;
       property Values[const Name : string] : Variant read GetValues write SetValues; default;
       property Names[Index : integer] : string read GetNames write SetNames;
       property Count : integer read GetCount;
     end;

     TROSessionClass = class of TROSession;

     { TROSessionList }
     TROSessionList = class
     private
       fList: TStringList;

       function GetCount: integer;
       function GetSessions(Index: integer): TROSession;

     protected
     public
       constructor Create;
       destructor Destroy; override;

       procedure Clear;

       procedure Add(aSession: TROSession); overload;
       function Add(aSessionId: TGUID): TROSession; overload;

       procedure Delete(aIndex: integer);

       function GetSessionIndex(aSessionId: TGUID): integer;
       function SessionById(aSessionId: TGUID): TROSession;

       property Sessions[Index: integer]: TROSession read GetSessions;
       property Count: integer read GetCount;
     end;

     { TROCustomSessionManager }
     TROMaxSessionsReachedEvent = procedure (var aFail: Boolean) of object;
     TSessionEvent = procedure(const aSession : TROSession) of object;
     TROSessionExceptionEvent = procedure (aSessionID : TGUID; anException: Exception; var aRetry: Boolean) of object;
     TDeleteSessionEvent = procedure(const aSessionID : TGUID; IsExpired : boolean) of object;
     TROCustomSessionCreationEvent = procedure (const aSessionID : TGUID; var Session : TROSession) of object;

     TROSessionsActions = (saAdd, saDelete, saTmpSessionDelete, saRelease, saRemoveActiveListener);

     IROSessionsChangesListener = interface ['{A964942D-699F-48FD-ADA5-1E4720E0150E}']
       procedure SessionsChangedNotification(const aSessionID : TGUID; aSessionAction: TROSessionsActions; Sender: TObject);
     end;

     IROSessionsChangesNotifier = interface ['{71F4384A-0F8A-4783-863B-D61A3BD85E12}']
       procedure RegisterSessionsChangesListener(aListener: IROSessionsChangesListener);
       procedure UnRegisterSessionsChangesListener(aListener: IROSessionsChangesListener);
     end;

     TROCustomSessionManager = class(TROComponent, IROSessionsChangesNotifier)
     private
       fMaxSessions: integer;
       fSessionDuration: integer;
       fCritical : TCriticalSection;
       fClearing : boolean;
       fOnSessionCreated: TSessionEvent;
       fTimer : TROThreadTimer;
       fSessionChangesListeners: TInterfaceList;
       FOnBeforeDeleteSession: TDeleteSessionEvent;
       fOnSessionDeleted: TDeleteSessionEvent;
       fOnCustomCreateSession: TROCustomSessionCreationEvent;
       fOnMaxSessionsReached: TROMaxSessionsReachedEvent;
       fSessionCheckInterval: Integer;
       fOnException: TROSessionExceptionEvent;
       fInDeleteSession: Boolean;
       procedure SetSessionCheckInterval(const Value: Integer);

     protected
       { IROSessionsChangesNotifier }

       procedure RegisterSessionsChangesListener(aListener: IROSessionsChangesListener); virtual;
       procedure UnRegisterSessionsChangesListener(aListener: IROSessionsChangesListener); virtual;

       procedure DoNotifySessionsChangesListener(const aSessionID : TGUID; aSessionAction: TROSessionsActions; Sender: TObject); virtual;

       function DoCreateSession(const aSessionID : TGUID) : TROSession; virtual;
       function DoCheckSessionIsExpired(aSession : TROSession) : boolean; virtual;

       procedure DoTimerTick(CurrentTickCount : cardinal); virtual;

       function DoFindSession(const aSessionID : TGUID; aUpdateTime: Boolean) : TROSession; virtual; abstract;
       procedure DoDeleteSession(const aSessionID : TGUID; IsExpired : boolean); virtual; abstract;
       procedure DoReleaseSession(aSession : TROSession; NewSession : boolean); virtual;
       procedure DoClearSessions(OnlyExpired : boolean); virtual; abstract;
       function DoGetSessionCount : integer; virtual; abstract;
       procedure DoGetAllSessions(Dest: TStringList); virtual;

       procedure Loaded; override;

       procedure KillTimer;

       property Clearing : boolean read fClearing;
       property SessionDuration : integer read fSessionDuration write fSessionDuration default 15;
       property SessionCheckInterval : Integer read fSessionCheckInterval write SetSessionCheckInterval default 15;
     public
       constructor Create(aOwner : TComponent); override;
       destructor Destroy; override;

       // Session management routines
       function CreateSession(const aSessionID : TGUID) : TROSession;
       function FindSession(const aSessionID : TGUID; aUpdateTime: Boolean = True) : TROSession;
       procedure DeleteSession(const aSessionID : TGUID; IsExpired : boolean);
       procedure DeleteTemporarySession(var Session : TROSession);
       procedure ReleaseSession(var aSession : TROSession; NewSession : boolean);
       procedure ClearSessions(OnlyExpired : boolean);
       function CheckSessionIsExpired(aSession : TROSession) : boolean;
       function GetSessionCount : integer;
       procedure GetAllSessions(Dest: TStringList);
       property Critical : TCriticalSection read fCritical;
     published
       property OnMaxSessionsReached: TROMaxSessionsReachedEvent read fOnMaxSessionsReached write fOnMaxSessionsReached;
       property MaxSessions : integer read fMaxSessions write fMaxSessions default -1;

       property OnCustomCreateSession : TROCustomSessionCreationEvent read fOnCustomCreateSession write fOnCustomCreateSession;
       property OnSessionCreated : TSessionEvent read fOnSessionCreated write fOnSessionCreated;
       property OnBeforeDeleteSession: TDeleteSessionEvent read FOnBeforeDeleteSession write FOnBeforeDeleteSession;
       property OnSessionDeleted : TDeleteSessionEvent read fOnSessionDeleted write fOnSessionDeleted;
       property OnException : TROSessionExceptionEvent read fOnException write fOnException;
     end;

     { TROEventSessionManager }
     TFindSessionEvent = procedure(const aSessionID : TGUID; out aSession: TROSession) of object;
     TReleaseSessionEvent = procedure(var aSession : TROSession; NewSession : boolean) of object;
     TClearSessionsEvent = procedure(SessionManager : TROCustomSessionManager; OnlyExpired : boolean) of object;
     TGetSessionCountEvent = function(SessionManager : TROCustomSessionManager) : integer of object;
     TGetAllSessionsEvent = procedure (SessionManager : TROCustomSessionManager; aDest: TStringList) of object;

     TROEventSessionManager = class(TROCustomSessionManager)
     private
       fOnFindSession: TFindSessionEvent;
       fOnDeleteSession: TDeleteSessionEvent;
       fOnReleaseSession: TReleaseSessionEvent;
       fOnClearSessions: TClearSessionsEvent;
       fOnGetSessionCount: TGetSessionCountEvent;
       fOnGetAllSessions: TGetAllSessionsEvent;

     protected
       function DoFindSession(const aSessionID : TGUID; aUpdateTime: Boolean) : TROSession; override;
       procedure DoDeleteSession(const aSessionID : TGUID; IsExpired : boolean); override;
       procedure DoReleaseSession(aSession : TROSession; NewSession : boolean); override;
       procedure DoClearSessions(OnlyExpired : boolean); override;
       function DoGetSessionCount : integer; override;
       procedure DoGetAllSessions(Dest: TStringList); override;

     public

     published
       property OnDeleteSession : TDeleteSessionEvent read fOnDeleteSession write fOnDeleteSession;
       property OnFindSession : TFindSessionEvent read fOnFindSession write fOnFindSession;
       property OnReleaseSession : TReleaseSessionEvent read fOnReleaseSession write fOnReleaseSession;
       property OnClearSessions : TClearSessionsEvent read fOnClearSessions write fOnClearSessions;
       property OnGetSessionCount : TGetSessionCountEvent read fOnGetSessionCount write fOnGetSessionCount;
       property OnGetAllSessions: TGetAllSessionsEvent read fOnGetAllSessions write fOnGetAllSessions;
       property SessionDuration;
       property SessionCheckInterval;
     end;

     { TROInMemorySessionManager }
     TROInMemorySessionManager = class(TROCustomSessionManager)
     private
       fSessionList : TStringList;

     protected
       function DoFindSession(const aSessionID : TGUID; aUpdateTime: Boolean) : TROSession; override;
       procedure DoDeleteSession(const aSessionID : TGUID; IsExpired : boolean); override;
       procedure DoClearSessions(OnlyExpired : boolean); override;
       procedure DoReleaseSession(aSession : TROSession; NewSession : boolean); override;
       function DoGetSessionCount : integer; override;
       procedure DoGetAllSessions(Dest: TStringList); override;

     public
       constructor Create(aOwner : TComponent); override;
       destructor Destroy; override;

     published
       property SessionDuration;
       property SessionCheckInterval;
     end;

implementation

uses
  uRORes, uROBinaryHelpers,
  {$IFDEF DELPHI5}
  Windows, ComObj; { for StringToGuid in Delphi 5 }
  {$ELSE}
  DateUtils;
  {$ENDIF DELPHI6UP}

{ TROVariantList }
constructor TROVariantList.Create;
begin
  inherited;

  Sorted := TRUE;
  Duplicates := dupError;
end;

destructor TROVariantList.Destroy;
begin
  Clear;

  inherited;
end;

procedure TROVariantList.Add(const aName: string; const aValue: Variant);
var 
  item : PVariantItem;
begin
  New(Item);
  try
    inherited AddObject(aName, TObject(item));

    item^.Name := aName;
    item^.Value := aValue;
  except
    Dispose(item);
    raise;
  end;
end;

procedure TROVariantList.Delete(const aName: string);
var 
  idx : integer;
begin
  idx := IndexOf(aName);
  if (idx>=0) then Delete(idx);
end;

function TROVariantList.GetItems(Index: integer): PVariantItem;
begin
  result := PVariantItem(inherited Objects[Index]);
end;

function TROVariantList.GetValueNames(Index: integer): string;
begin
  result := inherited Strings[Index]
end;

function TROVariantList.GetValues(const aName: string): Variant;
var 
  idx : integer;
begin
  idx := IndexOf(aName);
  if (idx>=0) then 
    result := PVariantItem(inherited Objects[idx])^.Value
  else 
    result := Null;
end;

procedure TROVariantList.SetValues(const aName: string;
  const Value: Variant);
var 
  idx : integer;
begin
  idx := IndexOf(aName);
  if (idx>=0) then 
    PVariantItem(inherited Objects[idx])^.Value := Value
  else 
    Add(aName, Value);
end;

procedure TROVariantList.Clear;
var 
  i : integer;
begin
  for i := 0 to (Count-1) do
    Dispose(PVariantItem(inherited Objects[i]));

  inherited Clear;
end;

procedure TROVariantList.Delete(Index: integer);
begin
  Dispose(PVariantItem(Objects[Index]));
  inherited Delete(Index);
end;

procedure TROVariantList.SetValueNames(Index: integer;
  const Value: string);
begin
  inherited Strings[Index] := Value
end;


{ TROSession }

constructor TROSession.Create(const aSessionID: TGUID);
begin
  inherited Create;

  fValues := TROVariantList.Create;
  fSessionID := aSessionID;
  fCreated := Now;
  fLastAccessed := Now;
end;

destructor TROSession.Destroy;
begin
  fValues.Free;
  inherited;
end;

function TROSession.GetCount: integer;
begin
  result := fValues.Count
end;

function TROSession.GetNames(Index: integer): string;
begin
  result := fValues.ValueNames[Index]
end;

function TROSession.GetValues(const Name: string): Variant;
begin
  result := fValues.Values[Name]
end;

procedure TROSession.SetNames(Index: integer; const Value: string);
begin
  fValues.ValueNames[Index] := Value
end;

procedure TROSession.SetValues(const Name: string; const Value: Variant);
begin
  fValues[Name] := Value
end;

procedure TROSession.LoadFromStream(aStream: TStream; OnlyValues : boolean = FALSE);
var 
  i : integer;
  nme : string;
  val : Variant;
begin
  fValues.Clear;

  Check((aStream=NIL), 'Invalid stream');
  if (aStream.Size=0) then 
    Exit 
  else 
    aStream.Position := 0;

  if not OnlyValues then begin
    fSessionID := StringToGUID(ReadVariantFromBinary(aStream));
    fCreated := ReadVariantFromBinary(aStream);
    fLastAccessed := ReadVariantFromBinary(aStream);
  end;

  val := ReadVariantFromBinary(aStream);

  for i := 0 to Integer(Val) -1 do begin
    nme := ReadVariantFromBinary(aStream);
    val := ReadVariantFromBinary(aStream);

    Values[nme] := val;
  end;
end;

procedure TROSession.SaveToStream(aStream: TStream; OnlyValues : boolean = FALSE);
var 
  i : integer;
begin
  Check(aStream=NIL, 'Invalid stream');

  aStream.Position := 0;

  if not OnlyValues then begin
    WriteVariantToBinary(GUIDToString(fSessionID), aStream);
    WriteVariantToBinary(fCreated ,aStream);
    WriteVariantToBinary(fLastAccessed ,aStream);
  end;

  WriteVariantToBinary(Count ,aStream);

  for i := 0 to (Count-1) do begin
    WriteVariantToBinary(fValues.ValueNames[i], aStream);
    WriteVariantToBinary(fValues.Items[i]^.Value, aStream);
  end;
end;

procedure TROSession.SaveStruct(aStruct: TROComplexType);
var 
  i : integer;
begin
  if aStruct=NIL then Exit;

  for i := 0 to (aStruct.FieldCount-1) do begin
    Values[aStruct.FieldName[i]] := aStruct.GetFieldValue(aStruct.FieldName[i]);
  end;
end;

{ TROCustomSessionManager }

constructor TROCustomSessionManager.Create(aOwner: TComponent);
begin
  inherited;

  fClearing := FALSE;
  fMaxSessions := -1;
  fCritical := TCriticalSection.Create;
  fSessionChangesListeners := TInterfaceList.Create;
  fSessionDuration := 15;
  fSessionCheckInterval := 15;
end;

destructor TROCustomSessionManager.Destroy;
begin
  // Doesn't clear any sessions here. If the session manager is an in-memory one that is done by the
  // in-memory session manager destroyer, if this is a DB or an event driver one it might be used in a cluster
  // so we cannot assume other servers don't need this info. It's user's responsibility to clear the expired
  // sessions. Worst case in a DB the sessions will be cleared the enxt time this server is started.
  
  KillTimer;
  fSessionChangesListeners.Clear;
  fSessionChangesListeners.Free;
  fCritical.Free;
  
  inherited;
end;

function TROCustomSessionManager.CheckSessionIsExpired(aSession: TROSession): boolean;
begin
  result := DoCheckSessionIsExpired(aSession)
end;

procedure TROCustomSessionManager.ClearSessions(OnlyExpired : boolean);
var
  lRetry: Boolean;
begin
  fCritical.Enter;
  try
    fClearing := TRUE;
    lRetry := True;
    while lRetry do begin
      lRetry := False;
      try
      DoClearSessions(OnlyExpired);
      except
        on e: Exception do begin
          if assigned(fOnException) then fOnException(EmptyGUID, e, lRetry);
          if not lRetry then raise;
        end;
      end;
    end;
  finally
    fClearing := FALSE;
    fCritical.Leave;
  end;
end;

function TROCustomSessionManager.CreateSession(const aSessionID: TGUID): TROSession;
var
  lRetry, lFail: Boolean;
begin
  if (GetSessionCount>=MaxSessions) and (MaxSessions>0) then begin
    lFail := true;
    if assigned(fOnMaxSessionsReached) then fOnMaxSessionsReached(lFail);
    if lFail then RaiseError(err_TooManySessions, [SessionDuration]);
  end;

  Result := nil;
  
  lRetry := True;
  while lRetry do begin
    lRetry := False;
    try
      result := DoCreateSession(aSessionID);
    except
      on e: Exception do begin
        if assigned(fOnException) then fOnException(aSessionID, e, lRetry);
        if not lRetry then raise;
      end;
    end;
  end;
  DoNotifySessionsChangesListener(aSessionID, saAdd, nil);

  if Assigned(fOnSessionCreated) then fOnSessionCreated(result);
end;

procedure TROCustomSessionManager.DeleteTemporarySession(var Session: TROSession);
var 
  id : TGUID;
begin
  fInDeleteSession:=True;
  try
    id := Session.SessionID;
    if Assigned(FOnBeforeDeleteSession) then FOnBeforeDeleteSession(id, FALSE);

    FreeAndNIL(Session);

    DoNotifySessionsChangesListener(id, saTmpSessionDelete, nil);

    if Assigned(fOnSessionDeleted) then fOnSessionDeleted(id, FALSE);
  finally
    fInDeleteSession:=False;
  end;
end;

procedure TROCustomSessionManager.DeleteSession(const aSessionID: TGUID; IsExpired : boolean);
var
  lRetry: Boolean;
begin
  fInDeleteSession:=True;
  try
    if Assigned(FOnBeforeDeleteSession) then FOnBeforeDeleteSession(aSessionID, IsExpired);
    if not Clearing then fCritical.Enter;
    try
      lRetry := True;
      while lRetry do begin
        lRetry := False;
        try
          DoDeleteSession(aSessionID, IsExpired);
        except
          on e: Exception do begin
            if assigned(fOnException) then fOnException(aSessionID, e, lRetry);
            if not lRetry then raise;
          end;
        end;
      end;

      DoNotifySessionsChangesListener(aSessionID, saDelete, nil);
      if Assigned(fOnSessionDeleted) then fOnSessionDeleted(aSessionID, IsExpired);
    finally
      if not Clearing then fCritical.Leave;
    end;
  finally
    fInDeleteSession:=False;
  end;
end;

function TROCustomSessionManager.DoCheckSessionIsExpired(aSession: TROSession): boolean;
var
  elapsed : integer;
begin
  elapsed := MinutesBetween(aSession.LastAccessed, Now);
  result := (SessionDuration>0) and (elapsed>=SessionDuration);
end;

function TROCustomSessionManager.DoCreateSession(
  const aSessionID: TGUID): TROSession;
begin
  result := NIL;
  if Assigned(fOnCustomCreateSession) then fOnCustomCreateSession(aSessionID, result);

  if (result=NIL) then result := TROSession.Create(aSessionID);
end;

function TROCustomSessionManager.GetSessionCount: integer;
var
  lRetry: Boolean;
begin
  lRetry := True;
  Result := 0;
  while lRetry do begin
    lRetry := False;
    try
      fCritical.Enter;
      try
        result := DoGetSessionCount;
      finally
        fCritical.Leave;
      end;
    except
      on e: Exception do begin
        if assigned(fOnException) then fOnException(EmptyGUID, e, lRetry);
        if not lRetry then raise;
      end;
    end;
  end;
end;

function TROCustomSessionManager.FindSession(
  const aSessionID: TGUID; aUpdateTime: Boolean): TROSession;
var
  lRetry: Boolean;
begin
  lRetry := True;
  Result := nil;
  while lRetry do begin
    lRetry := False;
    try
      fCritical.Enter;
      try
        result := DoFindSession(aSessionID, aUpdateTime);
      finally
        fCritical.Leave;
      end;
    except
      on e: Exception do begin
        if assigned(fOnException) then fOnException(aSessionID, e, lRetry);
        if not lRetry then raise;
      end;
    end;
  end;

  if not fInDeleteSession then
    if (result<>NIL) and CheckSessionIsExpired(result) then begin
      DeleteSession(aSessionID, TRUE);
      raise EROSessionExpired.Create('Session '+GUIDToString(aSessionID)+' is expired');
    end;
end;

procedure TROCustomSessionManager.ReleaseSession(var aSession: TROSession; NewSession : boolean);
var
  id: TGUID;
  lRetry: Boolean;
begin
  inherited;

  if (aSession=NIL) then Exit;

  fCritical.Enter;
  try
    id := aSession.SessionID;
    lRetry := True;
    while lRetry do begin
      lRetry := False;
      try
        DoReleaseSession(aSession, NewSession);
      except
        on e: Exception do begin
          if assigned(fOnException) then fOnException(aSession.SessionID, e, lRetry);
          if not lRetry then raise;
        end;
      end;
    end;
    aSession := nil;
  finally
    fCritical.Leave;
  end;
  DoNotifySessionsChangesListener(id, saRelease, nil);
end;

procedure TROCustomSessionManager.DoTimerTick(CurrentTickCount: cardinal);
begin
  ClearSessions(TRUE); // Clears expired sessions
end;

procedure TROCustomSessionManager.KillTimer;
begin
  if not (csDesigning in ComponentState) then begin
    while Clearing do Sleep(100); // If it's clearing sessions we don't want to interfere
    fTimer.Free;
    fTimer := nil;
  end;
end;

procedure TROCustomSessionManager.DoReleaseSession(aSession: TROSession; NewSession : boolean);
begin
  if (aSession<>NIL) then aSession.LastAccessed := Now;
end;

procedure TROCustomSessionManager.Loaded;
begin
  inherited;
  SessionCheckInterval := fSessionCheckInterval;
end;

procedure TROCustomSessionManager.RegisterSessionsChangesListener(
  aListener: IROSessionsChangesListener);
begin
  if fSessionChangesListeners.IndexOf(aListener) = -1 then fSessionChangesListeners.Add(aListener);
end;

procedure TROCustomSessionManager.UnRegisterSessionsChangesListener(
  aListener: IROSessionsChangesListener);
var
  lIndex: Integer;
begin
  lIndex := fSessionChangesListeners.IndexOf(aListener);
  if lIndex <> -1 then fSessionChangesListeners.Delete(lIndex);
end;

procedure TROCustomSessionManager.DoNotifySessionsChangesListener(const aSessionID : TGUID; aSessionAction: TROSessionsActions; Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to fSessionChangesListeners.Count - 1 do begin
    IROSessionsChangesListener(pointer(fSessionChangesListeners[i])).SessionsChangedNotification(aSessionID, aSessionAction, Sender);
  end;
end;

procedure TROCustomSessionManager.GetAllSessions(Dest: TStringList);
begin
  fCritical.Enter;
  try
    DoGetAllSessions(Dest);
  finally
    fCritical.Leave;
  end;
end;

procedure TROCustomSessionManager.DoGetAllSessions(Dest: TStringList);
begin
  // do nothing
end;

procedure TROCustomSessionManager.SetSessionCheckInterval(
  const Value: Integer);
begin
  if not ((csDesigning in ComponentState) or (csLoading in ComponentState)) then begin
    fTimer.Free;
    fTimer := nil;

    if (Value>0) then fTimer := TROThreadTimer.Create(DoTimerTick, Value*60000);
  end;
  fSessionCheckInterval := Value;
end;

{ TROEventSessionManager }
procedure TROEventSessionManager.DoClearSessions;
begin
  if Assigned(fOnClearSessions) then fOnClearSessions(Self, OnlyExpired);
end;

procedure TROEventSessionManager.DoDeleteSession(const aSessionID: TGUID; IsExpired : boolean);
begin
  if Assigned(fOnDeleteSession) then fOnDeleteSession(aSessionID, IsExpired);
end;

function TROEventSessionManager.DoGetSessionCount: integer;
begin
  result := 0;
  if Assigned(fOnGetSessionCount) then result := fOnGetSessionCount(Self);
end;

function TROEventSessionManager.DoFindSession(const aSessionID: TGUID; aUpdateTime: Boolean): TROSession;
begin
  result := nil;
  if Assigned(fOnFindSession) then fOnFindSession(aSessionID, result);
  if (result <> nil) and (aUpdateTime) then result.LastAccessed := Now;
end;

procedure TROEventSessionManager.DoReleaseSession(aSession: TROSession; NewSession : boolean);
begin
  inherited;
  
  if Assigned(fOnReleaseSession) then fOnReleaseSession(aSession, NewSession);
end;

procedure TROEventSessionManager.DoGetAllSessions(Dest: TStringList);
begin
  if assigned(fOnGetAllSessions) then fOnGetAllSessions(Self, Dest);
end;

{ TROInMemorySessionManager }

constructor TROInMemorySessionManager.Create(aOwner: TComponent);
begin
  inherited;

  fSessionList := TStringList.Create;
  fSessionList.Duplicates := dupError;
  fSessionList.Sorted := TRUE;
end;

destructor TROInMemorySessionManager.Destroy;
begin
  KillTimer;

  // Clears all the sessions. This cannot be clustered so there's no point in keeping session info
  ClearSessions(FALSE);

  fSessionList.Free;

  inherited;
end;

procedure TROInMemorySessionManager.DoClearSessions(OnlyExpired: boolean);
var
  i : integer;
  lSessionID: TGUID;
begin
  if OnlyExpired then begin
    for i := (fSessionList.Count-1) downto 0 do
      if CheckSessionIsExpired(TROSession(fSessionList.Objects[i])) then begin
        lSessionID := TROSession(fSessionList.Objects[i]).SessionID;
        DeleteSession(lSessionID, TRUE);
      end;
  end
  else begin
    for i := (fSessionList.Count-1) downto 0 do begin
      lSessionID := TROSession(fSessionList.Objects[i]).SessionID;
      DeleteSession(lSessionID, FALSE);
    end;
  end;
end;

procedure TROInMemorySessionManager.DoDeleteSession(
  const aSessionID: TGUID; IsExpired : boolean);
var idx : integer;
begin
  idx := fSessionList.IndexOf(GUIDToString(aSessionID));

  if (idx>=0) then begin
    fSessionList.Objects[idx].Free;
    fSessionList.Delete(idx);
  end;
end;

function TROInMemorySessionManager.DoGetSessionCount: integer;
begin
  result := fSessionList.Count
end;

function TROInMemorySessionManager.DoFindSession(const aSessionID: TGUID; aUpdateTime: Boolean): TROSession;
var idx : integer;
begin
  result := nil;
  idx := fSessionList.IndexOf(GUIDToString(aSessionID));
  if (idx>=0) then result := TROSession(fSessionList.Objects[idx]);
  if (result <> nil) and (aUpdateTime) then result.LastAccessed := Now;
end;

procedure TROInMemorySessionManager.DoReleaseSession(aSession: TROSession; NewSession : boolean);
var id : string;
begin
  inherited;

  if NewSession then begin
    id := GUIDToString(aSession.SessionID);
    if fSessionList.IndexOf(id) = -1 then
      fSessionList.AddObject(id, aSession)
    else
      aSession.Free;
  end;
end;

procedure TROInMemorySessionManager.DoGetAllSessions(Dest: TstringList);
var
  i: Integer;
  currSession: TROSession;
begin
  for i := 0 to (fSessionList.Count-1) do begin
    currSession := TROSession(fSessionList.Objects[i]);
    if CheckSessionIsExpired(currSession) then Continue;
    Dest.Add(GUIDToString(currSession.SessionID));
  end;
end;

{ TROSessionList }
constructor TROSessionList.Create;
begin
  inherited;

  fList := TStringList.Create;
  fList.Duplicates := dupError;
  fList.Sorted := true;
end;


destructor TROSessionList.Destroy;
begin
  Clear;
  FreeAndNIL(fList);
  inherited;
end;

procedure TROSessionList.Add(aSession: TROSession);
begin
  fList.AddObject(GUIDToString(aSession.SessionID), aSession);
end;

procedure TROSessionList.Clear;
var
  i: integer;
begin
  for i := (fList.Count-1) downto 0 do
    Delete(i);
end;

procedure TROSessionList.Delete(aIndex: integer);
begin
  fList.Objects[aIndex].Free;
  fList.Delete(aIndex);
end;

function TROSessionList.GetCount: integer;
begin
  result := fList.Count;
end;

function TROSessionList.GetSessionIndex(aSessionId: TGUID): integer;
begin
  result := fList.IndexOf(GUIDToString(aSessionId))
end;

function TROSessionList.GetSessions(Index: integer): TROSession;
begin
  result := TROSession(fList.Objects[Index]);
end;

function TROSessionList.SessionById(aSessionId: TGUID): TROSession;
var
  idx: integer;
begin
  idx := GetSessionIndex(aSessionId);
  result := Sessions[idx];
end;

function TROSessionList.Add(aSessionId: TGUID): TROSession;
begin
  result := TROSession.Create(aSessionId);
  try
    Add(result);
  except
    result.Free;
    raise;
  end;
end;

initialization
  RegisterExceptionClass(EROSessionNotFound);
finalization
  UnregisterExceptionClass(EROSessionNotFound);
end.