TDaemon hangs on OnExecute, bug? (Windows 64bit)
lazarus / 67-Windows

----------------------------------------------------------------------
MaartenJB · 2022-01-06 10:54

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

----------------------------------------------------------------------
balazsszekely · 2022-01-06 11:37

@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.h
tml#msg426821


Edit: I attached a simplified version of the project. You can do some
task(s) on the execute event of the worker thread.

----------------------------------------------------------------------
MaartenJB · 2022-01-06 12:08

@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.

----------------------------------------------------------------------
balazsszekely · 2022-01-06 12:51

QuoteI 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.

QuoteI'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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i function
TDaemon.Execute: Boolean;begin  //do something  Result := False; //add
this lineend;

----------------------------------------------------------------------
MaartenJB · 2022-01-06 13:38

@GetMem, thanks.

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

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i //
...\lazarus\fpc\3.2.0\source\packages\fcl-
extra\examples\double\daemonunit1.pas procedure
TDaemon1.DataModuleExecute(Sender: TCustomDaemon);Var  I :
Integer;begin  I := 0;  Application.EventLog.Log('TDaemon1 execution
start');  While Self.Status = csRunning Do Begin    Sleep(10);   
Sender.CheckControlMessages(False);  // <-- This will make the status
update and exit appropriate   end;  Application.EventLog.Log('TDaemon1
execution stop');end;     
I'm not sure if this is the correct way, maybe someone with a bit more
knowledge than me can verify this "fix".

----------------------------------------------------------------------
MaartenJB · 2022-01-07 07:56

Quote from: GetMem on January 06, 2022, 01:51:47 pmBecause 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 · 2022-01-13 09:32

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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i
implementation  { TMyThread } constructor
TMyThread.Create(AConfigFile: String; ALog: TEventLog; ATerminate :
TNotifyEvent);begin  FConfigFile:=AConfigFile;  FLog:=Alog; 
OnTerminate:=ATerminate;  FreeOnTerminate:=false;  FThreadRTLEvent :=
RTLEventCreate;  Inherited Create(True);end; destructor
TMyThread.Destroy;begin  RTLeventDestroy(FThreadRTLEvent);  inherited
Destroy;end; procedure TMyThread.DoLog(EventType: TEventType; Msg :
String);begin  If Assigned(FLog) then    FLog.Log(EventType,
Msg);end; procedure TMyThread.DoTerminate;begin  //inherited
DoTerminate; we do not need to call inherited in service?  if (FDebug)
then begin    DoLog(etDebug,'TMyThread.DoTerminate');  end;  if
Assigned(OnTerminate) then begin    OnTerminate(Self); 
end;end; procedure TMyThread.Execute;Var  T : TDateTime;begin  try 
T:=Now;   Repeat    T:=Now+EncodeTime(0,FSyncEveryMins,0,0);   
Repeat      If Not Terminated then       
 RTLeventWaitFor(FThreadRTLEvent, 200);    Until (Now>=T) or
Terminated;    If Not Terminated then       DoWork;//Do actual work
here  Until Terminated;  if (FDebug) then   
DoLog(etDebug,'TMyThread.Terminated OnTerminate
'+BoolToStr(Assigned(Self.OnTerminate),true));  except   On E :
Exception do     DoLog(etError,'TMyThread.Execute err: '+E.Message); 
end; end; end.  
Daemon application:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i Program
SomeDaemon;   {...}TdaMyDaemon = Class(TCustomDaemon)  Private   
MyThread : TMyThread;    FLog : TEventLog;    procedure StartLog;   
Procedure ThreadStopped (Sender : TObject);  public   FTermRTLEvent:
PRTLEvent;   function LoadSettings: boolean;    constructor
Create(AOwner: TComponent);override;    destructor Destroy;override; 
 Function Start : Boolean; override;    Function Stop : Boolean;
override;    Function ShutDown : Boolean; override;    Function
Install : Boolean; override;    Function UnInstall: boolean;
override;  end; constructor TdaMyDaemon.Create(AOwner: TComponent); 
begin    FMyThread:=nil;    inherited.Create(AOwner);    FTermRTLEvent
:= RTLEventCreate;  end; destructor TdaMyDaemon.Destroy;begin 
 RTLeventDestroy(FTermRTLEvent);   inherited Destroy;end; function
TdaMyDaemon.Start: Boolean;  var    OK: boolean;  begin   
Result:=inherited Start;    StartLog;    OK:=LoadSettings;    If OK
then begin      if not (Assigned(FMyThread)) then begin       
FMyThread:=TMyThread.Create(FConfigFile,FLog,@ThreadStopped);       
if Assigned(FMyThread.FatalException) then            raise
FMyThread.FatalException;      end;      FMyThread.Start;    end else
begin      Application.Log(etError,'cannot create MyThread, check
settings');    end;    Result:=OK;end; function TdaMyDaemon.Stop:
Boolean;var  OK: boolean;  I: integer;begin  Result:=inherited Stop; 
Application.Log(etDebug,' TdaMyDaemon.Stop:
Assigned(FMyThread)='+BoolToStr(Assigned(FMyThread),true));  If
(Assigned(FMyThread)) then    begin      Application.Log(etDebug,'
TdaMyDaemon.Stop: Assigned(FMyThread.OnTerminate)='+BoolToStr(Assigned
(FMyThread.OnTerminate),true));      FMyThread.Terminate;    I:=0;   
// Wait at most 10 seconds.    While (FMyThread<>Nil) and (I<10000)
do      begin      //Sleep(100);  //causes temporary hang?     
RTLeventWaitFor(FTermRTLEvent, 100);      inc(i);      ReportStatus; 
   end;    // Let the thread die silently. Not sure about this.    { 
 If (FMyThread<>Nil) then      FMyThread.OnTerminate:=Nil;      }   
end;  OK:=FMyThread=Nil;  Application.Log(etInfo,'DaemonStop:
OK='+BoolToStr(OK,true));  Application.Terminate;//Not sure about
this. I hoped this solves: exe stays is memory after stopping the
service.end; procedure TdaMyDaemon.ThreadStopped(Sender:
TObject);begin  Application.Log(etInfo, 'Thread Stopped');  if
(Assigned(FMyThread)) then    begin      FreeAndNil(FMyThread);     
Application.Log(etDebug, 'Thread freed');    end;end;