diff --git a/SQLite3/Samples/11 - Exception logging/LogViewMain.lfm b/SQLite3/Samples/11 - Exception logging/LogViewMain.lfm
index e14b57930..2b0606d9b 100644
--- a/SQLite3/Samples/11 - Exception logging/LogViewMain.lfm
+++ b/SQLite3/Samples/11 - Exception logging/LogViewMain.lfm
@@ -14,7 +14,7 @@ object MainLogView: TMainLogView
OnCreate = FormCreate
OnKeyDown = FormKeyDown
OnShow = FormShow
- LCLVersion = '1.7'
+ LCLVersion = '2.0.7.0'
object Splitter2: TSplitter
Cursor = crVSplit
Left = 0
@@ -146,17 +146,17 @@ object MainLogView: TMainLogView
end
object lblServerRoot: TLabel
Left = 16
- Height = 13
+ Height = 14
Top = 48
- Width = 62
+ Width = 72
Caption = 'Server Root:'
ParentColor = False
end
object lblServerPort: TLabel
Left = 16
- Height = 13
+ Height = 14
Top = 90
- Width = 59
+ Width = 69
Caption = 'Server Port:'
ParentColor = False
end
@@ -182,10 +182,11 @@ object MainLogView: TMainLogView
PopupMenu = FilterMenu
Style = lbOwnerDrawFixed
TabOrder = 3
+ TopIndex = -1
end
object EditSearch: TEdit
Left = 16
- Height = 21
+ Height = 31
Hint = 'Search (Ctrl+F, F3 for next) '
Top = 40
Width = 85
@@ -231,9 +232,9 @@ object MainLogView: TMainLogView
end
object MergedProfile: TCheckBox
Left = 22
- Height = 19
+ Height = 23
Top = 283
- Width = 112
+ Width = 137
Caption = 'Merge method calls'
OnClick = MergedProfileClick
TabOrder = 5
@@ -261,8 +262,8 @@ object MainLogView: TMainLogView
Top = 336
Width = 118
Caption = ' Threads '
- ClientHeight = 78
- ClientWidth = 114
+ ClientHeight = 81
+ ClientWidth = 116
TabOrder = 8
object BtnThreadNext: TButton
Left = 8
@@ -374,7 +375,7 @@ object MainLogView: TMainLogView
end
object edtServerRoot: TEdit
Left = 16
- Height = 21
+ Height = 31
Top = 64
Width = 121
TabOrder = 11
@@ -382,7 +383,7 @@ object MainLogView: TMainLogView
end
object edtServerPort: TEdit
Left = 16
- Height = 21
+ Height = 31
Top = 106
Width = 121
TabOrder = 12
@@ -415,7 +416,9 @@ object MainLogView: TMainLogView
Width = 121
ItemHeight = 0
OnDblClick = lstDaysDblClick
+ ScrollWidth = 119
TabOrder = 15
+ TopIndex = -1
end
end
object MemoBottom: TMemo
@@ -494,6 +497,7 @@ object MainLogView: TMainLogView
OnClickCheck = ThreadListBoxClickCheck
OnDblClick = ThreadListBoxDblClick
TabOrder = 0
+ TopIndex = -1
end
object pnlThreadBottom: TPanel
Left = 1
@@ -555,19 +559,19 @@ object MainLogView: TMainLogView
end
end
object FilterMenu: TPopupMenu
- left = 88
- top = 16
+ Left = 88
+ Top = 16
end
object OpenDialog: TOpenDialog
DefaultExt = '.log'
Filter = 'Log|*.log;*.txt;*.synlz'
Options = [ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing]
- left = 40
- top = 80
+ Left = 40
+ Top = 80
end
object ListMenu: TPopupMenu
- left = 40
- top = 16
+ Left = 40
+ Top = 16
object ListMenuCopy: TMenuItem
Caption = '&Copy'
OnClick = ListMenuCopyClick
@@ -577,14 +581,14 @@ object MainLogView: TMainLogView
Enabled = False
Interval = 200
OnTimer = tmrRefreshTimer
- left = 88
- top = 80
+ Left = 88
+ Top = 80
end
object dlgSaveList: TSaveDialog
DefaultExt = '.log'
Filter = 'log|*.log|txt|*.txt|synlz|*.synlz'
Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing]
- left = 136
- top = 16
+ Left = 136
+ Top = 16
end
end
diff --git a/SQLite3/Samples/11 - Exception logging/LogViewMain.pas b/SQLite3/Samples/11 - Exception logging/LogViewMain.pas
index 88cb014df..ef52e1678 100644
--- a/SQLite3/Samples/11 - Exception logging/LogViewMain.pas
+++ b/SQLite3/Samples/11 - Exception logging/LogViewMain.pas
@@ -34,7 +34,9 @@ interface
{$endif}
SynCommons,
SynLog,
+ {$ifdef WINDOWS}
SynMemoEx,
+ {$endif}
mORMotHttpServer;
type
@@ -96,6 +98,9 @@ TMainLogView = class(TForm)
btnThreadDown: TButton;
btnThreadUp: TButton;
lstDays: TListBox;
+ {$ifdef LINUX}
+ MemoBottom: TMemo;
+ {$endif}
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure BtnFilterClick(Sender: TObject);
@@ -155,7 +160,9 @@ TMainLogView = class(TForm)
procedure ThreadListNameRefresh(Index: integer);
procedure ReceivedOne(const Text: RawUTF8);
public
+ {$ifdef WINDOWS}
MemoBottom: TMemoEx;
+ {$endif}
destructor Destroy; override;
property LogFileName: TFileName write SetLogFileName;
end;
@@ -332,6 +339,7 @@ procedure TMainLogView.FormCreate(Sender: TObject);
ProfileList.ColWidths[0] := 60;
ProfileList.ColWidths[1] := 1000;
ProfileList.Hide;
+ {$ifdef WINDOWS}
MemoBottom := TMemoEx.Create(self);
MemoBottom.Parent := PanelBottom;
MemoBottom.Align := alClient;
@@ -342,6 +350,7 @@ procedure TMainLogView.FormCreate(Sender: TObject);
MemoBottom.ReadOnly := true;
MemoBottom.ScrollBars := ssVertical;
MemoBottom.Text := '';
+ {$endif}
end;
procedure TMainLogView.FormShow(Sender: TObject);
@@ -1077,9 +1086,11 @@ procedure TMainLogView.PanelLeftResize(Sender: TObject);
procedure TMainLogView.PanelBottomResize(Sender: TObject);
var w: integer;
begin
+ {$ifdef WINDOWS}
w := MemoBottom.CellRect.Width;
if w > 0 then
MemoBottom.RightMargin := (PanelBottom.ClientWidth div w) - 7;
+ {$endif}
end;
end.
diff --git a/SQLite3/Samples/36 - Simple REST Benchmark/README.md b/SQLite3/Samples/36 - Simple REST Benchmark/README.md
index c3e5baba6..2b8878691 100644
--- a/SQLite3/Samples/36 - Simple REST Benchmark/README.md
+++ b/SQLite3/Samples/36 - Simple REST Benchmark/README.md
@@ -39,7 +39,7 @@ in RESTBEnchmark by passing `false` to then second parameter
### How to run
- - compile program and run with `unix` parameter
+ - compile a program and run with `unix` parameter
```
./RESTBenchmark unix
```
@@ -62,3 +62,52 @@ sudo nginx -s reload
```
wrk http://localhost:8888/root/abc
```
+
+
+## systemd integration
+
+ - socket activation
+ - journald logging (can be exported for LogView program)
+ - auto shutdown on inactivity
+
+With combination of [Systemd Template Unit](https://fedoramagazine.org/systemd-template-unit-files/), `* A` DNS zone and
+nginx virtual hosts we can build a "cloud solution" using mORMot services with per-customer process level isolation.
+
+### Install Unit
+Add our service to systemd (should be executed once).
+This command activate `rest_benchmark` socket on port 8889
+```bash
+sudo ./installSystemSocket.sh
+```
+
+### Socket activation, auto shutdown and logs
+Kill possible instances of RESTBenchmark program
+```bash
+killall -TERM RESTBenchmark
+```
+
+Now program is **NOT running**, lets send an HTTP request to a port configured in `rest_benchmark.socket` unit (8889)
+```bash
+curl http://localhost:8889/root/xyz
+```
+Magic - we got a response :) This is how systemd socket activation works.
+
+Inside our demo program, in case it executed by systemd it:
+ - log all activity into journald (see EchoToConsoleUseJournal)
+ - stops after 10 seconds without GET requests (see inactivityWatchdog in RESTBenchmark.dpr)
+
+Open new terminal window and run a command to watch logs from `rest_benchmark` services
+```bash
+journalctl -u rest_benchmark.service -f
+```
+
+Now wait for 10 second - service should shut down itself.
+
+### journald and LogView (Samples/11 - Exception logging)
+
+Logs from journald can be exported to format LogView understand. Example:
+```bash
+journalctl -u rest_benchmark.service --no-hostname -o short-iso-precise --since today | grep "RESTBenchmark\[.*\]: . " > todaysLog.log
+```
+better to grep by program PID `"RESTBenchmark\[12345]: . "` to include only one start/stop circle (on 2020-06 LogView do not allow to filter on PIDs)
+
diff --git a/SQLite3/Samples/36 - Simple REST Benchmark/RESTBenchmark.dpr b/SQLite3/Samples/36 - Simple REST Benchmark/RESTBenchmark.dpr
index 41633c72e..711200570 100644
--- a/SQLite3/Samples/36 - Simple REST Benchmark/RESTBenchmark.dpr
+++ b/SQLite3/Samples/36 - Simple REST Benchmark/RESTBenchmark.dpr
@@ -12,6 +12,8 @@ program RESTBenchmark;
{$APPTYPE CONSOLE}
{$endif}
+{$I Synopse.inc} // LINUXNOTBSD
+
uses
{$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
SysUtils,
@@ -22,6 +24,13 @@ uses
mORMot, // RESTful server & ORM
mORMotSQLite3, // SQLite3 engine as ORM core
SynSQLite3Static, // staticaly linked SQLite3 engine
+ {$ifdef UNIX}
+ BaseUnix,
+ {$endif}
+ {$ifdef LINUXNOTBSD}
+ SynSystemd,
+ mORMotService,
+ {$endif}
mORMotHttpServer; // HTTP server for RESTful server
type
@@ -102,9 +111,14 @@ begin
ctxt.Returns(s);
end;
+var
+ url: AnsiString;
+ keepAlive: boolean;
+ aRestServer: TSQLRestServer;
+ lastReadCount: TSynMonitorCount64;
+
procedure DoTest(const url: AnsiString; keepAlive: boolean);
var
- aRestServer: TSQLRestServerDB;
aHttpServer: TSQLHttpServer;
aServices: TMyServices;
begin
@@ -126,8 +140,14 @@ begin
if (keepAlive) then
writeLn('is enabled') else
writeLn('is disabled');
+ {$ifdef LINUX}
+ SynDaemonIntercept(nil);
+ writeln('Press [Ctrl+C] or send SIGINT/SIGTERM to close the server.');
+ fpPause;
+ {$else}
write('Press [Enter] to close the server.');
readln;
+ {$endif}
finally
aHttpServer.Free;
end;
@@ -135,17 +155,33 @@ begin
aServices.Free;
end;
finally
- aRestServer.Free;
+ FreeAndNil(aRestServer);
end;
end;
const
UNIX_SOCK_PATH = '/tmp/rest-bench.socket';
-var
- url: AnsiString;
- keepAlive: boolean;
-
+{$ifdef LINUX}
+/// killa process after X second without GEt requests
+function inactivityWatchdog(p: pointer): ptrint;
+var currentRC: TSynMonitorCount64;
+begin
+ repeat
+ sleep(10000); /// once per 10 second
+ if aRestServer = nil then // not initialized
+ continue;
+ currentRC := aRestServer.Stats.Read;
+ if (currentRC - lastReadCount) <= 0 then begin
+ SQLite3Log.Add.Log(sllServer, 'Terminating due to inactivity..');
+ FpKill(GetProcessID, SIGTERM);
+ break;
+ end;
+ lastReadCount := currentRC;
+ until false;
+ Result := 0;
+end;
+{$endif}
begin
// set logging abilities
SQLite3Log.Family.Level := LOG_VERBOSE;
@@ -153,6 +189,20 @@ begin
SQLite3Log.Family.PerThreadLog := ptIdentifiedInOnFile;
SQLite3Log.Family.NoFile := true; // do not create log files for benchmark
{$ifdef UNIX}
+ {$ifdef LINUXNOTBSD}
+ if SynSystemd.ProcessIsStartedBySystemd then begin
+ SQLite3Log.Family.EchoToConsole := SQLite3Log.Family.Level;
+ SQLite3Log.Family.EchoToConsoleUseJournal := true;
+ if sd.listen_fds(0) = 1 then
+ url := '' // force to use socket passed by systemd
+ else
+ url := '8888';
+ // set a wachdog to kill our process after 10 sec of inactivity
+ // just for demo - in real life verifiing only read operations is not enought
+ lastReadCount := 0;
+ BeginThread(@inactivityWatchdog, nil);
+ end else
+ {$endif}
if (ParamCount>0) and (ParamStr(1)='unix') then begin
url := 'unix:' + UNIX_SOCK_PATH;
if FileExists(UNIX_SOCK_PATH) then
diff --git a/SQLite3/Samples/36 - Simple REST Benchmark/RESTBenchmark.lpi b/SQLite3/Samples/36 - Simple REST Benchmark/RESTBenchmark.lpi
index d828b6b41..3661fcacb 100644
--- a/SQLite3/Samples/36 - Simple REST Benchmark/RESTBenchmark.lpi
+++ b/SQLite3/Samples/36 - Simple REST Benchmark/RESTBenchmark.lpi
@@ -39,6 +39,7 @@
+
diff --git a/SQLite3/Samples/36 - Simple REST Benchmark/installSystemSocket.sh b/SQLite3/Samples/36 - Simple REST Benchmark/installSystemSocket.sh
new file mode 100755
index 000000000..63c2fd4d0
--- /dev/null
+++ b/SQLite3/Samples/36 - Simple REST Benchmark/installSystemSocket.sh
@@ -0,0 +1,5 @@
+ln -s "`pwd`/rest_benchmark.socket" /etc/systemd/system
+ln -s "`pwd`/rest_benchmark.service" /etc/systemd/system
+systemctl enable rest_benchmark.socket
+systemctl start rest_benchmark.socket
+systemctl status rest_benchmark.socket #output status to console
\ No newline at end of file
diff --git a/SQLite3/Samples/36 - Simple REST Benchmark/rest_benchmark.service b/SQLite3/Samples/36 - Simple REST Benchmark/rest_benchmark.service
new file mode 100644
index 000000000..01fc249cc
--- /dev/null
+++ b/SQLite3/Samples/36 - Simple REST Benchmark/rest_benchmark.service
@@ -0,0 +1,12 @@
+[Unit]
+Description=mORMot socket activation demo
+Documentation=https://synopse.info
+RefuseManualStart=true
+
+[Service]
+Restart=on-failure
+ExecStart="/home/pavelmash/dev/tmp/crypto_ssl/mORMot/SQLite3/Samples/36 - Simple REST Benchmark/RESTBenchmark"
+# starting from systemd v244 is possible to configure log limits per service as below
+# befote - only inside journald.conf
+# LogRateLimitIntervalSec=1s
+# LogRateLimitBurst=50000 # ~10 000 req / sec
diff --git a/SQLite3/Samples/36 - Simple REST Benchmark/rest_benchmark.socket b/SQLite3/Samples/36 - Simple REST Benchmark/rest_benchmark.socket
new file mode 100644
index 000000000..d52d6b411
--- /dev/null
+++ b/SQLite3/Samples/36 - Simple REST Benchmark/rest_benchmark.socket
@@ -0,0 +1,7 @@
+[Socket]
+ListenStream=127.0.0.1:8889
+NoDelay=true
+KeepAlive=true
+
+[Install]
+WantedBy=sockets.target
\ No newline at end of file
diff --git a/SynBidirSock.pas b/SynBidirSock.pas
index 5b2b99abe..c67a1e789 100644
--- a/SynBidirSock.pas
+++ b/SynBidirSock.pas
@@ -1072,7 +1072,8 @@ TWebSocketServer = class(THttpServer)
// once it has been upgraded to WebSockets
constructor Create(const aPort: SockString; OnStart,OnStop: TNotifyThreadEvent;
const ProcessName: SockString; ServerThreadPoolCount: integer=2;
- KeepAliveTimeOut: integer=30000; HeadersNotFiltered: boolean=false); override;
+ KeepAliveTimeOut: integer=30000; HeadersNotFiltered: boolean=false;
+ CreateSuspended: boolean = false); override;
/// close the server
destructor Destroy; override;
/// will send a given frame to all connected clients
@@ -3153,7 +3154,7 @@ function HttpServerWebSocketUpgrade(ClientSock: THttpServerSocket;
constructor TWebSocketServer.Create(const aPort: SockString; OnStart,OnStop: TNotifyThreadEvent;
const ProcessName: SockString; ServerThreadPoolCount, KeepAliveTimeOut: integer;
- HeadersNotFiltered: boolean);
+ HeadersNotFiltered: boolean; CreateSuspended: boolean);
begin
// override with custom processing classes
fSocketClass := TWebSocketServerSocket;
@@ -3166,7 +3167,7 @@ constructor TWebSocketServer.Create(const aPort: SockString; OnStart,OnStop: TNo
fCanNotifyCallback := true;
// start the server
inherited Create(aPort,OnStart,OnStop,ProcessName,ServerThreadPoolCount,
- KeepAliveTimeOut,HeadersNotFiltered);
+ KeepAliveTimeOut,HeadersNotFiltered,CreateSuspended);
end;
function TWebSocketServer.WebSocketProcessUpgrade(ClientSock: THttpServerSocket;
diff --git a/SynCrtSock.pas b/SynCrtSock.pas
index 2cd496020..6e4d2f2e7 100644
--- a/SynCrtSock.pas
+++ b/SynCrtSock.pas
@@ -286,12 +286,12 @@ TCrtSocket = class
// Windows by now, using the SChannel API)
constructor Open(const aServer, aPort: SockString; aLayer: TCrtSocketLayer=cslTCP;
aTimeOut: cardinal=10000; aTLS: boolean=false);
- /// bind to a Port
- // - expects the port to be specified as Ansi string, e.g. '1234'
- // - you can optionally specify a server address to bind to, e.g.
- // '1.2.3.4:1234'
- // - for unix domain socket use unix:/path/to/file
- constructor Bind(const aPort: SockString; aLayer: TCrtSocketLayer=cslTCP);
+ /// bind to an address. Expects the address to be specified as Ansi string as
+ // - '1234' - bind to a port on all interfaces, the same as '0.0.0.0:1234'
+ // - 'IP:port' - bind to specified interface only, e.g. '1.2.3.4:1234'
+ // - 'unix:/path/to/file' - bind to unix domain socket, e.g. 'unix:/run/mormot.sock'
+ // - '' - bind to systemd descriptor on linux. See http://0pointer.de/blog/projects/socket-activation.html
+ constructor Bind(const anAddr: SockString; aLayer: TCrtSocketLayer=cslTCP);
/// low-level internal method called by Open() and Bind() constructors
// - raise an ECrtSocket exception on error
// - you may ask for a TLS secured client connection (only available under
@@ -361,7 +361,7 @@ TCrtSocket = class
procedure SockSend(P: pointer; Len: integer); overload;
/// flush all pending data to be sent, optionally with some body content
// - raise ECrtSocket on error
- procedure SockSendFlush(const aBody: SockString='');
+ procedure SockSendFlush(const aBody: SockString=''); virtual;
/// flush all pending data to be sent
// - returning true on success
function TrySockSendFlush: boolean;
@@ -1879,6 +1879,10 @@ THttpServer = class(THttpServerGeneric)
// - this constructor will raise a EHttpServer exception if binding failed
// - expects the port to be specified as string, e.g. '1234'; you can
// optionally specify a server address to bind to, e.g. '1.2.3.4:1234'
+ // - can listed on UDS in case port is specified with 'unix:' prefix, e.g.
+ // 'unix:/run/myapp.sock'
+ // - on Linux in case aPort is empty string will check if external fd
+ // is passed by systemd and use it (so called systemd socked activation)
// - you can specify a number of threads to be initialized to handle
// incoming connections. Default is 32, which may be sufficient for most
// cases, maximum is 256. If you set 0, the thread pool will be disabled
@@ -1890,7 +1894,8 @@ THttpServer = class(THttpServerGeneric)
// THttpServer.Create()
constructor Create(const aPort: SockString; OnStart,OnStop: TNotifyThreadEvent;
const ProcessName: SockString; ServerThreadPoolCount: integer=32;
- KeepAliveTimeOut: integer=30000; HeadersUnFiltered: boolean=false); reintroduce; virtual;
+ KeepAliveTimeOut: integer=30000; HeadersUnFiltered: boolean=false;
+ CreateSuspended: boolean = false); reintroduce; virtual;
/// ensure the HTTP server thread is actually bound to the specified port
// - TCrtSocket.Bind() occurs in the background in the Execute method: you
// should call and check this method result just after THttpServer.Create
@@ -3228,6 +3233,11 @@ function WinHTTP_WebSocketEnabled: boolean;
implementation
+{$ifdef LINUXNOTBSD}
+uses
+ SynSystemd;
+{$endif}
+
{ ************ some shared helper functions and classes }
var
@@ -4920,13 +4930,30 @@ function Split(const Text: SockString; Sep: AnsiChar; var Before,After: SockStri
result := false;
end;
-constructor TCrtSocket.Bind(const aPort: SockString; aLayer: TCrtSocketLayer);
+constructor TCrtSocket.Bind(const anAddr: SockString; aLayer: TCrtSocketLayer);
var s,p: SockString;
+ aSock: integer;
+ {$ifdef LINUXNOTBSD}
+ n: integer;
+ {$endif}
begin
Create(10000);
- if not Split(aPort,':',s,p) then begin
+ if anAddr = '' then begin // try systemd
+ {$ifdef LINUXNOTBSD}
+ if not SystemdIsAvailable then
+ raise ECrtSocket.Create('Systemd is not available but empty address is passed to bind');
+ n := sd.listen_fds(0);
+ if (n > 1) then
+ raise ECrtSocket.Create('Systemd activation fails - too many file descriptors received');
+ aSock := SD_LISTEN_FDS_START + 0;
+ {$else}
+ raise ECrtSocket.Create('Can''t bind to empty address');
+ {$endif}
+ end else begin
+ aSock := -1; // force OpenBind to create listening socket
+ if not Split(anAddr,':',s,p) then begin
s := '0.0.0.0';
- p := aPort;
+ p := anAddr;
end;
{$ifndef MSWINDOWS}
if s='unix' then begin
@@ -4935,7 +4962,8 @@ constructor TCrtSocket.Bind(const aPort: SockString; aLayer: TCrtSocketLayer);
p := '';
end;
{$endif}
- OpenBind(s,p,{dobind=}true,-1,aLayer); // raise a ECrtSocket on error
+ end;
+ OpenBind(s,p,{dobind=}true,aSock,aLayer); // raise a ECrtSocket on error
end;
constructor TCrtSocket.Open(const aServer, aPort: SockString; aLayer: TCrtSocketLayer;
@@ -4966,6 +4994,12 @@ procedure TCrtSocket.Close;
end;
if fSock<=0 then
exit; // no opened connection, or Close already executed
+ {$ifdef LINUXNOTBSD}
+ if (fWasBind and (fPort='')) then begin // binded on external socket
+ fSock := -1;
+ exit;
+ end;
+ {$endif}
{$ifdef MSWINDOWS}
if fSecure.Initialized then
fSecure.BeforeDisconnection(fSock);
@@ -5018,8 +5052,10 @@ procedure TCrtSocket.OpenBind(const aServer, aPort: SockString;
SendTimeout := TimeOut;
end;
if aLayer=cslTCP then begin
- TCPNoDelay := 1; // disable Nagle algorithm since we use our own buffers
- KeepAlive := 1; // enable TCP keepalive (even if we rely on transport layer)
+ if (aSock<0) or ((aSock>0) and not doBind) then begin // do not touch externally created socket
+ TCPNoDelay := 1; // disable Nagle algorithm since we use our own buffers
+ KeepAlive := 1; // enable TCP keepalive (even if we rely on transport layer)
+ end;
if aTLS and (aSock<=0) and not doBind then
try
{$ifdef MSWINDOWS}
@@ -6196,7 +6232,7 @@ function THttpServerGeneric.NextConnectionID: integer;
constructor THttpServer.Create(const aPort: SockString; OnStart,
OnStop: TNotifyThreadEvent; const ProcessName: SockString;
ServerThreadPoolCount: integer; KeepAliveTimeOut: integer;
- HeadersUnFiltered: boolean);
+ HeadersUnFiltered: boolean; CreateSuspended: boolean);
begin
fSockPort := aPort;
fInternalHttpServerRespList := {$ifdef FPC}TFPList{$else}TList{$endif}.Create;
@@ -6216,7 +6252,7 @@ constructor THttpServer.Create(const aPort: SockString; OnStart,
fHTTPQueueLength := 1000;
end;
fHeadersNotFiltered := HeadersUnFiltered;
- inherited Create(false,OnStart,OnStop,ProcessName);
+ inherited Create(CreateSuspended,OnStart,OnStop,ProcessName);
end;
function THttpServer.GetAPIVersion: string;
@@ -6377,6 +6413,13 @@ procedure THttpServer.Execute;
// main server process loop
try
fSock := TCrtSocket.Bind(fSockPort); // BIND + LISTEN
+ {$ifdef LINUXNOTBSD}
+ // in case we started by systemd, listening socket is created by another process
+ // and do not interrupt while process got a signal. So we need to set a timeout to
+ // unblock accept() periodically and check we need terminations
+ if fSockPort = '' then // external socket
+ fSock.ReceiveTimeout := 1000; // unblock accept every second
+ {$endif}
fExecuteState := esRunning;
if fSock.Sock<=0 then // paranoid (Bind would have raise an exception)
raise ECrtSocket.Create('THttpServer.Execute: TCrtSocket.Bind failed');
diff --git a/SynLog.pas b/SynLog.pas
index dfa8d37b3..b5bc6c1ba 100644
--- a/SynLog.pas
+++ b/SynLog.pas
@@ -465,6 +465,7 @@ TSynLogFamily = class
fExceptionIgnore: TList;
fOnBeforeException: TSynLogOnBeforeException;
fEchoToConsole: TSynLogInfos;
+ fEchoToConsoleUseJournal: boolean;
fEchoCustom: TOnTextWriterEcho;
fEchoRemoteClient: TObject;
fEchoRemoteClientOwned: boolean;
@@ -481,6 +482,7 @@ TSynLogFamily = class
procedure SetLevel(aLevel: TSynLogInfos);
procedure SynLogFileListEcho(const aEvent: TOnTextWriterEcho; aEventAdd: boolean);
procedure SetEchoToConsole(aEnabled: TSynLogInfos);
+ procedure SetEchoToConsoleUseJournal(aValue: boolean);
procedure SetEchoCustom(const aEvent: TOnTextWriterEcho);
function GetSynLogClassName: string;
function GetExceptionIgnoreCurrentThread: boolean;
@@ -571,6 +573,13 @@ TSynLogFamily = class
// - can be set e.g. to LOG_VERBOSE in order to echo every kind of events
// - EchoCustom or EchoToConsole can be activated separately
property EchoToConsole: TSynLogInfos read fEchoToConsole write SetEchoToConsole;
+ /// For Linux with journald. If true - redirect all EchoToConsole logging
+ // into journald service.
+ // - such logs can exported in format what can be viewed by LogView tool using
+ // a command (raplace UNIT with your unit name and PROCESS with executable name):
+ // "journalctl -u UNIT --no-hostname -o short-iso-precise --since today | grep "PROCESS\[.*\]: . " > todaysLog.log"
+ property EchoToConsoleUseJournal: boolean read fEchoToConsoleUseJournal
+ write SetEchoToConsoleUseJournal;
/// can be set to a callback which will be called for each log line
// - could be used with a third-party logging system
// - EchoToConsole or EchoCustom can be activated separately
@@ -1170,6 +1179,7 @@ TSynLogFile = class(TMemoryMapText)
fLogProcSortInternalOrder: TLogProcSortOrder;
/// used by ProcessOneLine//GetLogLevelTextMap
fLogLevelsTextMap: array[TSynLogInfo] of cardinal;
+ fIsJournald: boolean;
procedure SetLogProcMerged(const Value: boolean);
function GetEventText(index: integer): RawUTF8;
function GetLogLevelFromText(LineBeg: PUTF8Char): TSynLogInfo;
@@ -1578,7 +1588,11 @@ implementation
uses
SynFPCTypInfo // small wrapper unit around FPC's TypInfo.pp
{$ifdef Linux}
- , SynFPCLinux, BaseUnix, Unix, Errors, dynlibs
+ , SynFPCLinux, BaseUnix, Unix, Errors,
+ {$ifdef LINUXNOTBSD}
+ SynSystemd,
+ {$endif}
+ dynlibs
{$endif} ;
{$endif FPC}
@@ -3188,6 +3202,18 @@ procedure TSynLogFamily.SetEchoToConsole(aEnabled: TSynLogInfos);
fEchoToConsole := aEnabled;
end;
+procedure TSynLogFamily.SetEchoToConsoleUseJournal(aValue: boolean);
+begin
+ if self=nil then
+ exit;
+ {$ifdef LINUXNOTBSD}
+ if aValue and SynSystemd.SystemdIsAvailable then
+ fEchoToConsoleUseJournal := true
+ else
+ {$endif}
+ fEchoToConsoleUseJournal := false;
+end;
+
function TSynLogFamily.GetSynLogClassName: string;
begin
if self=nil then
@@ -4097,6 +4123,14 @@ function TSynLog.ConsoleEcho(Sender: TTextWriter; Level: TSynLogInfo;
result := true;
if not (Level in fFamily.fEchoToConsole) then
exit;
+ {$ifdef LINUXNOTBSD}
+ if Family.EchoToConsoleUseJournal then begin
+ // skip time "20200615 08003008 ." - journal do it for us; and first space after it
+ if length(Text) > 18 then
+ sd.journal_print(longint(LOG_TO_SYSLOG[Level]), [PUTF8Char(pointer(Text))+18]);
+ exit;
+ end;
+ {$endif}
TextColor(LOG_CONSOLE_COLORS[Level]);
{$ifdef MSWINDOWS}
tmp := CurrentAnsiConvert.UTF8ToAnsi(Text);
@@ -4105,7 +4139,7 @@ function TSynLog.ConsoleEcho(Sender: TTextWriter; Level: TSynLogInfo;
{$endif}
writeln(tmp);
{$else}
- write(Text,#13#10);
+ writeln(Text);
{$endif}
ioresult;
TextColor(ccLightGray);
@@ -5079,11 +5113,33 @@ procedure TSynLogFile.LoadFromMap(AverageLineLength: integer=32);
OK: boolean;
begin
// 1. calculate fLines[] + fCount and fLevels[] + fLogProcNatural[] from .log content
- fLineHeaderCountToIgnore := 3;
+ fLineHeaderCountToIgnore := 3; fIsJournald := false;
+ if IdemPChar(fMap.Buffer,'-- LOGS BEGIN AT') then begin
+ //-- Logs begin at Sun 2020-06-07 12:42:31 EEST, end at Thu 2020-06-18 18:08:52 EEST. --
+ fIsJournald := true;
+ fHeaderLinesCount := 1;
+ fLineHeaderCountToIgnore := 1;
+ end else begin
+ //2020-06-18T13:28:20.754089+0300 ub[12316]:
+ Iso8601ToDateTimePUTF8CharVar(fMap.Buffer,26,fStartDateTime);
+ if fStartDateTime > 0 then begin
+ fIsJournald := true;
+ fHeaderLinesCount := 0;
+ fLineHeaderCountToIgnore := 0;
+ end;
+ end;
inherited LoadFromMap(100);
// 2. fast retrieval of header
OK := false;
try
+ // journald export
+ if fIsJournald then begin
+ if LineSizeSmallerThan(1,34) then exit;
+ Iso8601ToDateTimePUTF8CharVar(fLines[1],26,fStartDateTime);
+ if fStartDateTime=0 then
+ exit;
+ end else begin
+ // SynLog original
{ C:\Dev\lib\SQLite3\exe\TestSQL3.exe 0.0.0.0 (2011-04-07 11:09:06)
Host=BW013299 User=G018869 CPU=1*0-15-1027 OS=2.3=5.1.2600 Wow64=0 Freq=3579545
TSynLog 1.13 LVCL 2011-04-07 12:04:09 }
@@ -5149,6 +5205,7 @@ procedure TSynLogFile.LoadFromMap(AverageLineLength: integer=32);
end;
if fStartDateTime=0 then
exit;
+ end;
// 3. compute fCount and fLines[] so that all fLevels[]<>sllNone
CleanLevels(self);
if Length(fLevels)-fCount>16384 then begin // size down only if worth it
@@ -5342,16 +5399,27 @@ procedure TSynLogFile.ProcessOneLine(LineBeg, LineEnd: PUTF8Char);
var thread,n: cardinal;
MS: integer;
L: TSynLogInfo;
+ p: PUTF8Char; dcOffset: integer;
begin
inherited ProcessOneLine(LineBeg,LineEnd);
if length(fLevels)50) or not (LineBeg[0] in ['0'..'9']) then
exit; // definitively does not sound like a .log content
- if LineBeg[8]=' ' then begin
+ if fIsJournald then begin
+ p := PosChar(LineBeg, ']'); //time proc[pid]:
+ if p = nil then
+ exit; // not a log
+ fLineLevelOffset := (p - LineBeg) + 4; // ": "
+ fDayCurrent := PInt64(LineBeg+dcOffset)^;
+ end else if LineBeg[8]=' ' then begin
// YYYYMMDD HHMMSS is one char bigger than Timestamp
fLineLevelOffset := 19;
fDayCurrent := PInt64(LineBeg)^;
@@ -5371,8 +5439,8 @@ procedure TSynLogFile.ProcessOneLine(LineBeg, LineEnd: PUTF8Char);
L := GetLogLevelFromText(LineBeg);
if L=sllNone then
exit;
- if (fDayChangeIndex<>nil) and (fDayCurrent<>PInt64(LineBeg)^) then begin
- fDayCurrent := PInt64(LineBeg)^;
+ if (fDayChangeIndex<>nil) and (fDayCurrent<>PInt64(LineBeg+dcOffset)^) then begin
+ fDayCurrent := PInt64(LineBeg+dcOffset)^;
AddInteger(fDayChangeIndex,fCount-1);
end;
if fThreads<>nil then begin
diff --git a/SynSystemd.pas b/SynSystemd.pas
new file mode 100644
index 000000000..85361e90e
--- /dev/null
+++ b/SynSystemd.pas
@@ -0,0 +1,154 @@
+/// curl library direct access classes
+// - this unit is a part of the freeware Synopse framework,
+// licensed under a MPL/GPL/LGPL tri-license; version 1.18
+unit SynSystemd;
+
+{
+ *****************************************************************************
+ Access to SystemD features for modern Linux using libsystemd
+
+ Features:
+ - a building block for THTTPServer socket activation
+
+ Limitations:
+ - Linux only
+
+ *****************************************************************************
+}
+
+interface
+
+{$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER
+
+uses
+ {$ifndef LINUXNOTBSD}
+ // SynSystemD is for Linux only
+ {$endif}
+ SysUtils,
+ SynCommons;
+
+const
+ /// The first passed file descriptor is fd 3
+ SD_LISTEN_FDS_START = 3;
+ /// low-level libcurl library file name, depending on the running OS
+ LIBSYSTEMD_PATH = 'libsystemd.so.0';
+ ENV_INVOCATION_ID = 'INVOCATION_ID';
+
+type
+ /// low-level exception raised during systemd library access
+ ESystemd = class(Exception);
+
+var
+ /// low-level late binding functions access to the systemd library API
+ // - ensure you called LibSystemdInitialize or SystemdIsAvailable functions to
+ // setup this global instance before using any of its internal functions
+ // - see also https://www.freedesktop.org/wiki/Software/systemd/
+ // and http://0pointer.de/blog/projects/socket-activation.html
+ // - to get a headers on debian - `sudo apt install libsystemd-dev && cd /usr/include/systemd`
+ sd: packed record
+ /// hold a reference to the loaded library
+ // - PtrInt(Module)=0 before initialization, or PtrInt(Module) = -1
+ // on initialization failure, or PtrInt(Module)>0 if loaded
+ {$ifdef FPC}
+ Module: TLibHandle;
+ {$else}
+ Module: THandle;
+ {$endif FPC}
+ /// returns how many file descriptors have been passed to process.
+ // If result=1 then socket for accepting connection is SD_LISTEN_FDS_START
+ listen_fds: function(unset_environment: integer): integer; cdecl;
+ /// returns 1 if the file descriptor is an AF_UNIX socket of the specified type and path
+ is_socket_unix: function(fd, typr, listening: integer;
+ var path: TFileName; pathLength: PtrUInt): integer; cdecl;
+ /// submit simple, plain text log entries to the system journal
+ // priority can be obtained using longint(LOG_TO_SYSLOG[logLevel])
+ journal_print: function(priority: longint; args: array of const): longint; cdecl;
+ /// sends notification to systemd. See https://www.freedesktop.org/software/systemd/man/sd_notify.html
+ // status notification sample: sd.notify(0, 'READY=1');
+ // watchdog notification: sd.notify(0, 'WATCHDOG=1');
+ notify: function(unset_environment: longint; state: PUTF8Char): longint; cdecl;
+ /// check whether the service manager expects watchdog keep-alive notifications from a service
+ // If result > 0 then usec contains notification interval (app should notify every usec\2 uniseconds)
+ watchdog_enabled: function(unset_environment: longint; usec: Puint64): longint; cdecl;
+ end;
+
+/// return TRUE if a systemd library is available
+// - will load and initialize it, calling LibSystemdInitialize if necessary,
+// catching any exception during the process
+function SystemdIsAvailable: boolean;
+
+/// Return true in case process is started by systemd
+// For systemd v232+
+function ProcessIsStartedBySystemd: boolean;
+
+/// initialize the libsystemd API
+// - do nothing if the library has already been loaded
+// - will raise ESsytemd exception on any loading issue
+procedure LibSystemdInitialize(const libname: TFileName=LIBSYSTEMD_PATH);
+
+implementation
+
+uses
+ BaseUnix,
+ SynFPCSock; // SynSockCS
+
+function SystemdIsAvailable: boolean;
+begin
+ try
+ if sd.Module=0 then
+ LibSystemdInitialize;
+ result := PtrInt(sd.Module)>0;
+ except
+ result := false;
+ end;
+end;
+
+function ProcessIsStartedBySystemd: boolean;
+begin
+ if not SystemdIsAvailable then
+ exit(false);
+ // note: for example on Ubuntu 20.04 INVOCATION_ID is always defined
+ // from the other side PPID 1 can be in case we run under docker of started by init.d
+ // so let's verify both
+ Result := (fpgetppid() = 1) and (fpGetenv(ENV_INVOCATION_ID) <> nil);
+end;
+
+procedure LibSystemdInitialize(const libname: TFileName);
+var P: PPointer;
+ api: integer;
+ h: {$ifdef FPC}TLibHandle{$else}THandle{$endif FPC};
+const NAMES: array[0..4] of string = (
+ 'sd_listen_fds', 'sd_is_socket_unix', 'sd_journal_print', 'sd_notify', 'sd_watchdog_enabled');
+begin
+ EnterCriticalSection(SynSockCS);
+ try
+ if sd.Module=0 then // try to load once
+ try
+ h := LoadLibrary(libname);
+ P := @@sd.listen_fds;
+ for api := low(NAMES) to high(NAMES) do begin
+ P^ := GetProcAddress(h,PChar(NAMES[api]));
+ if P^=nil then
+ raise ESystemd.CreateFmt('Unable to find %s() in %s',[NAMES[api],libname]);
+ inc(P);
+ end;
+ sd.Module := h;
+ except
+ on E: Exception do begin
+ if h<>0 then
+ FreeLibrary(h);
+ PtrInt(sd.Module) := -1; // <>0 so that won't try to load any more
+ raise;
+ end;
+ end;
+ finally
+ LeaveCriticalSection(SynSockCS);
+ end;
+end;
+
+finalization
+ if PtrInt(sd.Module) > 0 then begin
+ FreeLibrary(sd.Module);
+ end;
+end.
+
diff --git a/build-fpc-linux64.sh b/build-fpc-linux64.sh
index a6ca60682..dc3b310f3 100755
--- a/build-fpc-linux64.sh
+++ b/build-fpc-linux64.sh
@@ -4,4 +4,4 @@ rm -rf ./fpc/*
mkdir -p ./fpc/lib/x86_64-linux
mkdir -p ./fpc/bin/x86_64-linux
-fpc -B -MObjFPC -Scagi -Cg -Cirot -gw2 -gl -l -dFPCSQLITE3STATIC -dUseCThreads -Fi -Fifpc/lib/x86_64-linux -Fl./fpc-linux64 -Fu./SQLite3 -Fu./SQLite3/DDD/dom -Fu./SQLite3/DDD/infra "-Fu./SQLite3/Samples/33 - ECC" -Fu. -FUfpc/lib/x86_64-linux -FEfpc/bin/x86_64-linux/ ./SQLite3/TestSQL3.dpr
+fpc.sh -B -MObjFPC -Scagi -Cg -Cirot -gw2 -gl -l -dFPCSQLITE3STATIC -dUseCThreads -Fi -Fifpc/lib/x86_64-linux -Fl./fpc-linux64 -Fu./SQLite3 -Fu./SQLite3/DDD/dom -Fu./SQLite3/DDD/infra "-Fu./SQLite3/Samples/33 - ECC" -Fu. -FUfpc/lib/x86_64-linux -FEfpc/bin/x86_64-linux/ ./SQLite3/TestSQL3.dpr