////////////////////////////////////////////////////////////////////////////////
// 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:                                                                   //
// This unit implement FileGuard - file protection object.                    //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20241128 - Created by A.K.                                                 //
////////////////////////////////////////////////////////////////////////////////

 {
 Unit implements FileGuard - file protection object.
 
 Модуль реализует FileGuard - объект для защиты файлов.
 }
unit _crw_flgrd;

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math, fileutil, masks,
 _crw_alloc, _crw_ef, _crw_str, _crw_fio, _crw_sect,
 _crw_dbglog;

 {
 TFileGuard is File Guard class to apply file protection.
 1) Replace some file names like ~~/temp/… to another (session profile)
    directory to protect crwdaq home directory from file writing.
 2) Disable editing some files marked as ReadOnly.
 }
type
 TFileGuard = class(TMasterObject)
 private
  myEnabled:Boolean;
  myReadOnlyLines:LongString;
  myReplaceDirectoryLines:LongString;
  function  GetEnabled:Boolean;
  procedure SetEnabled(Value:Boolean);
  procedure ReadIniReadOnlyLines;
  procedure ReadIniReplaceDirectoryLines;
 public
  constructor Create;
  destructor  Destroy; override;
 public
  {
  Apply ReplaceDirectory protection.
  Replace local directories like '~~/temp', '~~/data'  etc
  to work directories located in safe place like '/tmp/…'.
  ReplaceDirectory items located in [System.FileGuard.Replacement] section
  and contains lines 'ReplaceDirectory = DIR REP' to replace DIR to REP.
  For example, 'ReplaceDirectory = ~~/temp $CRW_DAQ_SYS_TMP_DIR/temp'.
  }
  function ApplyReplaceDirectory(const aFileName:LongString):LongString;
  {
  Protect program HomeDir from changes.
  Apply ReplaceDirectory if aFileName starts from HomeDir.
  }
  function ProtectHomeDir(aFileName:LongString):LongString;
  {
  aFilename protected as ReadOnly.
  aFileName matches to ReadOnly list in [System.FileGuard.Protection].
  }
  function ProtectedReadOnly(aFileName:LongString):Boolean;
  {
  Enable/disable FileGuard protection.
  If disabled, ProtectedReadOnly is always false.
  }
  property Enabled:Boolean read GetEnabled write SetEnabled;
 end;

 {
 DebugLog channel for FileGuard events.
 }
function dlc_FileGuard:Integer;

 {
 The only one instance of FileGuard object.
 }
function FileGuard:TFileGuard;

implementation

function dlc_FileGuard:Integer;
const dlc:Integer=0;
begin
 if (dlc=0) then dlc:=RegisterDebugLogChannel('_FileGuard');
 Result:=dlc;
end;

 ////////////////////////////
 // TFileGuard implementation
 ////////////////////////////

constructor TFileGuard.Create;
begin
 inherited Create;
 dlc_FileGuard;
 myEnabled:=true;
 myReadOnlyLines:='';
 myReplaceDirectoryLines:='';
end;

destructor TFileGuard.Destroy;
begin
 myReadOnlyLines:='';
 myReplaceDirectoryLines:='';
 inherited Destroy;
end;

function TFileGuard.GetEnabled:Boolean;
begin
 if Assigned(Self)
 then Result:=myEnabled
 else Result:=false;
end;

procedure TFileGuard.SetEnabled(Value:Boolean);
begin
 if Assigned(Self) then myEnabled:=Value;
end;

type TRepDirIter=record Guard:TFileGuard; FileName:LongString; end;
function repdirIter(n:SizeInt; Line:LongString; Custom:Pointer):Boolean;
var dir,rep,old:LongString;
begin
 Result:=false;
 if Assigned(Custom) then
 with TRepDirIter(Custom^) do
 if (PhraseCount(Line,ScanSpaces)=2) then begin
  dir:=ExtractPhrase(1,Line,ScanSpaces);
  rep:=ExtractPhrase(2,Line,ScanSpaces);
  if StartsText(dir,FileName) then begin
   old:=FileName;
   Delete(FileName,1,Length(dir));
   FileName:=rep+FileName;
   if DebugLogEnabled(dlc_FileGuard)
   then DebugLog(dlc_fileGuard,'ReplaceDirectory: '+QArg(old)+' ➞ '+QArg(FileName));
   Exit;
  end;
 end;
 Result:=true;
end;

function TFileGuard.ApplyReplaceDirectory(const aFileName:LongString):LongString;
var R:TRepDirIter;
begin
 Result:=aFileName;
 if Assigned(Self) then
 try
  R:=Default(TRepDirIter);
  try
   R.Guard:=Self;
   R.FileName:=aFileName;
   ReadIniReplaceDirectoryLines;
   ForEachStringLine(myReplaceDirectoryLines,repdirIter,@R);
   Result:=R.FileName;
  finally
   R.FileName:='';
  end;
 except
  on E:Exception do BugReport(E,Self,'ReplaceDirectory');
 end;
end;

function TFileGuard.ProtectHomeDir(aFileName:LongString):LongString;
begin
 Result:=aFileName;
 if Assigned(Self) then
 if StartsText(HomeDir,aFileName)
 then Result:=ApplyReplaceDirectory(aFileName);
end;

function repdirAdd(n:SizeInt; Line:LongString; Custom:Pointer):Boolean;
var dir,rep,item:LongString; Guard:TFileGuard;
begin
 Result:=true;
 Guard:=Custom;
 if Assigned(Custom) then
 if (PhraseCount(Line,ScanSpaces)=2) then begin
  dir:=ExtractPhrase(1,Line,ScanSpaces);
  rep:=ExtractPhrase(2,Line,ScanSpaces);
  if MaybeEnvStr(dir) then dir:=ExpEnv(dir);
  if MaybeEnvStr(rep) then rep:=ExpEnv(rep);
  dir:=AdaptFileName(dir); rep:=AdaptFileName(rep);
  if MaybeTildeStr(dir) then dir:=SmartFileRef(dir);
  if MaybeTildeStr(rep) then rep:=SmartFileRef(rep);
  if IsRelativePath(dir) then dir:=DefaultPath(dir,HomeDir);
  if IsRelativePath(rep) then rep:=DefaultPath(rep,HomeDir);
  dir:=UnifyFileAlias(dir,ua_FileDefLow); if IsEmptyStr(dir) then Exit;
  rep:=UnifyFileAlias(rep,ua_FileDefLow); if IsEmptyStr(rep) then Exit;
  item:=QArg(dir)+' '+QArg(rep);
  if DebugLogEnabled(dlc_FileGuard)
  then DebugLog(dlc_FileGuard,'ReplaceDirectory = '+item);
  Guard.myReplaceDirectoryLines:=Guard.myReplaceDirectoryLines+item+EOL;
 end;
end;

procedure TFileGuard.ReadIniReplaceDirectoryLines;
var Buff,Sect:LongString;
begin
 if Assigned(Self) then
 if (myReplaceDirectoryLines='') then
 try
  myReplaceDirectoryLines:='';
  Sect:=SectSystemFileGuardReplacement;
  Buff:=ExtractTextSectionByPrefix(SysIniFile,Sect,'ReplaceDirectory',efConfigNC);
  ForEachStringLine(Buff,repdirAdd,Self);
 except
  on E:Exception do BugReport(E,Self,'ReadIniReplaceDirectoryLines');
 end;
end;

function roAdd(n:SizeInt; Line:LongString; Custom:Pointer):Boolean;
var dir,wcd,msk,wrd,item:LongString; Guard:TFileGuard; i:Integer;
begin
 Result:=true;
 Guard:=Custom;
 if Assigned(Custom) then
 if (PhraseCount(Line,ScanSpaces)>=2) then begin
  dir:=ExtractPhrase(1,Line,ScanSpaces);
  msk:=Trim(SkipPhrases(1,Line,ScanSpaces));
  wcd:=ExtractFileNameExt(dir);
  if IsWildCard(wcd) then dir:=ExtractFileDir(dir) else wcd:='';
  if MaybeEnvStr(dir) then dir:=ExpEnv(dir);
  dir:=AdaptFileName(dir);
  if MaybeTildeStr(dir) then dir:=SmartFileRef(dir);
  if IsRelativePath(dir) then dir:=DefaultPath(dir,HomeDir);
  dir:=UnifyFileAlias(dir,ua_FileDefLow); if IsEmptyStr(dir) then Exit;
  if (wcd<>'') then dir:=AddPathDelim(dir)+wcd;
  item:=''; if IsEmptyStr(msk) then Exit;
  for i:=1 to WordCount(msk,ScanSpaces) do begin
   wrd:=ExtractWord(i,msk,ScanSpaces);
   if (item<>'') then item:=item+';';
   item:=item+wrd;;
  end;
  item:=QArg(dir)+' '+item;
  if DebugLogEnabled(dlc_FileGuard)
  then DebugLog(dlc_FileGuard,'ReadOnly = '+item);
  Guard.myReadOnlyLines:=Guard.myReadOnlyLines+item+EOL;
 end;
end;

procedure TFileGuard.ReadIniReadOnlyLines;
var Buff,Sect:LongString;
begin
 if Assigned(Self) then
 if (myReadOnlyLines='') then
 try
  myReadOnlyLines:='';
  Sect:=SectSystemFileGuardProtection;
  Buff:=ExtractTextSectionByPrefix(SysIniFile,Sect,'ReadOnly',efConfigNC);
  ForEachStringLine(Buff,roAdd,Self);
 except
  on E:Exception do BugReport(E,Self,'ReadIniReadOnlyLines');
 end;
end;

function FileMatch(const FileName,Path,Mask:LongString):Boolean;
var Pat,Efd,FN:LongString;
begin
 Result:=false;
 if IsEmptyStr(Mask) then Exit;
 if IsEmptyStr(Path) then Exit;
 if IsEmptyStr(FileName) then Exit;
 if IsWildCard(Path) then begin
  Pat:=AddPathDelim(ExtractFileDir(Path));
  if not StartsText(Pat,FileName) then Exit;
 end else begin
  Pat:=DropPathDelim(Path);
  Efd:=ExtractFileDir(FileName);
  if not SameText(Pat,Efd) then Exit;
 end;
 FN:=ExtractFileNameExt(FileName);
 Result:=MatchesMaskList(FN,Mask);
end;

type TRoFind=record FileName:LongString; Matches:Integer; end;
function roFind(n:SizeInt; Line:LongString; Custom:Pointer):Boolean;
var dir,mask:LongString;
begin
 Result:=true;
 if Assigned(Custom) then
 with TRoFind(Custom^) do
 if (PhraseCount(Line,JustSpaces)=2) then begin
  dir:=ExtractPhrase(1,Line,ScanSpaces);
  mask:=Trim(SkipPhrases(1,Line,ScanSpaces));
  if FileMatch(FileName,dir,mask) then Inc(Matches);
  if (Matches>0) then Exit(false);
 end;
end;

function TFileGuard.ProtectedReadOnly(aFileName:LongString):Boolean;
var R:TRoFind;
begin
 Result:=false;
 if Assigned(Self) then
 try
  ReadIniReadOnlyLines;
  if IsEmptyStr(myReadOnlyLines) then Exit;
  if not Enabled then Exit;
  R:=Default(TRoFind);
  try
   R.Matches:=0;
   R.FileName:=UnifyAlias(aFileName);
   ForEachStringLine(myReadOnlyLines,roFind,@R);
   if DebugLogEnabled(dlc_FileGuard)
   then DebugLog(dlc_FileGuard,Format('ReadOnly("%s") = %d',[R.FileName,R.Matches]));
   Result:=(R.Matches>0);
  finally
   R.FileName:='';;
  end;
 except
  on E:Exception do BugReport(E,Self,'ReadIniReadOnlyLines');
 end;
end;

 ///////////////////////////
 // FileGuard implementation
 ///////////////////////////

const
 TheFileGuard:TFileGuard=nil;

function FileGuard:TFileGuard;
begin
 if not Assigned(TheFileGuard) then begin
  TheFileGuard:=TFileGuard.Create;
  TheFileGuard.Master:=@TheFileGuard;
 end;
 Result:=TheFileGuard;
end;

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

procedure Init_crw_flgrd;
begin
 FileGuard.Ok;
end;

procedure Free_crw_flgrd;
begin
 Kill(TObject(TheFileGuard));
end;

initialization

 Init_crw_flgrd;

finalization

 Free_crw_flgrd;

end.

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

