////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// System logging routines.                                                   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20250819 - Created by A.K.                                                 //
// 20260207 - sev_INVALID,IsValidSeverity,ValidateSeverity                    //
////////////////////////////////////////////////////////////////////////////////

unit _crw_syslog; //  System Logging.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math, lazfileutils,
 _crw_alloc, _crw_rtc, _crw_ef, _crw_str, _crw_fio,
 _crw_fifo, _crw_proc, _crw_polling, _crw_uri,
 _crw_hl, _crw_sesman;

 {
 Severity granularity, i.e. number of sublevels for earch severity base level.
 }
const
 SeverityGrain = 10;

 {
 Severity Base levels.
 }
const
 seb_DEBUG = 0; // Debugging messages
 seb_INFO  = 1; // Information messages
 seb_WARN  = 2; // Warnings
 seb_ERROR = 3; // Recoverable errors
 seb_FATAL = 4; // Unrecoverable errors
 seb_OFF   = 5; // Logging is OFF
 seb_MIN   = seb_DEBUG;
 seb_MAX   = seb_OFF;
 {
 Severity levels for SysLog
 }
const // syslog severity levels - base
 sev_DEBUG   = seb_DEBUG * SeverityGrain; // Базовый уровень ОТЛАДКА
 sev_INFO    = seb_INFO  * SeverityGrain; // Базовый уровень ИНФОРМАЦИЯ
 sev_WARN    = seb_WARN  * SeverityGrain; // Базовый уровень ПРЕДУПРЕЖДЕНИЕ
 sev_ERROR   = seb_ERROR * SeverityGrain; // Базовый уровень ОШИБКА
 sev_FATAL   = seb_FATAL * SeverityGrain; // Базовый уровень ФАТАЛЬНАЯ ОШИБКА
 sev_OFF     = seb_OFF   * SeverityGrain; // Базовый уровень ЖУРНАЛ ОТКЛЮЧЕН
 sev_MIN     = sev_DEBUG;
 sev_MAX     = sev_OFF;
 sev_INVALID = sev_MIN-1;
const // syslog severity levels - named
 /////////////////////////////////// DEBUG SubLevels:
 sev_Remark      = sev_DEBUG + 1; // Пометка
 sev_Comment     = sev_DEBUG + 2; // Комментарий
 sev_Notice      = sev_DEBUG + 3; // Заметка
 sev_Mark        = sev_DEBUG + 4; // Отметка
 sev_Details     = sev_DEBUG + 5; // Детальное описание
 sev_ViewExp     = sev_DEBUG + 6; // Отладочный вывод (экспорт)
 sev_ViewImp     = sev_DEBUG + 7; // Отладочный ввод  (импорт)
 sev_Report      = sev_DEBUG + 8; // Доклад
 sev_Attention   = sev_DEBUG + 9; // Обратить внимание!
 /////////////////////////////////// INFO SubLevels:
 sev_Voice       = sev_INFO  + 1; // Звуковое сообщение
 sev_Tooltip     = sev_INFO  + 2; // Всплывающее сообщение
 sev_Input       = sev_INFO  + 3; // Ввод  Главной Консоли
 sev_Print       = sev_INFO  + 4; // Вывод Главной Консоли
 sev_Notify      = sev_INFO  + 5; // Уведомление (ЗНАЧЕНИЕ ТРИГГЕРА ПО УМОЛЧАНИЮ)
 sev_Success     = sev_INFO  + 6; // Успешное действие
 sev_Succeed     = sev_INFO  + 7; // Операция прошла успешно
 sev_Great       = sev_INFO  + 8; // Отлично
 sev_Perfect     = sev_INFO  + 9; // Идеально
 /////////////////////////////////// WARN SubLevels:
 sev_Worry       = sev_WARN  + 1; // Это вызывает беспокойство
 sev_Hazard      = sev_WARN  + 2; // Возник риск неприятностей
 sev_Disturb     = sev_WARN  + 3; // Это беспокоит и мешает
 sev_Hardship    = sev_WARN  + 4; // Возникли трудности
 sev_Problem     = sev_WARN  + 5; // Это уже проблема!
 sev_Mistimes    = sev_WARN  + 6; // Рассинхронизация часов
 sev_Exception   = sev_WARN  + 7; // Программное исключение
 sev_Watchdog    = sev_WARN  + 8; // Строжевой таймер
 sev_Alert       = sev_WARN  + 9; // Режим повышенной готовности
 /////////////////////////////////// ERROR SubLevels:
 sev_Bug         = sev_ERROR + 1; // Баг  (ожидаемая ошибка)
 sev_Glitch      = sev_ERROR + 2; // Глюк (неожиданный сбой)
 sev_Fail        = sev_ERROR + 3; // Неудачная операция
 sev_Fault       = sev_ERROR + 4; // Сбой программы/аппаратуры
 sev_Trouble     = sev_ERROR + 5; // Беда (серьезная ошибка)
 sev_Alarm       = sev_ERROR + 6; // Тревога (красная лампа)
 sev_Danger      = sev_ERROR + 7; // Тревога (опасность)
 sev_Siren       = sev_ERROR + 8; // Врубай сирену!
 sev_Critical    = sev_ERROR + 9; // Критическая ошибка
 /////////////////////////////////// FATAL SubLevels:
 sev_Failure     = sev_FATAL + 1; // Серьезный (аппаратный) сбой
 sev_Abort       = sev_FATAL + 2; // Аварийное завершение (программы)
 sev_Crash       = sev_FATAL + 3; // Крах (неожиданное падение программы)
 sev_Misfortune  = sev_FATAL + 4; // Беда, неудача
 sev_Emergency   = sev_FATAL + 5; // Чрезвычайная ситуация
 sev_Accident    = sev_FATAL + 6; // Несчастный случай
 sev_Catastrophe = sev_FATAL + 7; // Катастрофа, крупная авария
 sev_Disaster    = sev_FATAL + 8; // Бедствие, несчастье
 sev_Doomsday    = sev_FATAL + 9; // Судный день

const
 DefaultSysLogFileName = 'sys'; // File $CRW_DAQ_VAR_TMP_DIR/sys.log

type
 TSeverityBase   = seb_MIN..seb_MAX;
 TSeveritySub    = 0..SeverityGrain-1;
 TSeverityLevel  = sev_MIN..sev_MAX;

 {
 TSysLogger: system logger class.
 Format:
  TimeStamp => Severity: Sender - Body
   where
    TimeStamp: 2025.12.31-00:00:00.000
    Severity:  DEBUG|INFO|WARN|ERROR|FATAL
    Sender:    Session/Config/Device
    Body:      pct-encode(Text Message)
 Example:
  2025.12.31-00:00:00.000 => INFO: crwdaq_1/!demo/&CronSrv - Device started.
 Notes:
  1. Cookies - custom user data.
  2. LogFile,LogBuff - log fileName and fileBuffer uses to store SysLog to file.
  3. DbUri,DbTab - database URI and TableName, uses to store SysLog to DataBase.
  4. To activate file logger, assign SysLog.LogFile:='syslog';
 }
type
 TSysLogger = class;
 TSysLoggerHandler=procedure(aLogger:TSysLogger; const aContent:LongString);
 TSysLogger = class(TMasterObject)
 private
  myFifo:TFifo;
  myPolling:TPolling;
  myPrompt:LongString;
  myReserved:TCharSet;
  myTriggerLevel:Integer;
  mySessionId:LongString;
  myHandlers:TThreadList;
  mySeverityHash:THashList;
  mySeverityList:LongString;
  mySeverityIdent:array[TSeverityLevel] of LongString;
  mySeverityDelim:LongString;
  mySeveritySep:Char;
  myBodySep:LongString;
  myLogFile:LongString;
  myLogBuff:LongString;
  myCookies:LongString;
  myDbUri:LongString;
  myDbTab:LongString;
  myHost:LongString;
  mySenderSep:Char;
 private
  procedure AssignSeverityIdent(aAssignment:Boolean);
  procedure SetReserved(aReserved:TCharSet);
  procedure SetSeveritySep(aSep:Char);
  procedure SetLogFile(s:LongString);
  function  GetSessionId:LongString;
  procedure SetTriggerLevel(aLevel:Integer);
 public
  constructor Create;
  destructor  Destroy; override;
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
 public
  procedure PerformHandlers;
  function  HandlerCount:Integer;
  function  GetHandler(aIndex:Integer):TSysLoggerHandler;
  procedure AddHandler(aHandler:TSysLoggerHandler);
  procedure RemoveHandler(aHandler:TSysLoggerHandler);
  function  HasHandler(aHandler:TSysLoggerHandler):Boolean;
 public // Notable=(aSeverity>=TriggerLevel)
  function Notable(aSeverity:Integer):Boolean;
 public // Severity Level = Base * Grain + Sub.
  function StringToSeverity(const S:LongString; Def:Integer=sev_OFF):Integer;
  function GetSeverityIdent(aSeverity:Integer):LongString;
  function GetSeverityBaseIdent(aBase:Integer):LongString;
  function MakeSeverity(Base:Integer; Sub:Integer=0):Integer;
  function SeverityBase(aLevel:Integer):Integer;
  function SeveritySub(aLevel:Integer):Integer;
 public // Prompt, default is ' => '.
  property Fifo:TFifo read myFifo;
  property Polling:TPolling read myPolling;
  property SessionId:LongString read GetSessionId;
  property SeverityList:LongString read mySeverityList;
  property DbUri:LongString read myDbUri write myDbUri;
  property DbTab:LongString read myDbTab write myDbTab;
  property Prompt:LongString read myPrompt write myPrompt;
  property Cookies:LongString read myCookies write myCookies;
  property Reserved:TCharSet read myReserved write SetReserved;
  property TriggerLevel:Integer read myTriggerLevel write SetTriggerLevel;
  property SeveritySep:Char read mySeveritySep write SetSeveritySep;
  property SeverityDelim:LongString read mySeverityDelim;
  property LogFile:LongString read myLogFile write SetLogFile;
  property LogBuff:LongString read myLogBuff;
  property BodySep:LongString read myBodySep;
  property SenderSep:Char read mySenderSep;
  property Host:LongString read myHost;
 public // TimeStamp => Severity: Sender - Body
  function FormatTimeStamp(aTimeStamp:Double):LongString;
  function FormatSeverity(aSeverity:Integer):LongString;
  function FormatSender(const aSender:LongString):LongString;
  function EncodeBody(const aBody:LongString):LongString;
  function FormatBody(const aBody:LongString):LongString;
  function FormatLine(aTimeStamp:Double;
                      aSeverity:Integer;
                const aSender:LongString;
                const aBody:LongString
                     ):LongString;
 public // Parse input line SEVERITY SENDER - MESSAGE
  function ParseInputLine(const Line:LongString;
                          out aSeverity:Integer;
                          out aSender:LongString;
                          out aBody:LongString
                         ):Boolean; overload;
  function ParseInputLine(const Line:LongString;
                          out aSender:LongString;
                          out aBody:LongString
                         ):Boolean; overload;
 public // Add event to FIFO
  function Note(
               aTimeStamp:Double;
               aSeverity:Integer;
         const aSender:LongString;
         const aBody:LongString
              ):Integer;
 public // DEBUG
  function DEBUG(
                aTimeStamp:Double;
                aSeverity:Integer;
          const aSender:LongString;
          const aBody:LongString
                ):Integer; overload;
  function DEBUG(
                aSeverity:Integer;
          const aSender:LongString;
          const aBody:LongString
                ):Integer; overload;
  function DEBUG(
                aSeverity:Integer;
          const aBody:LongString
                ):Integer; overload;
  function DEBUG(
          const aSender:LongString;
          const aBody:LongString
                ):Integer; overload;
  function DEBUG(
          const aBody:LongString
                ):Integer; overload;
 public // INFO
  function INFO(
                aTimeStamp:Double;
                aSeverity:Integer;
          const aSender:LongString;
          const aBody:LongString
                ):Integer; overload;
  function INFO(
                aSeverity:Integer;
          const aSender:LongString;
          const aBody:LongString
                ):Integer; overload;
  function INFO(
                aSeverity:Integer;
          const aBody:LongString
                ):Integer; overload;
  function INFO(
          const aSender:LongString;
          const aBody:LongString
                ):Integer; overload;
  function INFO(
          const aBody:LongString
                ):Integer; overload;
 public // WARN
  function WARN(
                aTimeStamp:Double;
                aSeverity:Integer;
          const aSender:LongString;
          const aBody:LongString
                ):Integer; overload;
  function WARN(
                aSeverity:Integer;
          const aSender:LongString;
          const aBody:LongString
                ):Integer; overload;
  function WARN(
                aSeverity:Integer;
          const aBody:LongString
                ):Integer; overload;
  function WARN(
          const aSender:LongString;
          const aBody:LongString
                ):Integer; overload;
  function WARN(
          const aBody:LongString
                ):Integer; overload;
 public // ERROR
  function ERROR(
                aTimeStamp:Double;
                aSeverity:Integer;
          const aSender:LongString;
          const aBody:LongString
                ):Integer; overload;
  function ERROR(
                aSeverity:Integer;
          const aSender:LongString;
          const aBody:LongString
                ):Integer; overload;
  function ERROR(
                aSeverity:Integer;
          const aBody:LongString
                ):Integer; overload;
  function ERROR(
          const aSender:LongString;
          const aBody:LongString
                ):Integer; overload;
  function ERROR(
          const aBody:LongString
                ):Integer; overload;
 public // FATAL
  function FATAL(
                aTimeStamp:Double;
                aSeverity:Integer;
          const aSender:LongString;
          const aBody:LongString
                ):Integer; overload;
  function FATAL(
                aSeverity:Integer;
          const aSender:LongString;
          const aBody:LongString
                ):Integer; overload;
  function FATAL(
                aSeverity:Integer;
          const aBody:LongString
                ):Integer; overload;
  function FATAL(
          const aSender:LongString;
          const aBody:LongString
                ):Integer; overload;
  function FATAL(
          const aBody:LongString
                ):Integer; overload;
 public
  class function IsValidSeverity(aSeverity:Integer):Boolean;
  class function ValidateSeverity(aSeverity,aDefault:Integer):Integer;
 end;

 {
 SysLog: the only one instance of TSysLogger.
 }
function SysLog:TSysLogger;

 {
 FIFO/File buffer constants
 }
const
 SysLogFileBuffSize = KiloByte*48;   // File buffer, up to 65355 bytes
 SysLogDefFifoSize  = KiloByte*64;   // Initial SysLog FIFO size bytes
 SysLogDefGrowLimit = MegaByte*256;  // Maximal SysLog FIFO size bytes

 {
 Default handlers.
 }
procedure DefaultSysLogFileHandler(aLogger:TSysLogger; const aContent:LongString);

function DefaultSysLogNotable(Severity:Integer):Boolean;

function DefaultSysLogNote(TimeStamp:Double; Severity:Integer;
                           const Sender,Body:LongString):Integer;

implementation

 ///////////////////
 // Default handlers
 ///////////////////
function DefaultSysLogNotable(Severity:Integer):Boolean;
begin
 Result:=SysLog.Notable(Severity);
end;

function DefaultSysLogNote(TimeStamp:Double; Severity:Integer;
                           const Sender,Body:LongString):Integer;
begin
 Result:=SysLog.Note(TimeStamp,Severity,Sender,Body);
end;

 /////////////////////////////////
 // Polling handler for TSysLogger
 /////////////////////////////////
procedure SysLogPolling(aPolling:TPolling; var Terminate:Boolean);
var Obj:TObject;
begin
 if Assigned(aPolling) then Obj:=aPolling.LinkObject else Obj:=nil;
 if (Obj is TSysLogger) then TSysLogger(Obj).PerformHandlers;
end;

procedure HandleIoError(aLogger:TSysLogger; aError:Integer);
var Err,Msg:LongString;
begin
 if (aError<>0) then
 if Assigned(aLogger) then begin
  Err:=FpcRunErrorCodeToString(aError);
  Msg:=Format('IoResult[%d]: %s.',[aError,Err]);
  aLogger.ERROR(sev_Fail,'SysLog',Msg);
 end;
end;

procedure DefaultSysLogFileHandler(aLogger:TSysLogger; const aContent:LongString);
var F:Text; IOR,Code,Size:Integer; LogFile,LogBuff,Dir:LongString; Buff:PChar;
begin
 if (aContent<>'') then
 if Assigned(aLogger) then
 try
  LogFile:=aLogger.LogFile;
  LogBuff:=aLogger.LogBuff;
  if (LogFile='') then Exit;
  Dir:=ExtractFileDir(LogFile);
  if not DirExists(Dir) then Exit;
  IOR:=IoResult; SetInOutRes(0);
  System.Assign(F,LogFile);
  try
   if FileExists(LogFile)
   then System.Append(F)
   else System.Rewrite(F);
   if (LogBuff<>'') then begin
    Buff:=PChar(LogBuff);
    Size:=Length(LogBuff);
    SetTextBuf(F,Buff^,Size);
   end;
   Write(F,aContent);
   Code:=IoResult;
   if (Code<>0) then HandleIoError(aLogger,Code);
  finally
   SmartFileClose(F);
   SetInOutRes(IOR);
  end;
 except
  on E:Exception do BugReport(E,aLogger,'DefaultSysLogFileHandler');
 end;
end;

 ////////////////////////////
 // TSysLogger implementation
 ////////////////////////////
constructor TSysLogger.Create;
begin
 inherited Create;
 myPrompt:=' => ';
 myBodySep:=' - ';
 mySenderSep:='/';
 mySeveritySep:='/';
 mySeverityDelim:=': ';
 myTriggerLevel:=sev_OFF;
 myHost:=LoCaseStr(HostName);
 myReserved:=PosixCntrl+['%'];
 myHandlers:=TThreadList.Create;
 mySessionId:=SessionManager.SessionHead;
 myFifo:=NewFifo(SysLogDefFifoSize,'SysLog',2);
 myFifo.GrowLimit:=SysLogDefGrowLimit;
 myFifo.Master:=@myFifo;
 myPolling:=NewPolling(SysLogPolling,1000,tpNormal,False,'SysLog');
 myPolling.Master:=@myPolling;
 myPolling.LinkObject:=Self;
 mySeverityHash:=NewHashList(false,HashList_DefaultHasher);
 mySeverityHash.Master:=@mySeverityHash;
 mySeverityList:='';
 myLogFile:='';
 myLogBuff:='';
 myCookies:='';
 myDbUri:='';
 myDbTab:='';
end;

destructor TSysLogger.Destroy;
begin
 myHost:='';
 myDbUri:='';
 myDbTab:='';
 Kill(myFifo);
 myPrompt:='';
 myBodySep:='';
 myCookies:='';
 myLogFile:='';
 myLogBuff:='';
 mySessionId:='';
 Kill(myPolling);
 Kill(myHandlers);
 mySeverityList:='';
 mySeverityDelim:='';
 Kill(mySeverityHash);
 inherited Destroy;
end;

procedure TSysLogger.AfterConstruction;
begin
 inherited AfterConstruction;
 AssignSeverityIdent(True);
 Polling.Enabled:=True;
 Reserved:=[];
end;

procedure TSysLogger.BeforeDestruction;
begin
 Polling.Enabled:=False;
 AssignSeverityIdent(False);
 inherited BeforeDestruction;
end;

procedure TSysLogger.AssignSeverityIdent(aAssignment:Boolean);
var sl:TSeverityLevel; Base,Sub:Integer; sep:Char; sn:LongString;
begin
 if (Self=nil) then Exit;
 mySeverityList:=''; mySeverityHash.Clear;
 for sl:=Low(mySeverityIdent) to High(mySeverityIdent) do begin
  mySeverityIdent[sl]:=''; if not aAssignment then continue;
  Base:=SeverityBase(sl); if (Base>seb_OFF) then continue;
  mySeverityIdent[sl]:=GetSeverityBaseIdent(Base);
  Sub:=SeveritySub(sl); if (Sub=0) then continue;
  sep:=SeveritySep; sn:=Format('Level%d',[Sub]);
  case sl of
   sev_Remark      : sn:='Remark';
   sev_Comment     : sn:='Comment';
   sev_Notice      : sn:='Notice';
   sev_Mark        : sn:='Mark';
   sev_Details     : sn:='Details';
   sev_ViewExp     : sn:='ViewExp';
   sev_ViewImp     : sn:='ViewImp';
   sev_Report      : sn:='Report';
   sev_Attention   : sn:='Attention';
   sev_Voice       : sn:='Voice';
   sev_Tooltip     : sn:='Tooltip';
   sev_Input       : sn:='Input';
   sev_Print       : sn:='Print';
   sev_Notify      : sn:='Notify';
   sev_Success     : sn:='Success';
   sev_Succeed     : sn:='Succeed';
   sev_Great       : sn:='Great';
   sev_Perfect     : sn:='Perfect';
   sev_Worry       : sn:='Worry';
   sev_Hazard      : sn:='Hazard';
   sev_Disturb     : sn:='Disturb';
   sev_Hardship    : sn:='Hardship';
   sev_Problem     : sn:='Problem';
   sev_Mistimes    : sn:='Mistimes';
   sev_Exception   : sn:='Exception';
   sev_Watchdog    : sn:='Watchdog';
   sev_Alert       : sn:='Alert';
   sev_Bug         : sn:='Bug';
   sev_Glitch      : sn:='Glitch';
   sev_Fail        : sn:='Fail';
   sev_Fault       : sn:='Fault';
   sev_Trouble     : sn:='Trouble';
   sev_Alarm       : sn:='Alarm';
   sev_Danger      : sn:='Danger';
   sev_Siren       : sn:='Siren';
   sev_Critical    : sn:='Critical';
   sev_Failure     : sn:='Failure';
   sev_Abort       : sn:='Abort';
   sev_Crash       : sn:='Crash';
   sev_Misfortune  : sn:='Misfortune';
   sev_Emergency   : sn:='Emergency';
   sev_Accident    : sn:='Accident';
   sev_Catastrophe : sn:='Catastrophe';
   sev_Disaster    : sn:='Disaster';
   sev_Doomsday    : sn:='Doomsday';
  end;
  sn:=UpCaseStr(sn);
  mySeverityIdent[sl]:=mySeverityIdent[sl]+sep+sn;
 end;
 if aAssignment then
 for sl:=Low(mySeverityIdent) to High(mySeverityIdent) do begin
  sn:=Format('%-2d %s',[sl,mySeverityIdent[sl]]);
  mySeverityList:=mySeverityList+sn+EOL;
  mySeverityHash.KeyedLinks[IntToStr(sl)]:=sl;
  mySeverityHash.KeyedLinks[mySeverityIdent[sl]]:=sl;
  Base:=SeverityBase(sl); Sub:=SeveritySub(sl);
  sn:=GetSeverityBaseIdent(Base)+SeveritySep;
  mySeverityHash.KeyedLinks[sn+IntToStr(Sub)]:=sl;
  mySeverityHash.KeyedLinks[sn+'Level'+IntToStr(Sub)]:=sl;
 end;
end;

procedure TSysLogger.SetReserved(aReserved:TCharSet);
begin
 myReserved:=aReserved+PosixCntrl; // Always includes control chars
 Include(myReserved,'%');          // And Percent char must present
end;

procedure TSysLogger.SetSeveritySep(aSep:Char);
begin
 mySeveritySep:=aSep;
 AssignSeverityIdent(True);
end;

function TSysLogger.ParseInputLine(const Line:LongString;
                                   out aSeverity:Integer;
                                   out aSender:LongString;
                                   out aBody:LongString
                                  ):Boolean;
var p,sel:Integer; hdr,sev,sen,bod:LongString;
begin
 Result:=False;
 aSeverity:=sev_OFF;
 aSender:=''; aBody:='';
 if not Assigned(Self) then Exit;
 p:=Pos(BodySep,Line);
 if (p>1) then begin
  hdr:=LeftStr(Line,p-1);
  if (WordCount(hdr,PosixBlank)=2) then begin
   sev:=ExtractWord(1,hdr,PosixBlank);
   sen:=ExtractWord(2,hdr,PosixBlank);
   bod:=TailStr(Line,p+Length(BodySep));
   if (bod<>'') then begin
    sel:=SysLog.StringToSeverity(sev);
    aSeverity:=sel; aSender:=sen; aBody:=bod;
    Result:=InRange(aSeverity,sev_MIN,Pred(sev_MAX));
   end;
  end;
 end;
end;

function TSysLogger.ParseInputLine(const Line:LongString;
                                   out aSender:LongString;
                                   out aBody:LongString
                                  ):Boolean;
var p:Integer; hdr,sen,bod:LongString;
begin
 Result:=False;
 aSender:=''; aBody:='';
 if not Assigned(Self) then Exit;
 p:=Pos(BodySep,Line);
 if (p>1) then begin
  hdr:=LeftStr(Line,p-1);
  if (WordCount(hdr,PosixBlank)=1) then begin
   sen:=ExtractWord(1,hdr,PosixBlank);
   bod:=TailStr(Line,p+Length(BodySep));
   if (sen<>'') and (bod<>'') then begin
    aSender:=sen; aBody:=bod;
    Result:=True;
   end;
  end;
 end;
end;

procedure TSysLogger.SetLogFile(s:LongString);
var pe:Boolean;
begin
 s:=Trim(s);
 if (s<>'') and IsUnix then s:=LoCaseStr(s);
 if (s<>'') then s:=Trim(ExtractBaseName(s));
 if (s<>'') then s:=ForceExtension(s,'.log');
 if (SessionManager.VarTmpDir='') then s:='';
 if (s<>'') then s:=SessionManager.VarTmpFile(s);
 pe:=Polling.Enabled;
 try
  Polling.Enabled:=False;
  if (s<>'') then begin
   myLogBuff:=StringBuffer(SysLogFileBuffSize);
   AddHandler(DefaultSysLogFileHandler);
  end else begin
   RemoveHandler(DefaultSysLogFileHandler);
   myLogBuff:='';
  end;
 finally
  Polling.Enabled:=pe;
 end;
 myLogFile:=s;
end;

procedure TSysLogger.SetTriggerLevel(aLevel:Integer);
begin
 myTriggerLevel:=EnsureRange(aLevel,sev_MIN,sev_MAX);
end;

function TSysLogger.Notable(aSeverity:Integer):Boolean;
begin
 aSeverity:=EnsureRange(aSeverity,sev_MIN,sev_MAX);
 if (aSeverity=sev_OFF) then Exit(False);
 Result:=(aSeverity>=TriggerLevel);
end;

function TSysLogger.GetSessionId:LongString;
begin
 if (mySessionId='') then mySessionId:=SessionManager.SessionHead;
 Result:=mySessionId;
end;

procedure TSysLogger.PerformHandlers;
var i:Integer; aContent:LongString; Handler:TSysLoggerHandler;
begin
 if Assigned(Self) then
 try
  aContent:=Fifo.GetText;
  if (aContent<>'') then
  for i:=0 to HandlerCount-1 do begin
   Handler:=GetHandler(i);
   if Assigned(Handler)
   then Handler(Self,aContent)
   else Break;
   Polling.WdtReset;
  end;
  Polling.WdtReset;
 except
  on E:Exception do BugReport(E,Self,'PerformHandlers');
 end;
end;

function TSysLogger.HandlerCount:Integer;
begin
 Result:=0;
 if Assigned(Self) then
 try
  with myHandlers.LockList do
  try
   Result:=Count;
  finally
   myHandlers.UnlockList;
  end;
 except
  on E:Exception do BugReport(E,Self,'HandlerCount');
 end;
end;

function TSysLogger.GetHandler(aIndex:Integer):TSysLoggerHandler;
begin
 Result:=nil;
 if Assigned(Self) then
 try
  with myHandlers.LockList do
  try
   if InRange(aIndex,0,Count-1)
   then  Result:=Items[aIndex];
  finally
   myHandlers.UnlockList;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetHandler');
 end;
end;

function TSysLogger.HasHandler(aHandler:TSysLoggerHandler):Boolean;
begin
 Result:=False;
 if Assigned(Self) then
 try
  if Assigned(aHandler) then
  with myHandlers.LockList do
  try
   Result:=(IndexOf(@aHandler)>=0);
  finally
   myHandlers.UnlockList;
  end;
 except
  on E:Exception do BugReport(E,Self,'HasHandler');
 end;
end;

procedure TSysLogger.AddHandler(aHandler:TSysLoggerHandler);
begin
 if Assigned(Self) then
 try
  if Assigned(aHandler) then
  with myHandlers.LockList do
  try
   if (IndexOf(@aHandler)<0) then Add(@aHandler);
  finally
   myHandlers.UnlockList;
  end;
 except
  on E:Exception do BugReport(E,Self,'AddHandler');
 end;
end;

procedure TSysLogger.RemoveHandler(aHandler:TSysLoggerHandler);
begin
 if Assigned(Self) then
 try
  if Assigned(aHandler) then
  with myHandlers.LockList do
  try
   if (IndexOf(@aHandler)>=0) then Remove(@aHandler);
  finally
   myHandlers.UnlockList;
  end;
 except
  on E:Exception do BugReport(E,Self,'AddHandler');
 end;
end;

function TSysLogger.GetSeverityIdent(aSeverity:Integer):LongString;
begin
 Result:='';
 if InRange(aSeverity,sev_MIN,sev_MAX)
 then Result:=mySeverityIdent[aSeverity];
end;

function TSysLogger.GetSeverityBaseIdent(aBase:Integer):LongString;
begin
 Result:='';
 case aBase of
  seb_DEBUG: Result:='DEBUG';
  seb_INFO:  Result:='INFO';
  seb_WARN:  Result:='WARN';
  seb_ERROR: Result:='ERROR';
  seb_Fatal: Result:='FATAL';
  seb_OFF:   Result:='OFF';
 end;
end;

function TSysLogger.StringToSeverity(const S:LongString; Def:Integer=sev_OFF):Integer;
var i:Integer;
begin
 Result:=Def; i:=-1;
 if not Assigned(Self) then Exit;
 if (S<>'') then i:=mySeverityHash.IndexOf(S);
 if (i>=0) then Result:=mySeverityHash.Links[i];
end;

function TSysLogger.MakeSeverity(Base:Integer; Sub:Integer=0):Integer;
begin
 Base:=EnsureRange(Base,seb_MIN,seb_MAX);
 Sub:=EnsureRange(Sub,0,SeverityGrain-1);
 Result:=Base*SeverityGrain+Sub;
end;

function TSysLogger.SeverityBase(aLevel:Integer):Integer;
begin
 aLevel:=EnsureRange(aLevel,sev_MIN,sev_MAX);
 Result:=(aLevel div SeverityGrain);
end;

function TSysLogger.SeveritySub(aLevel:Integer):Integer;
begin
 aLevel:=EnsureRange(aLevel,sev_MIN,sev_MAX);
 Result:=(aLevel mod SeverityGrain);
end;

function TSysLogger.FormatTimeStamp(aTimeStamp:Double):LongString;
begin
 if (aTimeStamp=0) then aTimeStamp:=mSecNow;
 Result:=StdDateTimeStr(aTimeStamp,nttsm_DateTimeZzz);
end;

function TSysLogger.FormatSeverity(aSeverity:Integer):LongString;
begin
 Result:=GetSeverityIdent(aSeverity);
 if (Result<>'') then Result:=Result+SeverityDelim;
end;

procedure ValidateSender(var S:LongString);
const Spaces=PosixCntrl+PosixSpace; Filler='_';
var i:Integer;
begin
 if HasChars(S,Spaces) then begin
  S:=Trim(S);
  for i:=1 to Length(S) do
  if (S[i] in Spaces) then S[i]:=Filler;
 end;
end;

function TSysLogger.FormatSender(const aSender:LongString):LongString;
begin
 Result:=Host; if (Result<>'') then Result:=Result+SenderSep;
 if (aSender='')
 then Result:=Result+SessionId
 else Result:=Result+SessionId+SenderSep+aSender;
 ValidateSender(Result);
end;

function TSysLogger.EncodeBody(const aBody:LongString):LongString;
begin
 Result:=aBody;
 if HasChars(Result,Reserved)
 then Result:=Percent_Encode(Result,myReserved);
end;

function TSysLogger.FormatBody(const aBody:LongString):LongString;
begin
 if (aBody='')
 then Result:=''
 else Result:=BodySep+EncodeBody(aBody);
end;

function TSysLogger.FormatLine(
                               aTimeStamp:Double;
                               aSeverity:Integer;
                         const aSender:LongString;
                         const aBody:LongString
                               ):LongString;
begin
 Result:=FormatTimeStamp(aTimeStamp)+Prompt+FormatSeverity(aSeverity)
        +FormatSender(aSender)+FormatBody(aBody);
end;

function TSysLogger.Note(
                         aTimeStamp:Double;
                         aSeverity:Integer;
                   const aSender:LongString;
                   const aBody:LongString
                        ):Integer;
var Line:LongString; Leng:Integer; const LenEOL=Length(EOL);
begin
 Result:=0;
 if not Notable(aSeverity) then Exit;
 Line:=FormatLine(aTimeStamp,aSeverity,aSender,aBody);
 Leng:=Length(Line); if (Leng=0) then Exit;
 if Fifo.PutText(Line+EOL)
 then Result:=Leng+LenEOL;
end;

function TSysLogger.DEBUG(
                         aTimeStamp:Double;
                         aSeverity:Integer;
                   const aSender:LongString;
                   const aBody:LongString
                        ):Integer;
var aSub:Integer;
begin
 aSub:=SeveritySub(aSeverity);
 Result:=Note(aTimeStamp,MakeSeverity(seb_DEBUG,aSub),aSender,aBody);
end;

function TSysLogger.DEBUG(
                         aSeverity:Integer;
                   const aSender:LongString;
                   const aBody:LongString
                        ):Integer;
var aSub:Integer;
begin
 aSub:=SeveritySub(aSeverity);
 Result:=Note(0,MakeSeverity(seb_DEBUG,aSub),aSender,aBody);
end;

function TSysLogger.DEBUG(
                         aSeverity:Integer;
                   const aBody:LongString
                        ):Integer;
var aSub:Integer;
begin
 aSub:=SeveritySub(aSeverity);
 Result:=Note(0,MakeSeverity(seb_DEBUG,aSub),'',aBody);
end;

function TSysLogger.DEBUG(
                   const aSender:LongString;
                   const aBody:LongString
                        ):Integer;
begin
 Result:=Note(0,MakeSeverity(seb_DEBUG,0),aSender,aBody);
end;

function TSysLogger.DEBUG(
                   const aBody:LongString
                        ):Integer;
begin
 Result:=Note(0,MakeSeverity(seb_DEBUG,0),'',aBody);
end;

function TSysLogger.INFO(
                         aTimeStamp:Double;
                         aSeverity:Integer;
                   const aSender:LongString;
                   const aBody:LongString
                        ):Integer;
var aSub:Integer;
begin
 aSub:=SeveritySub(aSeverity);
 Result:=Note(aTimeStamp,MakeSeverity(seb_INFO,aSub),aSender,aBody);
end;

function TSysLogger.INFO(
                         aSeverity:Integer;
                   const aSender:LongString;
                   const aBody:LongString
                        ):Integer;
var aSub:Integer;
begin
 aSub:=SeveritySub(aSeverity);
 Result:=Note(0,MakeSeverity(seb_INFO,aSub),aSender,aBody);
end;

function TSysLogger.INFO(
                         aSeverity:Integer;
                   const aBody:LongString
                        ):Integer;
var aSub:Integer;
begin
 aSub:=SeveritySub(aSeverity);
 Result:=Note(0,MakeSeverity(seb_INFO,aSub),'',aBody);
end;

function TSysLogger.INFO(
                   const aSender:LongString;
                   const aBody:LongString
                        ):Integer;
begin
 Result:=Note(0,MakeSeverity(seb_INFO,0),aSender,aBody);
end;

function TSysLogger.INFO(
                   const aBody:LongString
                        ):Integer;
begin
 Result:=Note(0,MakeSeverity(seb_INFO,0),'',aBody);
end;

function TSysLogger.WARN(
                         aTimeStamp:Double;
                         aSeverity:Integer;
                   const aSender:LongString;
                   const aBody:LongString
                        ):Integer;
var aSub:Integer;
begin
 aSub:=SeveritySub(aSeverity);
 Result:=Note(aTimeStamp,MakeSeverity(seb_WARN,aSub),aSender,aBody);
end;

function TSysLogger.WARN(
                         aSeverity:Integer;
                   const aSender:LongString;
                   const aBody:LongString
                        ):Integer;
var aSub:Integer;
begin
 aSub:=SeveritySub(aSeverity);
 Result:=Note(0,MakeSeverity(seb_WARN,aSub),aSender,aBody);
end;

function TSysLogger.WARN(
                         aSeverity:Integer;
                   const aBody:LongString
                        ):Integer;
var aSub:Integer;
begin
 aSub:=SeveritySub(aSeverity);
 Result:=Note(0,MakeSeverity(seb_WARN,aSub),'',aBody);
end;

function TSysLogger.WARN(
                   const aSender:LongString;
                   const aBody:LongString
                        ):Integer;
begin
 Result:=Note(0,MakeSeverity(seb_WARN,0),aSender,aBody);
end;

function TSysLogger.WARN(
                   const aBody:LongString
                        ):Integer;
begin
 Result:=Note(0,MakeSeverity(seb_WARN,0),'',aBody);
end;

function TSysLogger.ERROR(
                         aTimeStamp:Double;
                         aSeverity:Integer;
                   const aSender:LongString;
                   const aBody:LongString
                        ):Integer;
var aSub:Integer;
begin
 aSub:=SeveritySub(aSeverity);
 Result:=Note(aTimeStamp,MakeSeverity(seb_ERROR,aSub),aSender,aBody);
end;

function TSysLogger.ERROR(
                         aSeverity:Integer;
                   const aSender:LongString;
                   const aBody:LongString
                        ):Integer;
var aSub:Integer;
begin
 aSub:=SeveritySub(aSeverity);
 Result:=Note(0,MakeSeverity(seb_ERROR,aSub),aSender,aBody);
end;

function TSysLogger.ERROR(
                         aSeverity:Integer;
                   const aBody:LongString
                        ):Integer;
var aSub:Integer;
begin
 aSub:=SeveritySub(aSeverity);
 Result:=Note(0,MakeSeverity(seb_ERROR,aSub),'',aBody);
end;

function TSysLogger.ERROR(
                   const aSender:LongString;
                   const aBody:LongString
                        ):Integer;
begin
 Result:=Note(0,MakeSeverity(seb_ERROR,0),aSender,aBody);
end;

function TSysLogger.ERROR(
                   const aBody:LongString
                        ):Integer;
begin
 Result:=Note(0,MakeSeverity(seb_ERROR,0),'',aBody);
end;

function TSysLogger.FATAL(
                         aTimeStamp:Double;
                         aSeverity:Integer;
                   const aSender:LongString;
                   const aBody:LongString
                        ):Integer;
var aSub:Integer;
begin
 aSub:=SeveritySub(aSeverity);
 Result:=Note(aTimeStamp,MakeSeverity(seb_FATAL,aSub),aSender,aBody);
end;

function TSysLogger.FATAL(
                         aSeverity:Integer;
                   const aSender:LongString;
                   const aBody:LongString
                        ):Integer;
var aSub:Integer;
begin
 aSub:=SeveritySub(aSeverity);
 Result:=Note(0,MakeSeverity(seb_FATAL,aSub),aSender,aBody);
end;

function TSysLogger.FATAL(
                         aSeverity:Integer;
                   const aBody:LongString
                        ):Integer;
var aSub:Integer;
begin
 aSub:=SeveritySub(aSeverity);
 Result:=Note(0,MakeSeverity(seb_FATAL,aSub),'',aBody);
end;

function TSysLogger.FATAL(
                   const aSender:LongString;
                   const aBody:LongString
                        ):Integer;
begin
 Result:=Note(0,MakeSeverity(seb_FATAL,0),aSender,aBody);
end;

function TSysLogger.FATAL(
                   const aBody:LongString
                        ):Integer;
begin
 Result:=Note(0,MakeSeverity(seb_FATAL,0),'',aBody);
end;

class function TSysLogger.IsValidSeverity(aSeverity:Integer):Boolean;
begin
 Result:=InRange(aSeverity,sev_MIN,sev_MAX);
end;

class function TSysLogger.ValidateSeverity(aSeverity,aDefault:Integer):Integer;
begin
 Result:=aSeverity;
 if not InRange(aSeverity,sev_MIN,sev_MAX)
 then Result:=EnsureRange(aDefault,sev_MIN,sev_MAX);
end;

////////////////////////
// SysLog implementation
////////////////////////
function SysLog:TSysLogger;
const SLog:TSysLogger=nil;
begin
 if (SLog=nil) then begin
  SLog:=TSysLogger.Create;
  SLog.Master:=@SLog;
 end;
 Result:=SLog;
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_syslog;
begin
 SysLog.Ok;
 SeverityOfHarmBugs:=sev_Exception;
 if not Assigned(TheSysLogNotableCallback)
 then TheSysLogNotableCallback:=DefaultSysLogNotable;
 if not Assigned(TheSysLogNoteCallback)
 then TheSysLogNoteCallback:=DefaultSysLogNote;
end;

procedure Free_crw_syslog;
begin
 if (@TheSysLogNotableCallback=@DefaultSysLogNotable)
 then TheSysLogNotableCallback:=nil;
 if (@TheSysLogNoteCallback=@DefaultSysLogNote)
 then TheSysLogNoteCallback:=nil;
 SysLog.Free;
end;

initialization

 Init_crw_syslog;

finalization

 Free_crw_syslog;

end.

//////////////
// END OF FILE
//////////////

