Browse Source

* Fix bug #32532: AV when killing daemon app

git-svn-id: trunk@43645 -
michael 5 years ago
parent
commit
b82eaf4ce2

+ 8 - 0
.gitattributes

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

+ 29 - 0
packages/fcl-extra/examples/double/daemonmapperunit1.lfm

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

+ 34 - 0
packages/fcl-extra/examples/double/daemonmapperunit1.pas

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

+ 8 - 0
packages/fcl-extra/examples/double/daemonunit1.lfm

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

+ 52 - 0
packages/fcl-extra/examples/double/daemonunit1.pas

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

+ 8 - 0
packages/fcl-extra/examples/double/daemonunit2.lfm

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

+ 52 - 0
packages/fcl-extra/examples/double/daemonunit2.pas

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

+ 23 - 0
packages/fcl-extra/examples/double/double.pp

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

+ 32 - 0
packages/fcl-extra/examples/double/resdaemonapp.pp

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

+ 7 - 1
packages/fcl-extra/src/daemonapp.pp

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

+ 1 - 2
packages/fcl-extra/src/unix/daemonapp.inc

@@ -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]));