Permalink
Browse files

TSynDaemon fork/run support on Linux/Posix

  • Loading branch information...
Arnaud Bouchez
Arnaud Bouchez committed Oct 16, 2017
1 parent 967363c commit 5b569db11e47fd65e2e0f792e1383895e50352b6
Showing with 170 additions and 40 deletions.
  1. +167 −37 SQLite3/mORMotService.pas
  2. +2 −2 SynCommons.pas
  3. +1 −1 SynopseCommit.inc
View
@@ -90,7 +90,16 @@ interface
{$ifdef MSWINDOWS}
Windows,
Messages,
{$endif}
{$else}
{$ifdef FPC}
SynFPCLinux,
BaseUnix,
Unix,
{$else}
Types,
LibC, // Kylix
{$endif FPC}
{$endif MSWINDOWS}
Classes,
SysUtils,
{$ifndef LVCL}
@@ -548,26 +557,37 @@ TSynDaemonSettings = class(TSynAutoCreateFields)
fLogRotateFileCount: integer;
fLogClass: TSynLogClass;
public
/// initialize the settings
constructor Create; override;
/// read existing settings from a JSON file
function LoadFromFile(const aFileName: TFileName): boolean;
/// persist the settings as a JSON file, named from LoadFromFile() parameter
procedure SaveIfNeeded;
/// define the log information into the supplied TSynLog class
// - if you don't call this method, the logging won't be initiated
// - is to be called typically in the overriden Create constructor of the
// associated TSynDaemon class, just after "inherited Create"
procedure SetLog(aLogClass: TSynLogClass);
/// returns user-friendly description of the service, including version
// information and company copyright (if available)
function ServiceDescription: string;
published
/// the service name, as used internally by Windows or the TSynDaemon class
// - default is the executable name
property ServiceName: string read fServiceName;
property ServiceName: string read fServiceName write fServiceName;
{$ifdef MSWINDOWS}
/// the service name, as displayed by Windows
// - default is the executable name
property ServiceDisplayName: string read fServiceDisplayName;
property ServiceDisplayName: string read fServiceDisplayName write fServiceDisplayName;
{$endif}
/// if not void, will enable the logs (default is LOG_STACKTRACE)
property Log: TSynLogInfos read fLog write fLog;
/// allow to customize where the logs should be written
property LogPath: TFileName read fLogPath;
property LogPath: TFileName read fLogPath write fLogPath;
/// how many files will be rotated (default is 2)
property LogRotateFileCount: integer read fLogRotateFileCount;
property LogRotateFileCount: integer read fLogRotateFileCount write fLogRotateFileCount;
end;
/// meta-class of TSynDaemon settings information
TSynDaemonSettingsClass = class of TSynDaemonSettings;
/// abstract parent to implements a daemon/service
@@ -580,13 +600,23 @@ TSynDaemon = class(TSynPersistent)
procedure DoStop(Sender: TService);
{$endif}
public
/// initialize the daemon, creating the associated settings
// - any non supplied folder name will be replaced by a default value
// (executable folder under Windows, or /etc /var/log on Linux)
constructor Create(aSettingsClass: TSynDaemonSettingsClass;
const aWorkFolderName: TFileName); reintroduce;
const aWorkFolder, aSettingsFolder, aLogFolder: TFileName); reintroduce;
/// main entry point of the daemon, to process the command line switches
procedure CommandLine{$ifdef MSWINDOWS}(aAutoStart: boolean){$endif};
/// inherited class should override this abstract method with proper process
procedure Start; virtual; abstract;
/// inherited class should override this abstract method with proper process
// - should do nothing if the daemon was already stopped
procedure Stop; virtual; abstract;
/// call Stop, finalize the instance, and its settings
destructor Destroy; override;
published
/// the settings associated with this daemon
// - will be allocated in Create constructor, and released in Destroy
property Settings: TSynDaemonSettings read fSettings;
end;
@@ -1191,7 +1221,7 @@ destructor TServiceSingle.Destroy;
constructor TSynDaemonSettings.Create;
begin
inherited Create;
fLog := LOG_STACKTRACE;
fLog := LOG_STACKTRACE + [sllNewRun];
fLogRotateFileCount := 2;
fServiceName := UTF8ToString(ExeVersion.ProgramName);
{$ifdef MSWINDOWS}
@@ -1217,8 +1247,6 @@ function TSynDaemonSettings.LoadFromFile(const aFileName: TFileName): boolean;
finally
tmp.Done;
end;
if fLogPath = '' then
fLogPath := EnsureDirectoryExists(ExtractFilePath(aFileName) + 'log');
end;
procedure TSynDaemonSettings.SaveIfNeeded;
@@ -1233,9 +1261,23 @@ procedure TSynDaemonSettings.SaveIfNeeded;
FileFromString(saved, fFileName);
end;
function TSynDaemonSettings.ServiceDescription: string;
var
versionnumber: string;
begin
result := UTF8ToString({$ifdef MSWINDOWS}ServiceDisplayName{$else}ServiceName{$endif});
with ExeVersion.Version do begin
versionnumber := DetailedOrVoid;
if versionnumber <> '' then
result := result + ' ' + versionnumber;
if CompanyName <> '' then
result := format('%s - (c)%d %s', [result, BuildYear, CompanyName]);
end;
end;
procedure TSynDaemonSettings.SetLog(aLogClass: TSynLogClass);
begin
if (self <> nil) and (Log <> []) then
if (self <> nil) and (Log <> []) and (aLogClass <> nil) then
with aLogClass.Family do begin
DestinationPath := LogPath;
RotateFileCount := LogRotateFileCount;
@@ -1250,17 +1292,27 @@ procedure TSynDaemonSettings.SetLog(aLogClass: TSynLogClass);
{ TSynDaemon }
constructor TSynDaemon.Create(aSettingsClass: TSynDaemonSettingsClass;
const aWorkFolderName: TFileName);
const aWorkFolder, aSettingsFolder, aLogFolder: TFileName);
var
setf: TFileName;
begin
inherited Create;
if aWorkFolderName = '' then
if aWorkFolder = '' then
fWorkFolderName := ExeVersion.ProgramFilePath
else
fWorkFolderName := EnsureDirectoryExists(aWorkFolderName, true);
fWorkFolderName := EnsureDirectoryExists(aWorkFolder, true);
if aSettingsClass = nil then
aSettingsClass := TSynDaemonSettings;
fSettings := aSettingsClass.Create;
fSettings.LoadFromFile(format('%s%s.settings', [fWorkFolderName, ExeVersion.ProgramName]));
setf := aSettingsFolder;
if setf = '' then
setf := {$ifdef MSWINDOWS}fWorkFolderName{$else}'/etc/'{$endif};
fSettings.LoadFromFile(format('%s%s.settings', [setf, ExeVersion.ProgramName]));
if fSettings.LogPath = '' then
if aLogFolder = '' then
fSettings.LogPath := {$ifdef MSWINDOWS}fWorkFolderName{$else}'/var/log/'{$endif}
else
fSettings.LogPath := EnsureDirectoryExists(aLogFolder);
end;
destructor TSynDaemon.Destroy;
@@ -1281,11 +1333,48 @@ procedure TSynDaemon.DoStop(Sender: TService);
begin
Stop;
end;
{$else} // Linux/POSIX signal interception
var
SynDaemonTerminated: integer;
{$ifdef FPC}
procedure DoShutDown(Sig: Longint; Info: PSigInfo; Context: PSigContext); cdecl;
{$else}
procedure DoShutDown(Sig: integer); cdecl;
{$endif}
begin
SynDaemonTerminated := Sig;
end;
procedure SigIntercept;
{$ifdef FPC}
var
saOld, saNew: SigactionRec;
begin
FillCharFast(saNew, SizeOf(saNew), 0);
saNew.sa_handler := @DoShutDown;
fpSigaction(SIGQUIT, @saNew, @saOld);
fpSigaction(SIGTERM, @saNew, @saOld);
fpSigaction(SIGINT, @saNew, @saOld);
{$else} // Kylix
var
saOld, saNew: TSigAction;
begin
FillCharFast(saNew, SizeOf(saNew), 0);
saNew.__sigaction_handler := @DoShutDown;
sigaction(SIGQUIT, @saNew, @saOld);
sigaction(SIGTERM, @saNew, @saOld);
sigaction(SIGINT, @saNew, @saOld);
{$endif}
end;
{$endif MSWINDOWS}
type
TExecuteCommandLineCmd = (
cNone, cInstall, cUninstall, cVersion, cConsole, cVerbose, cFork,
cNone, cInstall, cUninstall, cVersion, cConsole, cVerbose, cRun, cFork,
cStart, cStop, cState, cHelp);
procedure TSynDaemon.CommandLine;
@@ -1296,6 +1385,51 @@ procedure TSynDaemon.CommandLine;
{$ifdef MSWINDOWS}
service: TServiceSingle;
ctrl: TServiceController;
{$else}
procedure RunUntilSigTerminated(dofork: boolean);
var
pid, sid: {$ifdef FPC}TPID{$else}pid_t{$endif};
begin
SigIntercept;
try
if dofork then begin
pid := {$ifdef FPC}fpFork{$else}fork{$endif};
if pid < 0 then
raise ESynException.CreateUTF8('%.CommandLine Fork failed', [self]);
if pid > 0 then begin // main program - just terminate
//{$ifdef FPC}fpExit{$else}__exit{$endif}(0);
exit;
end else begin // clean forked instance
sid := {$ifdef FPC}fpSetSID{$else}setsid{$endif};
if sid < 0 then // new session (process group) created?
raise ESynException.CreateUTF8('%.CommandLine SetSID failed', [self]);
{$ifdef FPC}fpUMask{$else}umask{$endif}(0); // reset file mask
chdir('/'); // avoid locking current directory
Close(input);
AssignFile(input, '/dev/null');
ReWrite(input);
Close(output);
AssignFile(output, '/dev/null');
ReWrite(output);
{$ifdef FPC}Close{$else}__close{$endif}(stderr);
end;
end;
log := fSettings.fLogClass.Add;
log.Log(sllNewRun, 'Start % %', [fSettings.ServiceName,
ExeVersion.Version.DetailedOrVoid], self);
Start;
while SynDaemonTerminated = 0 do
{$ifdef FPC}fpPause{$else}pause{$endif};
log.Log(sllNewRun, 'Stop from Sig=%', [SynDaemonTerminated], self);
Stop;
except
on E: Exception do begin
if not dofork then
ConsoleShowFatalException(E, true);
Halt(1); // notify error to caller process
end;
end;
end;
{$endif}
procedure Syntax;
@@ -1308,7 +1442,7 @@ procedure TSynDaemon.CommandLine;
{$ifdef MSWINDOWS}
writeln(spaces, '/install /uninstall /start /stop /state');
{$else}
writeln(spaces, '/fork -f');
writeln(spaces, '/run -r /fork -f');
{$endif}
end;
function cmdText: RawUTF8;
@@ -1340,10 +1474,7 @@ procedure TSynDaemon.CommandLine;
begin
if (self = nil) or (fSettings = nil) then
exit;
if fSettings.fLogClass <> nil then
log := fSettings.fLogClass.Add
else
log := nil;
log := nil;
{$I-}
param := trim(StringToUTF8(paramstr(1)));
@@ -1353,13 +1484,15 @@ procedure TSynDaemon.CommandLine;
case param[2] of
'C':
cmd := cConsole;
'R':
cmd := cRun;
'F':
cmd := cFork;
'H':
cmd := cHelp;
else
byte(cmd) := ord(cInstall) + IdemPCharArray(@param[2], ['INST', 'UNINST',
'VERS', 'CONS', 'VERB', 'FORK', 'START', 'STOP', 'STAT', 'HELP']);
'VERS', 'CONS', 'VERB', 'RUN', 'FORK', 'START', 'STOP', 'STAT', 'HELP']);
end;
case cmd of
cHelp:
@@ -1371,16 +1504,15 @@ procedure TSynDaemon.CommandLine;
if ExeVersion.Version.Version32 <> 0 then
writeln(' Version: ', ExeVersion.Version.Detailed);
end;
cConsole, cVerbose: begin
writeln('Launched in ', cmdText, ' mode'#10);
TextColor(ccLightGray);
case cmd of
cVerbose: // leave as in settings for -c (cConsole)
if log <> nil then
log.Family.EchoToConsole := LOG_VERBOSE;
end;
cConsole, cVerbose:
try
log.Log(sllNewRun, 'Start %', [fSettings], self);
writeln('Launched in ', cmdText, ' mode'#10);
TextColor(ccLightGray);
log := fSettings.fLogClass.Add;
if (cmd = cVerbose) and (log <> nil) then // leave as in settings for -c
log.Family.EchoToConsole := LOG_VERBOSE;
log.Log(sllNewRun, 'Start % %', [fSettings.ServiceName,
ExeVersion.Version.DetailedOrVoid], self);
Start;
writeln('Press [Enter] to quit');
ioresult;
@@ -1393,7 +1525,6 @@ procedure TSynDaemon.CommandLine;
on E: Exception do
ConsoleShowFatalException(E, true);
end;
end;
{$ifdef MSWINDOWS} // implement the daemon as a Windows Service
else if fSettings.ServiceName = '' then
if cmd = cNone then
@@ -1425,10 +1556,9 @@ procedure TSynDaemon.CommandLine;
else
Syntax;
cInstall:
with fSettings, ExeVersion.Version do
with fSettings do
Show(TServiceController.Install(ServiceName, ServiceDisplayName,
format('%s %s %s', [ServiceDisplayName, DetailedOrVoid, CompanyName]),
aAutoStart) <> ssNotInstalled);
ServiceDescription, aAutoStart) <> ssNotInstalled);
cStart, cStop, cUninstall, cState: begin
ctrl := TServiceController.CreateOpenService('', '', fSettings.ServiceName);
try
@@ -1453,10 +1583,10 @@ procedure TSynDaemon.CommandLine;
Syntax;
end;
{$else}
cRun:
RunUntilSigTerminated(false);
cFork:
begin
//TODO: properly implement Linux daemon fork
end;
RunUntilSigTerminated(true);
else
Syntax;
{$endif MSWINDOWS}
View
@@ -3348,15 +3348,15 @@ function SameTextU(const S1, S2: RawUTF8): Boolean;
/// fast conversion of the supplied text into 8 bit uppercase
// - this will not only convert 'a'..'z' into 'A'..'Z', but also accentuated
// latin characters ('e' acute into 'E' e.g.), using NormToUpper[] array
// - it will decode the supplied UTF-8 content to handle more than
// - it will therefore decode the supplied UTF-8 content to handle more than
// 7 bit of ascii characters (so this function is dedicated to WinAnsi code page
// 1252 characters set)
function UpperCaseU(const S: RawUTF8): RawUTF8;
/// fast conversion of the supplied text into 8 bit lowercase
// - this will not only convert 'A'..'Z' into 'a'..'z', but also accentuated
// latin characters ('E' acute into 'e' e.g.), using NormToLower[] array
// - it will convert decode the supplied UTF-8 content to handle more than
// - it will therefore decode the supplied UTF-8 content to handle more than
// 7 bit of ascii characters
function LowerCaseU(const S: RawUTF8): RawUTF8;
View
@@ -1 +1 @@
'1.18.3895'
'1.18.3896'

0 comments on commit 5b569db

Please sign in to comment.