* Fix bug #32532: AV when killing daemon app

git-svn-id: trunk@43645 -
This commit is contained in:
michael 2019-12-05 14:54:15 +00:00
parent 00e132498e
commit b82eaf4ce2
11 changed files with 254 additions and 3 deletions

8
.gitattributes vendored
View File

@ -3455,6 +3455,14 @@ packages/fcl-extra/examples/Makefile svneol=native#text/plain
packages/fcl-extra/examples/Makefile.fpc svneol=native#text/plain
packages/fcl-extra/examples/daemon.pp svneol=native#text/plain
packages/fcl-extra/examples/daemon.txt svneol=native#text/plain
packages/fcl-extra/examples/double/daemonmapperunit1.lfm svneol=native#text/plain
packages/fcl-extra/examples/double/daemonmapperunit1.pas svneol=native#text/plain
packages/fcl-extra/examples/double/daemonunit1.lfm svneol=native#text/plain
packages/fcl-extra/examples/double/daemonunit1.pas svneol=native#text/plain
packages/fcl-extra/examples/double/daemonunit2.lfm svneol=native#text/plain
packages/fcl-extra/examples/double/daemonunit2.pas svneol=native#text/plain
packages/fcl-extra/examples/double/double.pp svneol=native#text/plain
packages/fcl-extra/examples/double/resdaemonapp.pp svneol=native#text/plain
packages/fcl-extra/fpmake.pp svneol=native#text/pascal
packages/fcl-extra/src/daemonapp.pp svneol=native#text/plain
packages/fcl-extra/src/unix/daemonapp.inc svneol=native#text/plain

View File

@ -0,0 +1,29 @@
object DaemonMapper1: TDaemonMapper1
DaemonDefs = <
item
DaemonClassName = 'TDaemon1'
Name = 'TDaemon1'
Options = [doAllowStop, doAllowPause]
WinBindings.Dependencies = <>
WinBindings.StartType = stBoot
WinBindings.WaitHint = 0
WinBindings.IDTag = 0
WinBindings.ServiceType = stWin32
WinBindings.ErrorSeverity = esIgnore
LogStatusReport = False
end
item
DaemonClassName = 'TDaemon2'
Name = 'TDaemon2'
Options = [doAllowStop, doAllowPause]
WinBindings.Dependencies = <>
WinBindings.StartType = stBoot
WinBindings.WaitHint = 0
WinBindings.IDTag = 0
WinBindings.ServiceType = stWin32
WinBindings.ErrorSeverity = esIgnore
LogStatusReport = False
end>
Left = 284
Top = 140
end

View File

@ -0,0 +1,34 @@
unit DaemonMapperUnit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, DaemonApp;
type
TDaemonMapper1 = class(TDaemonMapper)
private
public
end;
var
DaemonMapper1: TDaemonMapper1;
implementation
procedure RegisterMapper;
begin
RegisterDaemonMapper(TDaemonMapper1)
end;
{$R *.lfm}
initialization
RegisterMapper;
end.

View File

@ -0,0 +1,8 @@
object Daemon1: TDaemon1
OldCreateOrder = False
OnExecute = DataModuleExecute
Height = 150
HorizontalOffset = 284
VerticalOffset = 140
Width = 150
end

View File

@ -0,0 +1,52 @@
unit DaemonUnit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, DaemonApp;
type
{ TDaemon1 }
TDaemon1 = class(TDaemon)
procedure DataModuleExecute(Sender: TCustomDaemon);
private
public
end;
var
Daemon1: TDaemon1;
implementation
procedure RegisterDaemon;
begin
RegisterDaemonClass(TDaemon1)
end;
{$R *.lfm}
{ TDaemon1 }
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);
end;
Application.EventLog.Log('TDaemon1 execution stop');
end;
initialization
RegisterDaemon;
end.

View File

@ -0,0 +1,8 @@
object Daemon2: TDaemon2
OldCreateOrder = False
OnExecute = DataModuleExecute
Height = 150
HorizontalOffset = 284
VerticalOffset = 140
Width = 150
end

View File

@ -0,0 +1,52 @@
unit daemonunit2;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, DaemonApp;
type
{ TDaemon2 }
TDaemon2 = class(TDaemon)
procedure DataModuleExecute(Sender: TCustomDaemon);
private
public
end;
var
Daemon2: TDaemon2;
implementation
procedure RegisterDaemon;
begin
RegisterDaemonClass(TDaemon2)
end;
{$R *.lfm}
{ TDaemon2 }
procedure TDaemon2.DataModuleExecute(Sender: TCustomDaemon);
Var
I : Integer;
begin
I := 0;
Application.EventLog.Log('TDaemon2 execution start');
While Self.Status = csRunning Do Begin
Sleep(10);
end;
Application.EventLog.Log('TDaemon2 execution stop');
end;
initialization
RegisterDaemon;
end.

View File

@ -0,0 +1,23 @@
Program double;
Uses
{$IFDEF UNIX}
CThreads,
{$ENDIF}
ResDaemonApp, DaemonApp, DaemonMapperUnit1, DaemonUnit1, daemonunit2, SysUtils, eventlog
{ add your units here };
Var
AExecutableFilenamePath : String;
begin
AExecutableFilenamePath := ParamStr(0);
AExecutableFilenamePath := ExpandFileName(AExecutableFilenamePath);
AExecutableFilenamePath := ExtractFilePath(AExecutableFilenamePath);
Application.Title:='Daemon application';
Application.Initialize;
Application.EventLog.FileName := SysUtils.ConcatPaths([AExecutableFilenamePath, 'event-log.txt']);
Application.EventLog.LogType := ltFile;
Application.EventLog.AppendContent := False;
Application.EventLog.Active := True;
Application.Run;
end.

View File

@ -0,0 +1,32 @@
{
*****************************************************************************
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
}
{$mode objfpc}
{$h+}
unit resdaemonapp;
interface
uses daemonapp;
Type
TResDaemonApplication = Class(TCustomDaemonApplication)
Procedure CreateDaemonInstance(Var ADaemon : TCustomDaemon; DaemonDef : TDaemonDef); override;
end;
implementation
uses classes;
Procedure TResDaemonApplication.CreateDaemonInstance(Var ADaemon : TCustomDaemon; DaemonDef : TDaemonDef);
begin
ADaemon:=DaemonDef.DaemonClass.Create(Self);
end;
Initialization
RegisterDaemonApplicationClass(TResDaemonApplication)
end.

View File

@ -56,6 +56,7 @@ Type
Function Install : Boolean; virtual;
Function UnInstall: boolean; virtual;
Function HandleCustomCode(ACode : DWord) : Boolean; Virtual;
procedure DoThreadTerminate(Sender: TObject);virtual;
Public
Procedure CheckControlMessages(Wait : Boolean);
Procedure LogMessage(const Msg : String);
@ -694,7 +695,12 @@ begin
Result:=False
end;
Procedure TCustomDaemon.CheckControlMessages(Wait : Boolean);
procedure TCustomDaemon.DoThreadTerminate(Sender: TObject);
begin
Self.FThread := NIL;
end;
procedure TCustomDaemon.CheckControlMessages(Wait: Boolean);
begin
If Assigned(FThread) then

View File

@ -167,9 +167,8 @@ begin
Try
T:=TDaemonThread.Create(FDaemon);
T.FreeOnTerminate:=True;
T.OnTerminate := @FDaemon.DoThreadTerminate;
T.Resume;
T.WaitFor;
FDaemon.FThread:=Nil;
except
On E : Exception do
FDaemon.Logmessage(Format(SErrDaemonStartFailed,[FDaemon.Definition.Name,E.Message]));