mORMot Open Source

StxLog

Member

From: France

Registered: 2015-09-14

Posts: 58

Services CallbackReleased

Hi,
I'm trying the websocket connection since a few days, and even if everything's working fine, i've bumped into one problem:

Here my interfaces

unit IMainServerCS;
interface
uses
  SysUtils, SynCommons, mORMot;

type
  IMainServCallback = interface(IInvokable)
    ['{7E7CA6D9-DA5A-4524-8257-41B14F2DBE8A}']
    procedure sendMsg(const ID: integer; const msg: string);
  end;

  IMainServService = interface(IServiceWithCallbackReleased)
    ['{397EBE90-AAA0-4ED2-BDEA-ED566585565A}']
    procedure Connect(const callback: IMainServCallback);
    function TotalConnected: Integer;
  end;

const
  TRANSMISSION_KEY = 'SECRET';

implementation

initialization
  TInterfaceFactory.RegisterInterfaces(
    [TypeInfo(IMainServService), TypeInfo(IMainServCallback)]);
end.

Here how i setup my server

type
  TMainServer = class(TInterfacedObject, IMainServService)
  protected
    fConnected: array of IMainServCallback;

    procedure SetLog;
    procedure SetConnection;
    procedure FreeAll;
  public
    fLog: TSynLog;
    fMODELBDD: TSQLModel;
    fBDD: TSQLDataBase;
    fRestServer: TSQLRestServerDB;
    fHTTPServer: TSQLHttpServer;
    fWebApp: TOtherWebApp;

    constructor Create;
    destructor Destroy; override;

    // INTERFACE SERVICE
    procedure Connect(const callback: IMainServCallback);
    procedure CallbackReleased(const callback: IInvokable; const interfaceName: RawUTF8);
    function TotalConnected: Integer;
  end;

implementation

{ TMainServeur }
constructor TMainServer.Create;
begin
  inherited;
  Self.SetLog;            //Init logs
  Self.SetConnection;   //Init connection
end;

destructor TMainServer.Destroy;
begin
  fLog.Enter(self, '::Destroy::');
  Self.FreeAll;
  inherited;
end;

procedure TMainServer.SetLog;
begin
  fLog := TSynLog.Add;
  with fLog.Family do begin
    {$IFDEF CONSOLE}
      EchoToConsole := LOG_VERBOSE;
    {$ENDIF}
    Level := LOG_VERBOSE;
    TSynLogTestLog := TSQLLog;
    RotateFileCount := 5;
    OnArchive := EventArchiveSynLZ;
    ArchiveAfterDays := 1;
    ArchivePath := ExeVersion.ProgramFilePath+'log\archive';
    PerThreadLog := ptIdentifiedInOnFile;
    DestinationPath := ExeVersion.ProgramFilePath+'log\';
    EndOfLineCRLF := true;
    AutoFlushTimeOut := 6;
  end;
  WebSocketLog := TSQLLog;
end;

procedure TMainServer.FreeAll;
begin
  fHTTPServer.Shutdown;
  if Assigned(fHTTPServer) then
    FreeAndNil(fHTTPServer);
  if Assigned(fWebApp) then
    FreeAndNil(fWebApp);
  if fRestServer <> nil then
    fRestServer := nil;
  if Assigned(fBDD) then
    FreeAndNil(fBDD);
  if Assigned(fMODELBDD) then
    FreeAndNil(fMODELBDD);
end;


procedure TMainServer.SetConnection;
begin
  fLog.Enter(self, ' - Init server...');

  fMODELBDD := TSQLModel.Create([TSQLUser, TSQLOther]);
  try
    fBDD := TSQLDataBase.Create(ExeVersion.ProgramFilePath+DB, '', SQLITE_OPEN_CREATE or SQLITE_OPEN_READWRITE);
    try
      fRestServer := TSQLRestServerDB.Create(fMODELBDD, fBDD, True);
      try
        fRestServer.AuthenticationUnregister(TSQLRestServerAuthenticationSSPI);
        fRestServer.CreateMissingTables(); 
        fRestServer.DB.LockingMode := lmExclusive;
        fRestServer.ServiceDefine(TMainServeur, [IMainServService], sicShared).
            SetOptions([],[optExecLockedPerInterface]);

        fWebApp := TOtherWebApp.Create;
        try
          fWebApp.parent := nil;
          fWebApp.Start(fRestServer);

          fHTTPServer := TSQLHttpServer.Create(AnsiString(PORT_CONNECT), [fRestServer], '+', useBidirSocket);
          try
            fHTTPServer.WebSocketsEnable(fRestServer, TRANSMISSION_KEY).
                Settings.SetFullLog;
            fHTTPServer.RootRedirectToURI('root/Default');
            fHTTPServer.AccessControlAllowOrigin := '*';
          except
            FreeAndNil(fHTTPServer);
          end;
        except
          FreeAndNil(fWebApp);
        end;
      except
        fRestServer := nil;
      end;
    except
      FreeAndNil(fBDD);
    end;
  except
    FreeAndNil(fMODELBDD);
  end;
end;



procedure TMainServer.Connect(const callback: IMainServCallback);
begin
  InterfaceArrayAdd(fConnected, callback);

  TSynLog.Add.Log(sllInfo, ' ++ Connect. '+IntToStr(self.TotalConnected+1)+' user(s).');
end;

procedure TMainServer.CallbackReleased(const callback: IInvokable; const interfaceName: RawUTF8);
begin
  if interfaceName='IMainServCallback' then begin
    InterfaceArrayDelete(fConnected, callback);
    TSynLog.Add.Log(sllInfo, ' -- Disconnect. Still '+IntToStr(self.TotalConnected+1)+' user(s).');
  end;
end;

function TMainServer.TotalConnected: Integer;
begin
  result := high(fConnected);
end;

end.

Then in another unit I have my callback implementation:

type
  TMainServCallback = class(TInterfacedCallback, IMainServCallback)
    protected
      procedure sendMsg(const ID: integer; const msg: string);
  end;

[...]

procedure TMainServCallback.sendMsg(const ID: integer; const msg: string);
begin
  //do something
end;
end.

And how I connect (in a DUnit procedure):

procedure TTestCaseConnection.TestConnection;
var
  FClient: TSQLHttpClientWebsockets;
  FService: IMainServService;
  FCallback: IMainServCallback;
begin
  FClient := TSQLHttpClientWebsockets.Create(AnsiString(SYN_ADRESSE), AnsiString(SYN_PORT), TSQLModel.Create([TSQLUser, TSQLOther]));
  try
    FClient.Model.Owner := FClient;
    FClient.WebSocketsUpgrade(TRANSMISSION_KEY);

    FClient.ServerTimeStampSynchronize;

    FClient.SetUser(SYN_USER_NAME, TSQLUser.ComputeHashedPassword(SYN_USER_PASS), true);

    //callback/service
    FClient.ServiceDefine([IMainServService], sicShared);
    FClient.Services.Resolve(IMainServService, FService);

    FCallback := TMainServCallback.Create(FClient, IMainServCallback);
    try
      FService.Connect(FCallback, 'XX');

      [.. do something .. ]

    finally
      FCallback := nil;
      FService := nil;
    end;
  finally
    FClient.SessionClose;
    FreeAndNil(FClient);
  end;
end;

My problem is:
When I connect, on the server console i can see the message '++connect...' but when i disconnect it doesnt call the CallbackReleased(..)
After a few try, I've noticed that if i do some step by step starting from "[.. do something .. ]" in the client, CallbackReleased() is called and the message '--disconnect' appear server side as i was expecting at the beginning.

It seems like the client is disconnecting too fast? But i'm no expert and can't really tell.

Server is in localhost, and when i compile and run Project31ChatServer/Client in same condition i dont have this issue.

Thanks all!

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,240

Website

Re: Services CallbackReleased

There is a weird "recursive" use of TMainServer.
TMainServer is hosting the service which is itself a TMainServer instance...
I do not understand how it may work...

StxLog

Member

From: France

Registered: 2015-09-14

Posts: 58

Re: Services CallbackReleased

Indeed, so i've extracted the service to do this:

  TMainServerService = class(TInterfacedObject, IMainServService)
  protected
    fConnected: array of IMainServCallback;
  public
    procedure Connect(const callback: IMainServCallback);
    procedure CallbackReleased(const callback: IInvokable; const interfaceName: RawUTF8);
    function TotalConnected: Integer;
  end;

  TMainServer = class(TObject)
  protected

    [ ... ]

Changed my service definition to this

fRestServer.ServiceDefine(TMainServerService, [IMainServService], sicShared).
            SetOptions([],[optExecLockedPerInterface]);

And I launch it like this

    try
      server := TMainServer.Create;
      WriteLn('-- running... Press key to leave');
      readln;
    finally
      server.Free;
      server := nil;
    end;

Is this good?
But I still have the same problem, i can see client connect, but not when they disconnect from the service. (nb: when they close their session i can see it in TSQLRestServerDB.OnSessionClosed)

Last edited by StxLog (2016-03-03 13:06:49)

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,240

Website

Re: Services CallbackReleased

It should.

Does

FCallback := nil;

release the callback as expected?
(use F7 in the IDE to step into this line, as see what it executes)

StxLog

Member

From: France

Registered: 2015-09-14

Posts: 58

Re: Services CallbackReleased

When I do F7 it does this

TInterfacedCallback.Destroy
TInterfacedCallback.CallbackRestUnregister
TServiceContainerClient.CallBackUnRegister
TSQLRestClientCallbacks.UnRegister
...

And then FCallback is = nil

But its really erratic, sometimes server side I can see the log 'disconnect' but almost never. Mostly I can see it when i'm doing some step to step, or if I put a sleep(100) after the FCallback := nil; but not necessary all the time

I'm sorry I can't give more precise info, i'm really not an expert in Delphi, but if you need something I'll do necessary

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,240

Website

Re: Services CallbackReleased

The server has to wait for the disconnection to be transmitted.
Perhaps your tests assume the callbacks have no delay, which is not the case.

StxLog

Member

From: France

Registered: 2015-09-14

Posts: 58

Re: Services CallbackReleased

ok I understand, thanks for your help and your time!