////////////////////////////////////////////////////////////////////////////////
// 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:                                                                   //
// Session manager routines.                                                  //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20231009 - Created by A.K.                                                 //
// 20231017 - 1st release.                                                    //
// 20240730 - TitlePidAtHost,SessionHead                                      //
// 20240801 - SessionSign                                                     //
// 20260227 - use QueryProcessState and ProcessStateIsAlive                   //
////////////////////////////////////////////////////////////////////////////////

unit _crw_sesman; //  Session manager routines.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

{$WARN 5023 off : Unit "$1" not used in $2}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math, simpleipc,
 _crw_alloc, _crw_cmdargs, _crw_environ, _crw_str, _crw_fio, _crw_ef,
 _crw_spcfld, _crw_polling, _crw_guard, _crw_snd, _crw_proc;

const              // Mode of SessionManager.DetectRunningPid(..):
 sm_CheckOnly = 0; // Check running.pid file only, don't delete/write file.
 sm_ClearDead = 1; // Clear (delete) running.pid file if process not running.
 sm_LockFirst = 2; // Lock (write) running.pid file if process not running.

const                        // Session manage commands:
 smc_Activate = '@Activate'; // Command to activate primary session from child.
 smc_Incoming = '@Incoming'; // Command received from external application.

 ///////////////////////////////////////////////////////////////////////////////
 // TSessionManager
 ///////////////////////////////////////////////////////////////////////////////
 // SessionManager calculate user config/data directories required for sessions.
 // Application may run single instance of each session identified by SessionNb.
 // Usually application uses default SessionNb (1) or get SessionNb from command
 // line options like  AppName --session=2   or   AppName --session 1   command.
 // Fields:
 //  SessionNb        - session identify number, default = 1
 //  SessionID        - VendorName_ApplicationName_DefSessionPrefix_SessionNb
 //  SessionPID       - PID of process who owns the session
 //  VendorName       - vendor identifier, default = daqgroup
 //  ApplicationName  - application identifier, usually executable base filename
 //  SessionSubFolder - VendorName/ApplicationName/DefSessionPrefix_SessionNb
 //  LocalConfigDir   - local user config dir: for program configuration files
 //  LocalDataDir     - local user data   dir: for program related data  files
 //  SystemTmpDir     - system temporary dir:  may be cleanup after reboot
 //  VarTmpDir        - var    temporary dir:  should be kept after reboot
 //  RuntimeDir       - runtime only dir:      should cleanup after reboot
 //  RunningPidFile   - running.pid file:      contain running process PID
 // Example: run    crwtestbench --session 1
 //  SessionNb      = 1
 //  SessionID      = daqgroup_crwtestbench_session_1
 //  SessionPID     = 4123
 //  SessionSign    = crwtestbench#1
 //  SessionHead    = crwtestbench_1
 //  LocalDataDir   = /home/alex/.local/share/daqgroup/crwtestbench/session_1
 //  LocalConfigDir = /home/alex/.config/daqgroup/crwtestbench/session_1
 //  SystemTmpDir   = /tmp/user-alex/daqgroup/crwtestbench/session_1
 //  VarTmpDir      = /var/tmp/user-alex/daqgroup/crwtestbench/session_1
 //  RuntimeDir     = /run/user/1000/daqgroup/crwtestbench/session_1
 //  RunningPidFile = /run/user/1000/daqgroup/crwtestbench/session_1/running.pid
 // Initialization:
 //  1) By default, SessionManager is not initialized.
 //     You should call SessionManager.Start(..) first.
 //  2) To initialize by cmdline, call: SessionManager.Start('$ 1').
 //     By default, uses options [-session;--session;-number;--number].
 //  3) To initialize by known SessionNb, call: SessionManager.Start(IntToStr(Nb)).
 //     By default (if empty arguments) uses Nb = 1.
 //  4) To initialize unknown SessionNb, call: SessionManager.Init('? 100').
 //     It found first unused Nb in range [1..100].
 // Program Example:
 //  program demo;
 //  uses ..,_crw_sesman;
 //  begin
 //   if not SessionManager.Start('$ 1') then begin
 //    writeln('Program already running.');
 //    Exit;
 //   end;
 //   Application.Run;
 //  end.
 ///////////////////////////////////////////////////////////////////////////////
type
 TSessionManager = class(TMasterObject)
 private
  mySessionNb        : LongInt;
  mySessionID        : LongString;
  myPidAtHost        : LongString;
  mySessionPID       : TPid;
  mySessionSign      : LongString;
  mySessionHead      : LongString;
  myVendorName       : LongString;
  myApplicationName  : LongString;
  mySessionSubFolder : LongString;
  myLocalConfigDir   : LongString;
  myLocalDataDir     : LongString;
  mySystemTmpDir     : LongString;
  myVarTmpDir        : LongString;
  myRuntimeDir       : LongString;
  myRunningPidFile   : LongString;
  myIpcServer        : TSimpleIpcServer;
  myIpcClient        : TSimpleIpcClient;
  myCmdActivate      : LongString;
 private
  procedure ClearAll;
  procedure ClearRunningPid;
  function  GetSessionNb:LongInt;
  function  GetSessionID:LongString;
  function  GetPidAtHost:LongString;
  function  GetSessionPID:TPid;
  function  GetSessionStarted:Boolean;
  function  GetVendorName:LongString;
  function  GetApplicationName:LongString;
  function  GetSessionSubFolder:LongString;
  function  GetIpcServer:TSimpleIpcServer;
  function  GetIpcClient:TSimpleIpcClient;
  function  GetIpcPipeId:LongString;
 public
  constructor Create;
  destructor  Destroy; override;
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
 public
  property  SessionNb:LongInt read GetSessionNb;
  property  SessionID:LongString read GetSessionID;
  property  PidAtHost:LongString read GetPidAtHost;
  property  SessionPID:TPid read GetSessionPID;
  property  SessionStarted:Boolean read GetSessionStarted;
  property  VendorName:LongString read GetVendorName;
  property  ApplicationName:LongString read GetApplicationName;
  property  SessionSubFolder:LongString read GetSessionSubFolder;
 public     // Title = SessionSign/aText
  function  SessionSign(Delim:Char='#'):LongString;   // crwdaq#1
  function  SessionHead(Delim:Char='_'):LongString;   // crwdaq_1
  function  Title(aText:LongString=''):LongString;    // crwdaq#1/aText
  function  TitlePidAtHost:LongString;                // crwdaq#1/4235@y510p
 public
  function  HasIpcServer:Boolean;
  function  HasIpcClient:Boolean;
  property  IpcServer : TSimpleIpcServer read GetIpcServer;
  property  IpcClient : TSimpleIpcClient read GetIpcClient;
  property  IpcPipeId : LongString       read GetIpcPipeId;
 public
  function  ComposeIpcPipeId(aUser,aVendor,aAppName:LongString;
                             aSessionNb,aSessionPid:Integer):LongString;
 public
  function  SendIpcMessage(const aMessage:LongString):Boolean;
  function  ReadIpcMessage(out aMessage:LongString):Boolean;
 public
  function  CmdActivate(const arg:LongString):LongString;
  procedure SetCmdActivate(aCmdActivate:LongString=smc_Activate);
 public
  function  LocalConfigDir(aCheck:Boolean=true):LongString;
  function  LocalDataDir(aCheck:Boolean=true):LongString;
  function  SystemTmpDir(aCheck:Boolean=true):LongString;
  function  VarTmpDir(aCheck:Boolean=true):LongString;
  function  RuntimeDir(aCheck:Boolean=true):LongString;
 public
  function  LocalConfigFile(aName:LongString; aCheck:Boolean=true):LongString;
  function  LocalDataFile(aName:LongString; aCheck:Boolean=true):LongString;
  function  SystemTmpFile(aName:LongString; aCheck:Boolean=true):LongString;
  function  VarTmpFile(aName:LongString; aCheck:Boolean=true):LongString;
  function  RuntimeFile(aName:LongString; aCheck:Boolean=true):LongString;
  function  RunningPidFile:LongString;
 public // Start('1') or Start('? 100') or Start('$ 1').
  function  Start(arg:LongString):Boolean;
  function  DetectRunningPid(Mode:Integer; aPidFile:LongString=''):TPid;
 protected
  function  StartBySessionNb(aNumber:LongInt=0):Boolean;
  function  StartByCmdLineOptions(aNumber:LongInt=0; aOptions:LongString=''):Boolean;
  function  CheckDirectories(aInit:Boolean=false):Boolean;
 public
  function  RedirectStdIo(aStreams:LongString='012'):Boolean;
  function  OpenLeakageLog(aFileName:LongString=''):Boolean;
  function  OpenReadIniLog(aFileName:LongString=''):Boolean;
  function  OpenDebugLog(aFileName:LongString=''):Boolean;
  function  OpenErrorLog(aFileName:LongString=''):Boolean;
  function  OpenSoundLog(aFileName:LongString=''):Boolean;
  procedure SetGuardIniPath(aPath:LongString='');
  procedure SetSystemEcho(aEcho:TEchoProcedure);
  procedure SetBlasterLogger(aLogger:TBlasterLoggerCallback);
  procedure SetSystemSendToMainConsole(aSend:TSendToMainConsoleFunction);
 public
  function  SimpleIpcSendMessage(aServerID,aMessage:LongString):Boolean;
  function  SimpleIpcSendCommand(aUser,aVendor,aAppName:LongString;
                            aSessionNb,aSessionPid:Integer;
                            aCommand:LongString):Boolean;
 private
  TheDefSessionNb : LongInt; static;
  TheDefLeakageLog : LongString; static;
  TheDefReadIniLog : LongString; static;
  TheDefDebugLog : LongString; static;
  TheDefErrorLog : LongString; static;
  TheDefSoundLog : LongString; static;
  TheDefSessionPrefix : LongString; static;
  TheDefCmdLineOptions : LongString; static;
 public
  class function DefSessionNb:LongInt; static;
  class function DefLeakageLog:LongString; static;
  class function DefReadIniLog:LongString; static;
  class function DefDebugLog:LongString; static;
  class function DefErrorLog:LongString; static;
  class function DefSoundLog:LongString; static;
  class function DefSessionPrefix:LongString; static;
  class function DefCmdLineOptions:LongString; static;
  class function ValidNb(aNb:LongInt):Boolean; static;
  class function ValidName(aId:LongString):Boolean; static;
  class function CheckDir(aDir:LongString):Boolean; static;
  class function ValidateName(aName:LongString):LongString; static;
 end;

function SessionManager:TSessionManager;

implementation

//////////////////
// TSessionManager
//////////////////

constructor TSessionManager.Create;
begin
 inherited Create;
 ClearAll;
end;

destructor TSessionManager.Destroy;
begin
 ClearAll;
 inherited Destroy;
end;

procedure TSessionManager.AfterConstruction;
begin
 inherited AfterConstruction;
 SetCmdActivate;
end;

procedure TSessionManager.BeforeDestruction;
begin
 if SessionStarted then ClearRunningPid;
 inherited BeforeDestruction;
end;

procedure TSessionManager.ClearAll;
begin
 if Assigned(Self) then begin
  mySessionNb:=0;
  mySessionID:='';
  myPidAtHost:='';
  myVendorName:='';
  mySessionSign:='';
  mySessionHead:='';
  myApplicationName:='';
  mySessionSubFolder:='';
  myLocalConfigDir:='';
  myLocalDataDir:='';
  mySystemTmpDir:='';
  myVarTmpDir:='';
  myRuntimeDir:='';
  myRunningPidFile:='';
  myCmdActivate:='';
  FreeAndNil(myIpcServer);
  FreeAndNil(myIpcClient);
 end;
end;

procedure TSessionManager.ClearRunningPid;
var pid:TPid;
begin
 if Assigned(Self) then
 if SessionStarted then begin
  pid:=DetectRunningPid(sm_CheckOnly);
  if (pid=0) or (pid=GetCurrentProcessId) then
  if FileExists(RunningPidFile) then DeleteFile(RunningPidFile);
 end;
end;

function TSessionManager.GetSessionNb:LongInt;
begin
 if Assigned(Self)
 then Result:=mySessionNb
 else Result:=0;
end;

function TSessionManager.GetSessionID:LongString;
begin
 if Assigned(Self)
 then Result:=mySessionID
 else Result:='';
end;

function TSessionManager.GetPidAtHost:LongString;
begin
 if Assigned(Self)
 then Result:=myPidAtHost
 else Result:='';
end;

function TSessionManager.GetSessionPID:TPid;
begin
 if Assigned(Self)
 then Result:=mySessionPID
 else Result:=0;
end;

function TSessionManager.SessionSign(Delim:Char='#'):LongString;
begin
 if Assigned(Self)
 then Result:=mySessionSign
 else Result:='';
 if (Result<>'') and (Delim<>'#')
 then Result:=StringReplace(Result,'#',Delim,[rfReplaceAll]);
end;

function TSessionManager.SessionHead(Delim:Char='_'):LongString;
begin
 if Assigned(Self)
 then Result:=mySessionHead
 else Result:='';
 if (Result<>'') and (Delim<>'_')
 then Result:=StringReplace(Result,'_',Delim,[rfReplaceAll]);
end;

 // crwdaq#1/aText
function TSessionManager.Title(aText:LongString=''):LongString;
begin
 if Assigned(Self)
 then Result:=mySessionSign+'/'+aText
 else Result:='';
end;

// crwdaq#Nb/PID@HOST
function TSessionManager.TitlePidAtHost:LongString;
begin
if Assigned(Self)
then Result:=Title(PidAtHost)
else Result:='';
end;

function TSessionManager.GetSessionStarted:Boolean;
begin
 if Assigned(Self)
 then Result:=ValidNb(mySessionNb)
 else Result:=false;
end;

function TSessionManager.GetSessionSubFolder:LongString;
begin
 if Assigned(Self)
 then Result:=mySessionSubFolder
 else Result:='';
end;

function  TSessionManager.GetIpcServer:TSimpleIpcServer;
begin
 if Assigned(Self)
 then Result:=myIpcServer
 else Result:=nil;
end;

function  TSessionManager.GetIpcClient:TSimpleIpcClient;
begin
 if Assigned(Self)
 then Result:=myIpcClient
 else Result:=nil;
end;

function  TSessionManager.HasIpcServer:Boolean;
begin
 if Assigned(Self)
 then Result:=Assigned(myIpcServer)
 else Result:=false;
end;

function  TSessionManager.HasIpcClient:Boolean;
begin
 if Assigned(Self)
 then Result:=Assigned(myIpcClient)
 else Result:=false;
end;

function TSessionManager.GetIpcPipeId:LongString;
begin
 if Assigned(Self)
 then Result:=ComposeIpcPipeId('','','',0,0)
 else Result:='';
end;

function TSessionManager.SendIpcMessage(const aMessage:LongString):Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 if (aMessage<>'') then
 if Assigned(myIpcClient) then
 try
  if myIpcClient.ServerRunning then begin
   if not myIpcClient.Active then myIpcClient.Active:=true;
   if myIpcClient.Active then myIpcClient.SendStringMessage(aMessage);
  end;
 except
  on E:Exception do BugReport(E,nil,'SendIpcMessage');
 end;
end;

function TSessionManager.ReadIpcMessage(out aMessage:LongString):Boolean;
begin
 aMessage:='';
 Result:=false;
 if Assigned(Self) then
 if Assigned(myIpcServer) then
 try
  Result:=myIpcServer.PeekMessage(0,true);
  if Result then aMessage:=myIpcServer.StringMessage;
 except
  on E:Exception do BugReport(E,nil,'ReadIpcMessage');
 end;
end;

function  TSessionManager.CmdActivate(const arg:LongString):LongString;
begin
 if Assigned(Self) and IsLexeme(myCmdActivate,lex_AtCall)
 then Result:=Trim(myCmdActivate+' '+arg)
 else Result:='';
end;

procedure TSessionManager.SetCmdActivate(aCmdActivate:LongString=smc_Activate);
begin
 if Assigned(Self) then
 if IsLexeme(aCmdActivate,lex_AtCmnd) or IsEmptyStr(aCmdActivate)
 then myCmdActivate:=Trim(aCmdActivate);
end;

function TSessionManager.GetVendorName:LongString;
begin
 if Assigned(Self)
 then Result:=myVendorName
 else Result:='';
end;

function TSessionManager.GetApplicationName:LongString;
begin
 if Assigned(Self)
 then Result:=myApplicationName
 else Result:='';
end;

function TSessionManager.LocalConfigDir(Check:Boolean=true):LongString;
begin
 if Assigned(Self)
 then Result:=myLocalConfigDir
 else Result:='';
 if aCheck then CheckDir(Result);
end;

function TSessionManager.LocalDataDir(aCheck:Boolean=true):LongString;
begin
 if Assigned(Self)
 then Result:=myLocalDataDir
 else Result:='';
 if aCheck then CheckDir(Result);
end;

function TSessionManager.SystemTmpDir(aCheck:Boolean=true):LongString;
begin
 if Assigned(Self)
 then Result:=mySystemTmpDir
 else Result:='';
 if aCheck then CheckDir(Result);
end;

function TSessionManager.VarTmpDir(aCheck:Boolean=true):LongString;
begin
 if Assigned(Self)
 then Result:=myVarTmpDir
 else Result:='';
 if aCheck then CheckDir(Result);
end;

function TSessionManager.RuntimeDir(aCheck:Boolean=true):LongString;
begin
 if Assigned(Self)
 then Result:=myRuntimeDir
 else Result:='';
 if aCheck then CheckDir(Result);
end;

function  TSessionManager.LocalConfigFile(aName:LongString; aCheck:Boolean=true):LongString;
begin
 if Assigned(Self)
 then Result:=AddPathDelim(LocalConfigDir(aCheck))+Trim(aName)
 else Result:='';
end;

function  TSessionManager.LocalDataFile(aName:LongString; aCheck:Boolean=true):LongString;
begin
 if Assigned(Self)
 then Result:=AddPathDelim(LocalDataDir(aCheck))+Trim(aName)
 else Result:='';
end;

function  TSessionManager.SystemTmpFile(aName:LongString; aCheck:Boolean=true):LongString;
begin
 if Assigned(Self)
 then Result:=AddPathDelim(SystemTmpDir(aCheck))+Trim(aName)
 else Result:='';
end;

function  TSessionManager.VarTmpFile(aName:LongString; aCheck:Boolean=true):LongString;
begin
 if Assigned(Self)
 then Result:=AddPathDelim(VarTmpDir(aCheck))+Trim(aName)
 else Result:='';
end;

function  TSessionManager.RuntimeFile(aName:LongString; aCheck:Boolean=true):LongString;
begin
 if Assigned(Self)
 then Result:=AddPathDelim(RuntimeDir(aCheck))+Trim(aName)
 else Result:='';
end;

function  TSessionManager.RunningPidFile:LongString;
begin
 if Assigned(Self)
 then Result:=myRunningPidFile
 else Result:='';
 if (Result<>'') then CheckDir(ExtractFileDir(Result));
end;

class function TSessionManager.DefSessionNb:LongInt;
begin
 Result:=TheDefSessionNb;
end;

class function TSessionManager.DefLeakageLog:LongString;
begin
 Result:=TheDefLeakageLog;
end;

class function TSessionManager.DefReadIniLog:LongString;
begin
 Result:=TheDefReadIniLog;
end;

class function TSessionManager.DefDebugLog:LongString;
begin
 Result:=TheDefDebugLog;
end;

class function TSessionManager.DefErrorLog:LongString;
begin
 Result:=TheDefErrorLog;
end;

class function TSessionManager.DefSoundLog:LongString;
begin
 Result:=TheDefSoundLog;
end;

class function TSessionManager.DefSessionPrefix:LongString;
begin
 Result:=TheDefSessionPrefix;
end;

class function TSessionManager.DefCmdLineOptions:LongString;
begin
 Result:=TheDefCmdLineOptions;
end;

class function TSessionManager.ValidNb(aNb:LongInt):Boolean;
begin
 Result:=InRange(aNb,1,MaxInt);
end;

class function TSessionManager.ValidName(aId:LongString):Boolean;
begin
 Result:=IsLexeme(aId,lex_Word);
end;

class function TSessionManager.CheckDir(aDir:LongString):Boolean;
begin
 Result:=false; if IsEmptyStr(aDir) then Exit;
 if DirectoryExists(aDir) then Result:=true else Result:=MkDir(aDir);
end;

class function TSessionManager.ValidateName(aName:LongString):LongString;
const WordChars=['_','0'..'9','a'..'z','A'..'Z'];
var i:Integer;
begin
 Result:=Trim(aName);
 if IsEmptyStr(Result) then Exit;
 for i:=1 to Length(Result) do begin
  if not (Result[i] in WordChars)
  then Result[i]:='_';
 end;
end;

function TSessionManager.Start(arg:LongString):Boolean;
var w1,w2,cmd:LongString; i,n:Integer; pid:TPid;
begin
 Result:=false;
 if Assigned(Self) then
 if not SessionStarted then
 try
  if IsEmptyStr(arg) // Default='1'
  then arg:=IntToStr(DefSessionNb);
  w1:=ExtractWord(1,arg,ScanSpaces);
  w2:=ExtractWord(2,arg,ScanSpaces);
  // arg = Nb - init by session number.
  if TryStrToInt(w1,i) and (i>0) then begin
   if StartBySessionNb(i) then begin
    pid:=DetectRunningPid(sm_LockFirst);
    Result:=(pid=0);
   end;
  end else
  // arg = '? 100' - find first free session in [1..100] range.
  if SameText(w1,'?') then begin
   n:=StrToIntDef(w2,100);
   for i:=1 to n do begin
    if StartBySessionNb(i) then begin
     pid:=DetectRunningPid(sm_LockFirst);
     Result:=(pid=0);
    end;
    if Result then Break;
   end;
  end else
  // $ 1 - init session by command line or use session 1.
  if SameText(w1,'$') then begin
   Result:=StartByCmdLineOptions(StrToIntDef(w2,0));
   if Result then begin
    pid:=DetectRunningPid(sm_LockFirst);
    Result:=(pid=0);
   end;
  end;
  pid:=DetectRunningPid(sm_CheckOnly);
  if (pid>0) then begin
   mySessionPID:=pid;
   if Result then begin
    myIpcServer:=TSimpleIpcServer.Create(nil);
    IpcServer.ServerID:=IpcPipeID;
    IpcServer.Global:=true;
    IpcServer.Active:=true;
   end else begin
    myIpcClient:=TSimpleIpcClient.Create(nil);
    IpcClient.ServerID:=IpcPipeID;
    if IpcClient.ServerRunning then begin
     cmd:=CmdActivate(GetCommandLine);
     IpcClient.Active:=true;
     SendIpcMessage(cmd);
    end;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'Init');
 end;
end;

function TSessionManager.StartBySessionNb(aNumber:LongInt=0):Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 try
  if not ValidNb(aNumber) then aNumber:=DefSessionNb;
  if ValidNb(aNumber) then mySessionNb:=aNumber;
  Result:=ValidNb(SessionNb) and CheckDirectories(true);
 except
  on E:Exception do BugReport(E,Self,'InitBySessionNb');
 end;
end;

function TSessionManager.StartByCmdLineOptions(aNumber:LongInt=0; aOptions:LongString=''):Boolean;
var i,sid:Integer; opt:LongString;
begin
 Result:=false;
 if Assigned(Self) then
 try
  sid:=0;
  if IsEmptyStr(aOptions) then aOptions:=DefCmdLineOptions;
  CmdArgs.ListOptVal:=aOptions;
  for i:=1 to WordCount(aOptions,ScanSpaces) do begin
   opt:=ExtractWord(i,aOptions,ScanSpaces);
   if CmdArgs.IsOption(opt) then
   if CmdArgs.HasOption(opt) then
   if CmdArgs.HasOptionValue(opt) then begin
    sid:=StrToIntDef(CmdArgs.GetOptionValue(opt),0);
    if ValidNb(sid) then Break;
    sid:=0;
   end;
  end;
  if not ValidNb(sid) then sid:=aNumber;
  Result:=StartBySessionNb(sid);
 except
  on E:Exception do BugReport(E,Self,'InitByCmdLineOptions');
 end;
end;

function TSessionManager.CheckDirectories(aInit:Boolean=false):Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 if ValidNb(SessionNb) then
 try
  if aInit or IsEmptyStr(SessionSubFolder) then begin
   myVendorName:=SysUtils.VendorName;
   myApplicationName:=SysUtils.ApplicationName;
   mySessionSubFolder:=AddPathDelim(VendorName)+ApplicationName;
   mySessionSubFolder:=AddPathDelim(mySessionSubFolder)+DefSessionPrefix+IntToStr(SessionNb);
   if IsUnix then mySessionSubFolder:=LowerCase(mySessionSubFolder);
   myLocalConfigDir:=GetSpecialShellFolderPath(CSIDL_XDG_CONFIG_HOME,SessionSubFolder);
   myLocalDataDir:=GetSpecialShellFolderPath(CSIDL_XDG_DATA_HOME,SessionSubFolder);
   myRuntimeDir:=GetSpecialShellFolderPath(CSIDL_XDG_RUNTIME_DIR,SessionSubFolder);
   myRunningPidFile:=RuntimeFile('running.pid',true);
   mySessionID:=ValidateName(SessionSubFolder);
   mySessionSign:=myApplicationName+'#'+IntToStr(SessionNb);
   mySessionHead:=myApplicationName+'_'+IntToStr(SessionNb);
   myPidAtHost:=LowerCase(IntToStr(GetCurrentProcessId)+'@'+HostName);
   if IsUnix and DirectoryExists('/tmp') then begin
    mySystemTmpDir:=AddPathDelim('/tmp')+'user-'+UserName;
    mySystemTmpDir:=AddPathDelim(mySystemTmpDir)+SessionSubFolder;
   end else begin
    if IsWindows and (WordIndex(UserName,GlobalTempDir,DirDelimiters)>0)
    then mySystemTmpDir:=GlobalTempDir
    else mySystemTmpDir:=GlobalTempDir('user-'+UserName);
    mySystemTmpDir:=AddPathDelim(mySystemTmpDir)+SessionSubFolder;
   end;
   if IsUnix and DirectoryExists('/var/tmp') then begin
    myVarTmpDir:=AddPathDelim('/var/tmp')+'user-'+UserName;
    myVarTmpDir:=AddPathDelim(myVarTmpDir)+SessionSubFolder;
   end else begin
    if IsWindows and (WordIndex(UserName,LocalTempDir,DirDelimiters)>0)
    then myVarTmpDir:=LocalTempDir
    else myVarTmpDir:=LocalTempDir('user-'+UserName);
    myVarTmpDir:=AddPathDelim(myVarTmpDir)+SessionSubFolder;
   end;
  end;
  Result:=CheckDir(LocalConfigDir)
      and CheckDir(LocalDataDir)
      and CheckDir(SystemTmpDir)
      and CheckDir(VarTmpDir);
 except
  on E:Exception do BugReport(E,Self,'CheckDirectories');
 end;
end;

function TSessionManager.DetectRunningPid(Mode:Integer; aPidFile:LongString=''):TPid;
var nPid:LongInt; sPid:LongString; PrState:Char;
begin
 Result:=0;
 if Assigned(Self) then
 try
  if IsEmptyStr(aPidFile)
  then aPidFile:=RunningPidFile;
  // Read PID from running.pid file.
  sPid:=StringFromFile(aPidFile,0);
  sPid:=ExtractWord(1,sPid,EolnDelims);
  if TryStrToInt(Trim(sPid),nPid) then Result:=nPid;
  if (Result<0) then Result:=0; // PID is positive.
  if (Result>0) then begin // Check process is alive.
   PrState:=QueryProcessState(Result,0,ExtractFileNameExt(ProgName));
   if not ProcessStateIsAlive(PrState) then Result:=0;
  end;
  if HasFlags(Mode,sm_ClearDead) and (Result<=0) then begin
   if FileExists(aPidFile) then DeleteFile(aPidFile);
  end;
  if HasFlags(Mode,sm_LockFirst) and (Result<=0) then begin
   if FileExists(aPidFile) then DeleteFile(aPidFile);
   sPid:=IntToStr(GetCurrentProcessId)+EOL;
   WriteBufferToFile(aPidFile,sPid);
  end;
 except
  on E:Exception do BugReport(E,Self,'DetectRunningPid');
 end;
end;

function TSessionManager.RedirectStdIo(aStreams:LongString='012'):Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 try
  _crw_fio.RedirectStdIo(aStreams,true);
  TPolling.SetDefRedirectStdIo(aStreams);
  Result:=true;
 except
  on E:Exception do BugReport(E,Self,'RedirectStdIo');
 end;
end;

function TSessionManager.OpenLeakageLog(aFileName:LongString=''):Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 if CheckDirectories then
 try
  if IsEmptyStr(aFileName)
  then aFileName:=DefLeakageLog;
  aFileName:=VarTmpFile(aFileName);
  Result:=OpenResourceLeakageLogFile(aFileName);
 except
  on E:Exception do BugReport(E,Self,'OpenLeakageLog');
 end;
end;

function TSessionManager.OpenReadIniLog(aFileName:LongString=''):Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 if CheckDirectories then
 try
  if IsEmptyStr(aFileName)
  then aFileName:=DefReadIniLog;
  aFileName:=VarTmpFile(aFileName);
  OpenIniLogFile(aFileName);
  Result:=true;
 except
  on E:Exception do BugReport(E,Self,'OpenReadIniLog');
 end;
end;

function TSessionManager.OpenDebugLog(aFileName:LongString=''):Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 if CheckDirectories then
 try
  if IsEmptyStr(aFileName)
  then aFileName:=DefDebugLog;
  aFileName:=VarTmpFile(aFileName);
  DebugOutOpenFile(stdfDebug,aFileName,DebugOutFifoSize,DebugOutFifoPollPeriod,true,true);
  DebugOutSetFifo(stdfDebug,DebugOutFifoSize,DebugOutFifoGrowFactor,DebugOutFifoGrowLimit);
  Result:=true;
 except
  on E:Exception do BugReport(E,Self,'OpenDebugLog');
 end;
end;

function TSessionManager.OpenErrorLog(aFileName:LongString=''):Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 if CheckDirectories then
 try
  if IsEmptyStr(aFileName)
  then aFileName:=DefErrorLog;
  aFileName:=VarTmpFile(aFileName);
  DebugOutOpenFile(stdfError,aFileName,DebugOutFifoSize,DebugOutFifoPollPeriod,true,true);
  DebugOutSetFifo(stdfError,DebugOutFifoSize,DebugOutFifoGrowFactor,DebugOutFifoGrowLimit);
  Result:=true;
 except
  on E:Exception do BugReport(E,Self,'OpenErrorLog');
 end;
end;

function TSessionManager.OpenSoundLog(aFileName:LongString=''):Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 if CheckDirectories then
 try
  if IsEmptyStr(aFileName)
  then aFileName:=DefSoundLog;
  aFileName:=VarTmpFile(aFileName);
  DebugOutOpenFile(stdfSound,aFileName,DebugOutFifoSize,DebugOutFifoPollPeriod,true,true);
  DebugOutSetFifo(stdfSound,DebugOutFifoSize,DebugOutFifoGrowFactor,DebugOutFifoGrowLimit);
  Result:=true;
 except
  on E:Exception do BugReport(E,Self,'OpenSoundLog');
 end;
end;

procedure TSessionManager.SetGuardIniPath(aPath:LongString='');
begin
 if not Assigned(Self) then Exit;
 if IsEmptyStr(aPath) then aPath:=VarTmpDir;
 Guard.IniPath:=aPath;
 CheckDir(aPath);
end;

procedure TSessionManager.SetSystemEcho(aEcho:TEchoProcedure);
begin
 SystemEchoProcedure:=aEcho;
end;

procedure TSessionManager.SetBlasterLogger(aLogger:TBlasterLoggerCallback);
begin
 BlasterLoggerCallback:=aLogger;
end;

procedure TSessionManager.SetSystemSendToMainConsole(aSend:TSendToMainConsoleFunction);
begin
 SystemSendToMainConsoleFunction:=aSend;
end;

function TSessionManager.ComposeIpcPipeId(aUser,aVendor,aAppName:LongString;
                                 aSessionNb,aSessionPid:Integer):LongString;
const cMode='vap'; // 'uvanp'; // Composition mode for IpcPipeId
begin
 Result:='';
 if Assigned(Self) then begin
  aUser:=TrimDef(aUser,UserName);
  aVendor:=TrimDef(aVendor,VendorName);
  aAppName:=TrimDef(aAppName,ApplicationName);
  if (aSessionNb<=0) then aSessionNb:=SessionNb;
  if (aSessionPid<=0) then aSessionPid:=SessionPID;
  Result:='ipc';
  if HasChars('u',cMode) then Result:=Format('%s_%s',[Result,aUser]);
  if HasChars('v',cMode) then Result:=Format('%s_%s',[Result,aVendor]);
  if HasChars('a',cMode) then Result:=Format('%s_%s',[Result,aAppName]);
  if HasChars('n',cMode) then Result:=Format('%s_session_%d',[Result,aSessionNb]);
  if HasChars('p',cMode) then Result:=Format('%s_pid_%d',[Result,aSessionPid]);
  Result:=ValidateName(Result);
 end;
end;

function TSessionManager.SimpleIpcSendMessage(aServerID,aMessage:LongString):Boolean;
var ipc:TSimpleIpcClient;
begin
 Result:=false;
 aServerID:=Trim(aServerID);
 if IsNonEmptyStr(aServerID) then
 try
  ipc:=TSimpleIpcClient.Create(nil);
  try
   ipc.ServerID:=aServerID;
   if ipc.ServerRunning then ipc.Active:=true;
   if ipc.Active then ipc.SendStringMessage(aMessage);
   Result:=ipc.Active;
  finally
   ipc.Free;
  end;
 except
  on E:Exception do BugReport(E,Self,'SimpleIpcSendMessage');
 end;
end;

function TSessionManager.SimpleIpcSendCommand(aUser,aVendor,aAppName:LongString;
                          aSessionNb,aSessionPid:Integer; aCommand:LongString):Boolean;
var aServerID:LongString;
begin
 Result:=false;
 if IsLexeme(aCommand,lex_AtCall) then begin
  aServerID:=ComposeIpcPipeId(aUser,aVendor,aAppName,aSessionNb,aSessionPid);
  Result:=SimpleIpcSendMessage(aServerID,aCommand);
 end;
end;

 /////////////////
 // SessionManager
 /////////////////

const
 TheSessionManager:TSessionManager=nil;

function SessionManager:TSessionManager;
begin
 if not Assigned(TheSessionManager) then begin
  TheSessionManager:=TSessionManager.Create;
  TheSessionManager.Master:=@TheSessionManager;
 end;
 Result:=TheSessionManager;
end;

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

procedure Init_crw_sesman;
begin
 TSessionManager.TheDefSessionNb:=1;
 TSessionManager.TheDefLeakageLog:='leakage.log';
 TSessionManager.TheDefReadIniLog:='readini.log';
 TSessionManager.TheDefSessionPrefix:='session_';
 TSessionManager.TheDefDebugLog:='debug.log';
 TSessionManager.TheDefErrorLog:='error.log';
 TSessionManager.TheDefSoundLog:='sound.log';
 TSessionManager.TheDefCmdLineOptions:='-session;--session;-number;--number';
 SessionManager.Ok;
end;

procedure Free_crw_sesman;
begin
 Kill(TObject(TheSessionManager));
end;

initialization

 Init_crw_sesman;

finalization

 Free_crw_sesman;

end.

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

