#1 2020-03-09 13:19:44

sakura
Member
From: Germany
Registered: 2018-02-21
Posts: 239
Website

THttpApiWebSocketServer - Free does not return

Hi,

I have a THttpApiWebSocketServer, and when freeing it, at the end of the app, the call will not return. Worked last week Friday (I think) without a problem.

program Project3;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  SynCrtSock;

var
  WebSocketServer: THttpApiWebSocketServer;
begin
  try
    WebSocketServer := THttpApiWebSocketServer.Create(False);
    WebSocketServer.AddUrlWebSocket('A', '8081', False, '+', True);
    Writeln('Freeing');
    WebSocketServer.Free;
    Writeln('You''ll never see me :-(');
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;

  Writeln('Done');
  Readln;
end.

Gets stuck in function TThread.WaitFor: LongWord;

Regards,
Daniel

Offline

#2 2020-03-09 14:07:16

sakura
Member
From: Germany
Registered: 2018-02-21
Posts: 239
Website

Re: THttpApiWebSocketServer - Free does not return

P.S.: Delphi 10.3.3

Offline

#3 2020-03-09 15:50:27

mpv
Member
From: Ukraine
Registered: 2012-03-24
Posts: 1,571
Website

Re: THttpApiWebSocketServer - Free does not return

@sakura - as far as i know ab do not use THttpApiWebSocketServer. I contribute it to mORMot several years ago, but now I also do not use it (migrate all my projects to Linux/FPC). Can you try to debug a problem?

Offline

#4 2020-03-09 19:14:15

sakura
Member
From: Germany
Registered: 2018-02-21
Posts: 239
Website

Re: THttpApiWebSocketServer - Free does not return

In the end, it stops within the repeat loop:

function TThread.WaitFor: LongWord;
{$IF Defined(MSWINDOWS)}
var
  H: array[0..1] of THandle;
  WaitResult: Cardinal;
{$IF not Declared(System.Embedded)}
  Msg: TMsg;
{$ENDIF}
begin
  if FExternalThread then
    raise EThread.CreateRes(@SThreadExternalWait);
  H[0] := FHandle;
  if CurrentThread.ThreadID = MainThreadID then
  begin
{$IF not Declared(System.Embedded)}
    WaitResult := 0;
{$ENDIF}
    H[1] := SyncEvent;
    repeat
{$IF Defined(NEXTGEN) and Declared(System.Embedded)}
      WaitResult := WaitForMultipleObjects(2, @H, False, 1000);
{$ELSE}
      { This prevents a potential deadlock if the background thread
        does a SendMessage to the foreground thread }
      if WaitResult = WAIT_OBJECT_0 + 2 then
        PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE);
      WaitResult := MsgWaitForMultipleObjects(2, H, False, 1000, QS_SENDMESSAGE);
{$ENDIF}
      CheckThreadError(WaitResult <> WAIT_FAILED);
      if WaitResult = WAIT_OBJECT_0 + 1 then
        CheckSynchronize;
    until WaitResult = WAIT_OBJECT_0;
  end else WaitForSingleObject(H[0], INFINITE);
  CheckThreadError(GetExitCodeThread(H[0], Result));
end;

MsgWaitForMultipleObjects(2, H, False, 1000, QS_SENDMESSAGE); always returns 258...

Offline

#5 2020-03-11 10:14:04

ab
Administrator
From: France
Registered: 2010-06-21
Posts: 14,673
Website

Re: THttpApiWebSocketServer - Free does not return

What it weird is that it should happen with the previous code too, but less often due to some weird multi-thread magic.

Should be fixed by https://synopse.info/fossil/info/f640a7dc402c311c

Online

#6 2020-03-11 10:56:33

sakura
Member
From: Germany
Registered: 2018-02-21
Posts: 239
Website

Re: THttpApiWebSocketServer - Free does not return

I do hope we see each other at the EKON, I'll have a drink or two at the ready for you!

Offline

#7 2020-03-11 13:43:37

ab
Administrator
From: France
Registered: 2010-06-21
Posts: 14,673
Website

Re: THttpApiWebSocketServer - Free does not return

Prost! smile

Online

#8 2020-03-11 15:26:50

sakura
Member
From: Germany
Registered: 2018-02-21
Posts: 239
Website

Re: THttpApiWebSocketServer - Free does not return

Sadly, for me, still, it does not return from the Free call. MsgWaitForMultipleObjects still times out...

P.S.: I've tried it 10 times, only one it returned, all other times, it waited for (whatever)...

Last edited by sakura (2020-03-11 15:28:07)

Offline

#9 2020-03-11 15:33:28

sakura
Member
From: Germany
Registered: 2018-02-21
Posts: 239
Website

Re: THttpApiWebSocketServer - Free does not return

destructor THttpApiServer.Destroy;
{$ifdef LVCL}
var i: integer;
{$endif}
begin
  {$ifdef LVCL}
  Terminate; // for Execute to be notified about end of process
  {$endif}
  try
    if (fClones<>nil) and (Http.Module<>0) then // fClones=nil for clone threads

----------- fClones<>nil needed? removing that, it seems to work...

      DestroyMainThread;
    {$ifdef LVCL}
    for i := 1 to 500 do
      if fExecuteFinished then
        break else
        SleepHiRes(10);
    {$endif}
  finally
    inherited Destroy;
  end;
end;

See comment above. I have not seen - in my demo case - where fClones is accessed within DestroyMainThread, so, it being NIL wouldn't be a problem. But in other cases it might...

Last edited by sakura (2020-03-11 15:33:46)

Offline

#10 2020-03-11 15:49:16

ab
Administrator
From: France
Registered: 2010-06-21
Posts: 14,673
Website

Re: THttpApiWebSocketServer - Free does not return

You are right: the fix was not enough.
Please try https://synopse.info/fossil/info/b2c2d46be6 - which seems fine now in my tests.

The problem was when you had no cloned thread, i.e. ThreadPoolCount=1.

Online

#11 2020-03-11 17:35:41

sakura
Member
From: Germany
Registered: 2018-02-21
Posts: 239
Website

Re: THttpApiWebSocketServer - Free does not return

Thanks, first tests look very promising. Tried about 20 times, all worked just perfectly fine :-)

Offline

Board footer

Powered by FluxBB