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