Recent

Author Topic: TDaemon hangs on OnExecute, bug? (Windows 64bit)  (Read 3456 times)

MaartenJB

  • Full Member
  • ***
  • Posts: 112
TDaemon hangs on OnExecute, bug? (Windows 64bit)
« on: January 06, 2022, 11:54:33 am »
Hi,

I have a problem with TDaemon, when OnExecute is assigned, you can start de service, but when you try to stop it, windows says it can't stop it.

Reproduce:

1) Open example: ...\lazarus\fpc\3.2.0\source\packages\fcl-extra\examples\double\double.pp
2) Let Lazarus create a new "Daemon (service) application" for it
3) Compile
4) Install the service: double.exe --install
5) Start the "TDaemon1" Service
6) Stop the "TDaemon1" Service
    Now Windows say it can't stop the service, and you have to kill it via the taskmanager.
7) Uninstall the service: double.exe --uninstall

This doesn't happen when OnExecute is not assigned.

Best regards,

Maarten

Lazarus 2.0.12 r64642 FPC 3.2.2 x86_64-win64-win32/win64
« Last Edit: January 06, 2022, 12:06:43 pm by MaartenJB »

balazsszekely

  • Guest
Re: TDaemon hangs on OnExecute, bug? (Windows 64bit)
« Reply #1 on: January 06, 2022, 12:37:53 pm »
@MaartenJB
Spawn a worker thread when the service is starting. For more details please check the attachment from the following post:
https://forum.lazarus.freepascal.org/index.php/topic,57390.msg426821.html#msg426821


Edit: I attached a simplified version of the project. You can do some task(s) on the execute event of the worker thread.
« Last Edit: January 06, 2022, 12:45:33 pm by GetMem »

MaartenJB

  • Full Member
  • ***
  • Posts: 112
Re: TDaemon hangs on OnExecute, bug? (Windows 64bit)
« Reply #2 on: January 06, 2022, 01:08:23 pm »
@GetMem, Thanks for your reply.

But it should not be necessary to create these threads yourself as it should be handled by: TCustomDaemonApplication as stated in the documentation:

(See Description)
https://www.freepascal.org/docs-html/fcl/daemonapp/tdaemonthread.html

I know how to make a service work with a thread, and that way it causes no problems, but why do this yourself if there is a framework for it?

I'm not saying there is a bug, but if there is a bug in the framework, that should ideally be fixed right? For me the example shipped with Lazarus doesn't work properly.


« Last Edit: January 06, 2022, 01:33:02 pm by MaartenJB »

balazsszekely

  • Guest
Re: TDaemon hangs on OnExecute, bug? (Windows 64bit)
« Reply #3 on: January 06, 2022, 01:51:47 pm »
Quote
I know how to make a service work with a thread, and that way it causes no problems, but why do this yourself if there is a framework for it?
Because you have more fine control over it, but OK I got your point.

Quote
I'm not saying there is a bug, but if there is a bug in the framework, that should ideally be fixed right? For me the example shipped with Lazarus doesn't work properly.
If you overwrite the Execute method on your TCustomDaemon class, set the function result to false and the thread will just stop fine.
Code: Pascal  [Select][+][-]
  1. function TDaemon.Execute: Boolean;
  2. begin
  3.   //do something
  4.   Result := False; //add this line
  5. end;
  6.  

MaartenJB

  • Full Member
  • ***
  • Posts: 112
Re: TDaemon hangs on OnExecute, bug? (Windows 64bit)
« Reply #4 on: January 06, 2022, 02:38:50 pm »
@GetMem, thanks.

I managed to find a solution to my problem with the demo:

Code: Pascal  [Select][+][-]
  1. // ...\lazarus\fpc\3.2.0\source\packages\fcl-extra\examples\double\daemonunit1.pas
  2.  
  3. procedure TDaemon1.DataModuleExecute(Sender: TCustomDaemon);
  4. Var
  5.   I : Integer;
  6. begin
  7.   I := 0;
  8.   Application.EventLog.Log('TDaemon1 execution start');
  9.   While Self.Status = csRunning Do Begin
  10.     Sleep(10);
  11.     Sender.CheckControlMessages(False);  // <-- This will make the status update and exit appropriate
  12.   end;
  13.   Application.EventLog.Log('TDaemon1 execution stop');
  14. end;    
  15.  

I'm not sure if this is the correct way, maybe someone with a bit more knowledge than me can verify this "fix".


MaartenJB

  • Full Member
  • ***
  • Posts: 112
Re: TDaemon hangs on OnExecute, bug? (Windows 64bit)
« Reply #5 on: January 07, 2022, 08:56:44 am »
Because you have more fine control over it, but OK I got your point.

Yes I agree, this one is probably the way to go ...\lazarus\fpc\3.2.0\source\packages\fcl-extra\examples\daemon.pp

I was looking at the file dates of the examples, and the double one seems way more recent, and wanted to give that a go.


RandomPascal

  • Newbie
  • Posts: 1
Re: TDaemon hangs on OnExecute, bug? (Windows 64bit)
« Reply #6 on: January 13, 2022, 10:32:43 am »
I will share my fresh experience with creating a Windows service:
  • Do no use LazDaemon package, use daemon.pp from fcl-extra as a starting point.
  • Override DoTerminate() of your thread doing the work, to make thread's OnTerminate() execute. Otherwise OnTerminate never executes.
  • Do not use sleep(), use RTLeventWaitFor(FThreadRTLEvent, WaitMiliseconds) instead. This will not (kind of) "freeze"  Windows.

Problem not solved yet: After stopping the service, exe stays in memory, I have to kill it/restart Windows
UPDATE: It looks like Application.Terminate at the end of BOTH TdaMyDaemon.Stop and TdaMyDaemon.Shutdown solves problem of the executable in the memory after stopping the service.


Thread example:
Code: Pascal  [Select][+][-]
  1. implementation
  2.  
  3.  { TMyThread }
  4.  
  5. constructor TMyThread.Create(AConfigFile: String; ALog: TEventLog; ATerminate : TNotifyEvent);
  6. begin
  7.   FConfigFile:=AConfigFile;
  8.   FLog:=Alog;
  9.   OnTerminate:=ATerminate;
  10.   FreeOnTerminate:=false;
  11.   FThreadRTLEvent := RTLEventCreate;
  12.   Inherited Create(True);
  13. end;
  14.  
  15. destructor TMyThread.Destroy;
  16. begin
  17.   RTLeventDestroy(FThreadRTLEvent);
  18.   inherited Destroy;
  19. end;
  20.  
  21. procedure TMyThread.DoLog(EventType: TEventType; Msg : String);
  22. begin
  23.   If Assigned(FLog) then
  24.     FLog.Log(EventType, Msg);
  25. end;
  26.  
  27. procedure TMyThread.DoTerminate;
  28. begin
  29.   //inherited DoTerminate; we do not need to call inherited in service?
  30.   if (FDebug) then begin
  31.     DoLog(etDebug,'TMyThread.DoTerminate');
  32.   end;
  33.   if Assigned(OnTerminate) then begin
  34.     OnTerminate(Self);
  35.   end;
  36. end;
  37.  
  38. procedure TMyThread.Execute;
  39. Var
  40.   T : TDateTime;
  41. begin
  42.   try
  43.   T:=Now;
  44.    Repeat
  45.     T:=Now+EncodeTime(0,FSyncEveryMins,0,0);
  46.     Repeat
  47.       If Not Terminated then
  48.          RTLeventWaitFor(FThreadRTLEvent, 200);
  49.     Until (Now>=T) or Terminated;
  50.     If Not Terminated then
  51.        DoWork;//Do actual work here
  52.   Until Terminated;
  53.   if (FDebug) then
  54.     DoLog(etDebug,'TMyThread.Terminated OnTerminate '+BoolToStr(Assigned(Self.OnTerminate),true));
  55.   except
  56.    On E : Exception do
  57.      DoLog(etError,'TMyThread.Execute err: '+E.Message);
  58.   end;
  59.  
  60. end;
  61.  
  62. end.
  63.  
  64.  

Daemon application:

Code: Pascal  [Select][+][-]
  1. Program SomeDaemon;  
  2. {...}
  3. TdaMyDaemon = Class(TCustomDaemon)
  4.   Private
  5.     MyThread : TMyThread;
  6.     FLog : TEventLog;
  7.     procedure StartLog;
  8.     Procedure ThreadStopped (Sender : TObject);
  9.   public
  10.    FTermRTLEvent: PRTLEvent;
  11.    function LoadSettings: boolean;
  12.     constructor Create(AOwner: TComponent);override;
  13.     destructor Destroy;override;
  14.     Function Start : Boolean; override;
  15.     Function Stop : Boolean; override;
  16.     Function ShutDown : Boolean; override;
  17.     Function Install : Boolean; override;
  18.     Function UnInstall: boolean; override;
  19.   end;
  20.  
  21. constructor TdaMyDaemon.Create(AOwner: TComponent);
  22.   begin
  23.     FMyThread:=nil;
  24.     inherited.Create(AOwner);
  25.     FTermRTLEvent := RTLEventCreate;
  26.   end;
  27.  
  28. destructor TdaMyDaemon.Destroy;
  29. begin
  30.    RTLeventDestroy(FTermRTLEvent);
  31.    inherited Destroy;
  32. end;
  33.  
  34. function TdaMyDaemon.Start: Boolean;
  35.   var
  36.     OK: boolean;
  37.   begin
  38.     Result:=inherited Start;
  39.     StartLog;
  40.     OK:=LoadSettings;
  41.     If OK then begin
  42.       if not (Assigned(FMyThread)) then begin
  43.         FMyThread:=TMyThread.Create(FConfigFile,FLog,@ThreadStopped);
  44.         if Assigned(FMyThread.FatalException) then
  45.             raise FMyThread.FatalException;
  46.       end;
  47.       FMyThread.Start;
  48.     end else begin
  49.       Application.Log(etError,'cannot create MyThread, check settings');
  50.     end;
  51.     Result:=OK;
  52. end;
  53.  
  54. function TdaMyDaemon.Stop: Boolean;
  55. var
  56.   OK: boolean;
  57.   I: integer;
  58. begin
  59.   Result:=inherited Stop;
  60.   Application.Log(etDebug,' TdaMyDaemon.Stop: Assigned(FMyThread)='+BoolToStr(Assigned(FMyThread),true));
  61.   If (Assigned(FMyThread)) then
  62.     begin
  63.       Application.Log(etDebug,' TdaMyDaemon.Stop: Assigned(FMyThread.OnTerminate)='+BoolToStr(Assigned(FMyThread.OnTerminate),true));
  64.       FMyThread.Terminate;
  65.     I:=0;
  66.     // Wait at most 10 seconds.
  67.     While (FMyThread<>Nil) and (I<10000) do
  68.       begin
  69.       //Sleep(100);  //causes temporary hang?
  70.       RTLeventWaitFor(FTermRTLEvent, 100);
  71.       inc(i);
  72.       ReportStatus;
  73.       end;
  74.     // Let the thread die silently. Not sure about this.
  75.     {
  76.     If (FMyThread<>Nil) then
  77.       FMyThread.OnTerminate:=Nil;
  78.       }
  79.     end;
  80.   OK:=FMyThread=Nil;
  81.   Application.Log(etInfo,'DaemonStop: OK='+BoolToStr(OK,true));
  82.   Application.Terminate;//Not sure about this. I hoped this solves: exe stays is memory after stopping the service.
  83. end;
  84.  
  85. procedure TdaMyDaemon.ThreadStopped(Sender: TObject);
  86. begin
  87.   Application.Log(etInfo, 'Thread Stopped');
  88.   if (Assigned(FMyThread)) then
  89.     begin
  90.       FreeAndNil(FMyThread);
  91.       Application.Log(etDebug, 'Thread freed');
  92.     end;
  93. end;
  94.  
  95.  
« Last Edit: January 13, 2022, 11:08:52 am by RandomPascal »

 

TinyPortal © 2005-2018