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

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

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// Anti-Zombie service to detect Orphan child processess with Parent died.    //
// And other useful parent process monitoring routines.                       //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20071224 - Creation                                                        //
// 20080119 - 1st tested release                                              //
// 20230607 - Modified for FPC (A.K.)                                         //
////////////////////////////////////////////////////////////////////////////////

unit _crw_az; // Anti-Zombie service (detect orphan child processess)

{$I _crw_sysdef}

{$IFDEF FPC}{$mode Delphi}{$ENDIF}{$H+}

interface

uses
 _crw_sharemem, // NB: THIS UNIT MUST BE FIRST !!!
 {$IFDEF UNIX} cthreads, dl, {$ENDIF}
 {$IFDEF WINDOWS} windows, {$ENDIF}
 //{$IFDEF WINDOWS} tlhelp32, {$ENDIF}
 sysutils, classes,
 _crw_alloc, _crw_proc, _crw_fio, _crw_rtc;

 ////////////////////////////////////////////////////////////////////////////
 // GetParentProcessId  - Return parent process ID.
 // GetParentProcessExe - Return parent process Exe file name.
 // ParentProcessDied   - Return TRUE if parent process died and
 //                       child process became orphan (or zombie).
 ////////////////////////////////////////////////////////////////////////////
function GetParentProcessId:SizeInt;     inline;
function GetParentProcessExe:LongString; inline;
function ParentProcessDied:Boolean;

 ////////////////////////////////////////////////////////////////////////////
 // Return file type of standard input/output handles.
 // That is one of next values:
 //  FILE_TYPE_UNKNOWN - unknown file type or file not assigned.
 //  FILE_TYPE_DISK    - disk file.
 //  FILE_TYPE_CHAR    - character file, like an LPT device or a console.
 //  FILE_TYPE_PIPE    - named or anonymous pipe.
 //  FILE_TYPE_REMOTE  - remote network file.
 ////////////////////////////////////////////////////////////////////////////
function StdInFileType:DWORD;  inline;
function StdOutFileType:DWORD; inline;
function StdErrFileType:DWORD; inline;

 ////////////////////////////////////////////////////////////////////////////
 // A Child process became Orphan (or Zombie), when his Parent process died.
 // Usually it's normal situation, if child process independent from parent.
 // But if Child process depends on Parent and interact with parent process,
 // such orphan (zombie) maybe need to terminate when parent process died.
 // BecameOrphan                   - return True if parent process died.
 // BecameZombie or                - return True if parent process died and
 // BecameZombie(FILE_TYPE_PIPE)     standard I/O redirected to pipe.
 // BecameOrphan(0,0,'crw32.exe')  - return True if parent process died and
 //                                  parent process name equal to specified.
 // Example:
 //  program Test; {$APPTYPE CONSOLE} uses _az;
 //  begin
 //   while not BecameZombie(FILE_TYPE_PIPE) do begin
 //    Application.ProcessMessages;
 //    Sleep(1);
 //   end;
 //  end.
 // By default:
 //  BecameOrphan check parent process died.
 //  BecameZombie check parent process died and StdIO redirected to pipe.
 // Notes:
 //  Usually BecameOrphan & BecameZombie are called in main polling loop.
 //  If this child process became Orphan or Zombie, he can be terminated.
 //  To decrease CPU load, make check periodically: aPollPeriod millisec.
 //  So child process will terminate during aPollPeriod after parent die.
 ////////////////////////////////////////////////////////////////////////////
function BecameOrphan(aFileType:DWORD=FILE_TYPE_NONE;
         aPollPeriod:DWORD=High(DWORD); const aParentExe:LongString=''):Boolean;
function BecameZombie(aFileType:DWORD=FILE_TYPE_PIPE;
         aPollPeriod:DWORD=High(DWORD); const aParentExe:LongString=''):Boolean;

const // Default period to check Orphan.
 DefaultOrphanPollPeriod : DWORD = 1000;
 DefaultZombiePollPeriod : DWORD = 1000;

implementation

const // IO FileTypes.
 StdInFT  : DWORD = 0;
 StdOutFT : DWORD = 0;
 StdErrFT : DWORD = 0;

 {$IFDEF WINDOWS}
const myParentRef:THandle=INVALID_HANDLE_VALUE;
 {$ENDIF WINDOWS}

function GetParentProcessId:SizeInt;
begin
 {$IFDEF UNIX}
 Result:=_crw_proc.GetParentProcessID;
 {$ENDIF UNIX}
 {$IFDEF WINDOWS}
 Result:=_crw_proc.GetSnapshotParentProcessID;
 {$ENDIF WINDOWS}
end;

function GetParentProcessExe:LongString;
begin
 {$IFDEF UNIX}
 Result:=_crw_proc.GetParentProcessName;
 {$ENDIF UNIX}
 {$IFDEF WINDOWS}
 Result:=_crw_proc.GetSnapshotParentProcessName;
 {$ENDIF WINDOWS}
end;

function ParentProcessDied:Boolean;
begin
 {$IFDEF WINDOWS}
 // On Windows systems, the parent PID is constant.
 // We need to open parent process and check his status.
 if (myParentRef<>0) and (myParentRef<>INVALID_HANDLE_VALUE)
 then Result:=(WaitForSingleObject(myParentRef,0)=WAIT_OBJECT_0)
 else Result:=False;
 {$ENDIF WINDOWS}
 {$IFDEF UNIX}
 // On Unix systems, the parent PID is NOT constant.
 // At startup we call MakeParentSnapshot to save parent PID.
 // Then if parend PID changed, it means parent process died.
 Result:=(GetParentProcessID<>GetSnapshotParentProcessID);
 {$ENDIF UNIX}
end;

function StdInFileType:DWORD;
begin
 Result:=_crw_fio.StdInFileType;
end;

function StdOutFileType:DWORD;
begin
 Result:=_crw_fio.StdOutFileType;
end;

function StdErrFileType:DWORD;
begin
 Result:=_crw_fio.StdErrFileType;
end;

function MatchFileType(aFileType:DWORD):Boolean; inline;
begin
 Result:=(aFileType=FILE_TYPE_UNKNOWN)
      or (aFileType=StdInFT) or (aFileType=StdOutFT) or (aFileType=StdErrFT);
end;

function MatchProcExe(const aParentExe:LongString):Boolean; inline;
begin
 Result:=(aParentExe='') or SameText(aParentExe,GetParentProcessExe)
end;

function BecameOrphan(aFileType:DWORD;
                      aPollPeriod:DWORD; const aParentExe:LongString):Boolean;
const LastTicks:QWORD=0; var CurrTicks:QWORD;
begin
 Result:=false;
 CurrTicks:=GetTickCount64;
 if (aPollPeriod=High(DWORD))
 then aPollPeriod:=DefaultOrphanPollPeriod;
 if (CurrTicks-LastTicks>=aPollPeriod) then begin
  if MatchFileType(aFileType) then
  if MatchProcExe(aParentExe) then
  Result:=ParentProcessDied;
  LastTicks:=CurrTicks;
 end;
end;

function BecameZombie(aFileType:DWORD;
                      aPollPeriod:DWORD; const aParentExe:LongString):Boolean;
const LastTicks:QWORD=0; var CurrTicks:QWORD;
begin
 Result:=false;
 CurrTicks:=GetTickCount64;
 if (aPollPeriod=High(DWORD))
 then aPollPeriod:=DefaultZombiePollPeriod;
 if (CurrTicks-LastTicks>=aPollPeriod) then begin
  if MatchFileType(aFileType) then
  if MatchProcExe(aParentExe) then
  Result:=ParentProcessDied;
  LastTicks:=CurrTicks;
 end;
end;

{$IFDEF WINDOWS}
function OpenParentProcess(pPid:DWORD):THandle;
begin
 Result:=INVALID_HANDLE_VALUE;
 if (pPid<>0) then
 if (TPid(pPid)<>GetCurrentProcessId) then
 try
  Result:=OpenProcess(PROCESS_QUERY_INFORMATION or SYNCHRONIZE,False,pPid);
 except
  on E:Exception do Result:=INVALID_HANDLE_VALUE;
 end;
end;
{$ENDIF WINDOWS}

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

procedure Init_crw_az;
begin
 MakeParentSnapshot;
 StdInFT:=StdInFileType;
 StdOutFT:=StdOutFileType;
 StdErrFT:=StdErrFileType;
 {$IFDEF WINDOWS}
 myParentRef:=OpenParentProcess(GetParentProcessId);
 {$ENDIF WINDOWS}
end;

procedure Free_crw_az;
begin
 {$IFDEF WINDOWS}
 if (myParentRef<>INVALID_HANDLE_VALUE) then CloseHandle(myParentRef);
 myParentRef:=INVALID_HANDLE_VALUE;
 {$ENDIF WINDOWS}
end;

initialization

 Init_crw_az;

finalization

 Free_crw_az;

end.

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

