////////////////////////////////////////////////////////////////////////////////
// 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:                                                                   //
// Process and thread related routines.                                       //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20230507 - Created for FPC (A.K.)                                          //
// 20240808 - HasSudoRights now uses `sudo -n -v` instead of `sudo -v`        //
//            Also SetProcessNice uses `sudo -n ...` to avoid hanging.        //
// 20241115 - StringToSigCode,SigCodeToString                                 //
// 20241120 - SIGRTMIN,SIGRTMAX,GetListOfUnixSignals                          //
// 20241130 - RunCommandEx,RunCommandInDirEx,SwoToString,StringToSwo          //
// 20250120 - GetListOfProcesses: if /proc/pid/sched not avail ...            //
// 20250206 - GetListOfProcesses: read /proc/pid/stat with procps             //
// 20250207 - Replace FileExists to FileIsReadable for faster read /proc/...  //
// 20250208 - GetListOfProcesses: glops_FixName                               //
// 20250216 - dlc_ReNice                                                      //
// 20250522 - read_proc_pid_file/EFOpenError                                  //
// 20260204 - UseRunCommandEx                                                 //
// 20260221 - UnixSudoit                                                      //
// 20260227 - glops_PrState,QueryProcessState                                 //
// 20260304 - PidState,PidFind etc                                            //
// 20260305 - PidMaxLimit,PidLooksAsSystem,PidLooksAsValid                    //
////////////////////////////////////////////////////////////////////////////////

unit _crw_proc; //  Process & thread 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 !!!
 //////////////////////////////////////////////////////
 {$IFDEF UNIX} baseunix, unix, unixcp, unixtype, {$ENDIF}
 {$IFDEF LINUX} termio, syscall, {$ENDIF}
 {$IFDEF WINDOWS} ShellApi, Registry, {$ENDIF}
 {$IFDEF WINDOWS} JwaWinUser, JwaTlHelp32, JwaPsApi, JwaWinBase, {$ENDIF}
 sysutils, classes, math, process, strutils, ctypes, lazfileutils,
 _crw_alloc, _crw_ef, _crw_str, _crw_procps, _crw_wmic, _crw_procws;

 ////////////////////////////////////////////////
 // Scheduling algorithms. Imported from sched.h.
 ////////////////////////////////////////////////
const
 SCHED_OTHER    = 0; // Unix normal scheduler policy - CFS, prio 100..139.
 SCHED_FIFO     = 1; // Unix realtime, FIFO or FCFS policy, prio 1..99.
 SCHED_RR       = 2; // Unix realtime, Round-Robin  policy, prio 1..99.
 SCHED_BATCH    = 3; // Unix batch (background) policy.
 SCHED_ISO      = 4; // Reserved but not implemented.
 SCHED_IDLE     = 5; // Unix idle (background) policy.
 SCHED_DEADLINE = 6; // Unix realtime, GEDF and CBS policy, prio 1..99.

 /////////////////////////////////////////////////////////////
 // Unix user-space priority of SCHED_NORMAL/SCHED_BATCH class
 // has NICE values [-20..19] mapped to [100..139] static prio
 /////////////////////////////////////////////////////////////
const
 MAX_NICE   = 19;                  // Linux nice maximal value
 MIN_NICE   = -20;                 // Linux nice minamal value
 NICE_WIDTH = MAX_NICE-MIN_NICE+1; // Linux nice range width

 /////////////////////////////////////////////////////////////
 // Process has static priority [0..MAX_PRIO-1], valid RT prio
 // is [0..MAX_RT_PRIO-1],  SCHED_NORMAL/SCHED_BATCH tasks has
 // prio [MAX_RT_PRIO..MAX_PRIO-1]. Priority values (prio) are
 // inverted: lower prio value means higher priority.
 /////////////////////////////////////////////////////////////
const
 MAX_RT_PRIO  = 100;
 MAX_PRIO     = MAX_RT_PRIO+NICE_WIDTH;
 DEFAULT_PRIO = MAX_RT_PRIO+(NICE_WIDTH div 2);

 { Convert user-nice values [-20..19] to static priority [100..139]. }
function NICE_TO_PRIO(nice:Integer):Integer;

{ Convert static priority [100..139] to user-nice values [-20..19]. }
function PRIO_TO_NICE(prio:Integer):Integer;

 { Convert nice value [19,-20] to rlimit style value [1,40]. }
function nice_to_rlimit(nice:Integer):Integer;

 { Convert rlimit style value [1,40] to nice value [-20, 19]. }
function rlimit_to_nice(prio:Integer):Integer;

 { Unix only. Get NICE value of process. }
function GetProcessNice(pid:TPid=0):Integer;

 { Unix only. Renice, i.e. set NICE value (nice) of process (pid). }
function SetProcessNice(nice:Integer; pid:TPid=0):Boolean;

 { Unix only. Default Unix Sudoit command. }
const DefUnixSudoitCmnd='unix sudoit';

 { Unix only. ON/OFF Unix Sudoit command. }
procedure UseUnixSudoit(Flag:Boolean; const Cmnd:LongString=DefUnixSudoitCmnd);

 { Unix only. Is Unix Sudoit command ON? }
function IsUnixSudoit:Boolean; inline;

 { Unix only. Get command like 'unix sudoit' or 'sudo -n' depending on flag. }
function UnixSudoit(const CmdLine:LongString=''):LongString;

 { Unix only. Check if user has sudo rights - run 'sudo -n -v'. }
function HasSudoRights:Boolean;

 { Limit for NICE. }
function GetNiceRLimit:Integer;

 {
 Linux: Get calling Thread ID (TID).
 It's PID-like number and it's not same as pthread_self handle.
 On non-Linux platfrorms return -1.
 }
function FpGetTid:TPid;

 {
 Run command (cmdline) and read output (outputstring).
 }
function RunCommand(cmdline:LongString; out outputstring:LongString; rcm:Integer=0):Boolean;

 {
 Run command (cmdline) in directory (curdir) and read output (outputstring).
 }
function RunCommandInDir(curdir,cmdline:LongString; out outputstring:LongString; rcm:Integer=0):Boolean;

const                                   //  RunCommand Modes:
 rcm_Default  = 0;                      //< Use rcm_Selected mode of RunCommand.
 rcm_Standard = 1;                      //< Use standard FPC RunCommand implementation.
 rcm_Extended = 2;                      //< Use extended RunCommandEx   implementation.
 rcm_Selected : Integer = rcm_Standard; //< Which method to use on rcm_Default.

{$IFDEF UNIX}
function sched_getaffinity(pid:Ptruint; cpusetsize:longint; cpuset:pointer):cint; cdecl;
function sched_setaffinity(pid:Ptruint; cpusetsize:longint; cpuset:pointer):cint; cdecl;
function pthread_getaffinity_np(pid:TThreadID; cpusetsize:longint; cpuset:pointer):cint; cdecl;
function pthread_setaffinity_np(pid:TThreadID; cpusetsize:longint; cpuset:pointer):cint; cdecl;
{$ENDIF}

 // Get number of CPU's.
function cpu_count:Integer;

 // CPU frequency, MHz, by source id.
 // id=(0:default,1:nominal,2:eastimated).
 // Non-zero newMHz uses to update the value.
function cpu_mhz(id:Integer=0; newMHz:Double=0):Double;

const // Default cpu_mhz source id.
 cpu_mhz_default_source_id:Integer=0;

 // Readout nominal CPU frequency MHz from registry (Windows) or /proc (Unix).
function ReadNominalCpuFrequencyMhz(nCPU:Integer=0):Double;

 // Read /proc/cpuinfo (What field) for CPU`s in CpuMask (1=CPU0,2=CPU1,etc).
 // Use What='model name' to detect processor model name
 // like 'Intel(R) Core(TM) i7-4700MQ CPU @ 2.40GHz'.
function ReadProcCpuInfo(CpuMask:Int64; What:LongString):LongString;

{$IFDEF UNIX}
 // Check user is root.
function IsIamRoot:Boolean;
{$ENDIF UNIX}

 // Return true if handle is terminal.
function IsATTY(var F:Text):Boolean; overload;
function IsATTY(Handle:LongInt):Boolean; overload;

// Get process (pid) affinity mask.
// By default, PID 0 means the current process.
function GetProcessAffinityMask(pid:TPid=0):QWord;

// Get thread (tid) affinity mask.
// By default, TID 0 means the current thread.
function GetThreadAffinityMask(tid:SizeInt=0):QWord;

// Get/Set thread (tid) affinity mask.
// Tid 0 means the current thread, Mask=0 uses to Get only.
function SetThreadAffinityMask(tid:SizeInt; Mask:QWord):QWord;

const                   // GetListOfProcesses Flags:
 glops_CmdLine = $0001; // Include CmdLine to GetListOfProcesses fields
 glops_Threads = $0002; // Include Threads to GetListOfProcesses fields
 glops_PrState = $0004; // Include State   to GetListOfProcesses fields
 glops_FixName = $0008; // Fix TASKNAME (on Unix name can be truncated)
 glops_WantWmi = $0010; // Want to use WMI rather then PSAPI on Windows
 glops_MaxInfo = glops_PrState or glops_Threads or glops_CmdLine;
 glops_Maximal = glops_FixName or glops_WantWmi or glops_MaxInfo;
 glops_FixCmdL = glops_FixName or glops_CmdLine;
 glops_FixStat = glops_FixName or glops_PrState;
 glops_Default = glops_FixName or glops_CmdLine;
 glops_DefMaxi = glops_FixName or glops_MaxInfo;
 glops_DefMini = glops_FixName;

const
 glops_sep     = ', ';  // GetListOfProcesses fields separator

 ///////////////////////////////////////////////////////////////////////////////
 // Return list of running processes as lines of: PID, PPID, PRIO, TASKNAME, ...
 // On Unix systems the /proc filesystem is uses, so support required for /proc.
 // When specified (Details=true) then adds fields specified by values of Flags:
 // The Flags may have sum of bit values [1|2|4]=[CmdLine|Threads|State].
 // Result is: PID, PPID, PRIORITY, TASKNAME [,STATE] [,THREADS] [,CMDLINE]
 ///////////////////////////////////////////////////////////////////////////////
function GetListOfProcesses(aPid,aPPid:TPid; const aName:LongString;
         Detail:Boolean=false; Flags:Integer=glops_Default):LongString;

// Format line according to Flags.
function glops_format(Pid,PPid:TPid; Priority:Integer; const TaskName:LongString;
                      State:Char; Threads:Integer; const CmdLine:LongString;
                      Flags:Integer):LongString;

// Need Detail for this Flags.
function glops_need_detail(Flags:Integer):Boolean;

// Get number of fields in GetListOfProcesses.
function glops_num_fields(Flags:Integer):Integer;

// GetListOfProcesses fields:
// [1..7]=PID,PPID,PRIORITY,TASKNAME,STATE,THREADS,CMDLINE
function glops_name_fields(num:Integer; how:Integer=0):LongString;

// List fields names uses in GetListOfProcesses.
function glops_list_fields(Flags:Integer; how:Integer=0):LongString;

function glops_iof_pid(Flags:Integer):Integer;  inline; // Index of PID
function glops_iof_ppid(Flags:Integer):Integer; inline; // Index of PPID
function glops_iof_prio(Flags:Integer):Integer; inline; // Index of PRIORITY
function glops_iof_comm(Flags:Integer):Integer; inline; // Index of TASKNAME
function glops_iof_stat(Flags:Integer):Integer;         // Index of STATE
function glops_iof_nlwp(Flags:Integer):Integer;         // Index of THREADS
function glops_iof_cmdl(Flags:Integer):Integer;         // Index of CMDLINE

 // Extract fields from lines comes from GetListOfProcesses.
function glops_fetch_pid(const Line:LongString; Flags:Integer=glops_default):Integer;
function glops_fetch_ppid(const Line:LongString; Flags:Integer=glops_default):Integer;
function glops_fetch_prio(const Line:LongString; Flags:Integer=glops_default):Integer;
function glops_fetch_comm(const Line:LongString; Flags:Integer=glops_default):LongString;
function glops_fetch_stat(const Line:LongString; Flags:Integer):Char;
function glops_fetch_nlwp(const Line:LongString; Flags:Integer):Integer;
function glops_fetch_cmdl(const Line:LongString; Flags:Integer):LongString;

// Fetch field[n] as string from lines comes from GetListOfProcesses.
function glops_fetch_str(const Line:LongString; n,Flags:Integer):LongString;

// Fetch field[n] as integer from lines comes from GetListOfProcesses.
function glops_fetch_int(const Line:LongString; n,Flags:Integer; Def:Integer=0):Integer;

// Fetch field[n] first char from lines comes from GetListOfProcesses.
function glops_fetch_chr(const Line:LongString; n,Flags:Integer; Def:Char=#0):Char;

const                                          // GetListOfProcesses preferences
 glops_prefer_proc_pid_stat : Boolean = true;  // Prefer to use /proc/pid/stat
 glops_prefer_wmi_wql_query : Boolean = false; // Prefer to use WMI WQL query

// Get Process Name with PID specified.
// By default, PID 0 means the current process.
function GetProcessName(pid:TPid=0):LongString;

// Get Parent Process ID and Name.
function GetParentProcessID:TPid;
function GetParentProcessName:LongString;

// On Unix systems parent PID may change (when parent process die).
// So let`s make parent process snapshot for future to detect "zombie".
procedure MakeParentSnapshot;
procedure FreeParentSnapshot;
function GetSnapshotParentProcessID:TPid;
function GetSnapshotParentProcessName:LongString;

const
 {$IFDEF UNIX}
 // From https://man.archlinux.org/man/core/man-pages/proc_sys_kernel.5.en
 PID_MAX_LIMIT = (Integer(1) shl 22); // See also /proc/sys/kernel/pid_max
 {$ELSE}
 PID_MAX_LIMIT = MaxInt;              // Have no other idea.
 {$ENDIF}

 // Get current PID_MAX limit.
function PidMaxLimit(Mode:Integer=0):TPid;

const                                         // PidLooksAsValid Mode flags:
 plav_TestMax = $00000001;                    // Test /proc/sys/kernel/pid_max
 plav_SkipSys = $00000002;                    // Skip system processes like init
 plav_Default = plav_TestMax;                 // Default value for all
 plav_DefSafe = plav_TestMax or plav_SkipSys; // Default for safety

 // Check PID looks as system process.
function PidLooksAsSystem(aPid:TPid):Boolean;

 // Check PID looks as valid for operations.
function PidLooksAsValid(aPid:TPid; aMode:Integer=plav_Default):Boolean;

// Query process state with given PID and (optional) name.
// Parameter aPid specify (non-zero) process PID to query.
// Parameter aName specify (opional) process name to query.
// Return process State or pps_Invalid ('?') if not exists.
// Return '?' if PID exists but process name are different.
function QueryProcessState(aPid:TPid; aPPid:TPid=0; const aName:LongString=''; aFlags:Integer=glops_FixStat):Char;

// QueryProcessState indicate process exists.
function ProcessStateIsExist(aState:Char):Boolean;

// QueryProcessState indicate process still alive.
function ProcessStateIsAlive(aState:Char):Boolean;

///////////////////////
// Simplified functions
///////////////////////

const                      // PidFind Mode:
 pfm_Single  = 1;          // Allow only one found process
 pfm_Default = 0;          // PidFind Mode uses by default

function PidState(pid,ppid:TPid; const comm:LongString; Flags:Integer=glops_FixStat):Char; inline;
function PidExist(stat:Char):Boolean; inline;
function PidAlive(stat:Char):Boolean; inline;
function PidDefun(stat:Char):Boolean; inline;
function PidFind(pid,ppid:Integer; const comm:LongString; Flags:Integer=glops_FixName; Mode:Integer=pfm_Default):Integer;
function PidEnum(pid,ppid:Integer; const comm:LongString; Flags:Integer=glops_DefMaxi):LongString;
function PidCount(pid,ppid:Integer; const comm:LongString):Integer;

type // Uses for PidTrio
 TPidTrio = record pid,ppid:TPid; comm:PureString; end;

 // Parse args = pid ppid comm
function PidTrio(const args:LongString):TPidTrio;

// getrusage - resource usage.
{$IFDEF UNIX}
const
 RUSAGE_SELF     = 0;   // the process
 RUSAGE_CHILDREN = -1;  // his childrens
 RUSAGE_BOTH     = -2;  // sys_wait4() uses this
 RUSAGE_THREAD   = 1;   // only the calling thread
type
 Prusage = ^Trusage;
 Trusage = record        // from linux headers:
  ru_utime    : timeval; // user time used
  ru_stime    : timeval; // system time used
  ru_maxrss   : longint; // maximum resident set size
  ru_ixrss    : longint; // integral shared memory size
  ru_idrss    : longint; // integral unshared data size
  ru_isrss    : longint; // integral unshared stack size
  ru_minflt   : longint; // page reclaims
  ru_majflt   : longint; // page faults
  ru_nswap    : longint; // swaps
  ru_inblock  : longint; // block input operations
  ru_oublock  : longint; // block output operations
  ru_msgsnd   : longint; // messages sent
  ru_msgrcv   : longint; // messages received
  ru_nsignals : longint; // signals received
  ru_nvcsw    : longint; // voluntary context switches
  ru_nivcsw   : longint; // involuntary
  reserved    : array[0..15] of longint; // added just for safety
 end;
function FPgetrusage(who:longint; usage:Prusage):longint;
{$ENDIF}

 // Current Process/Thread times (system s, user u) as FileTime (100 ns units).
function GetProcessTimesAsFileTime(out s,u:Int64):Boolean; // Current process
function GetThreadTimesAsFileTime(out s,u:Int64):Boolean;  // Calling thread

const
 RunCommandSleepTimeMin = 1;               // Minimal RunCommand SleepTime, ms
 RunCommandSleepTimeMax = 10000;           // Maximal RunCommand SleepTime, ms
 RunCommandTimeoutMin   = 1;               // Minimal RunCommand Timeout, ms
 RunCommandTimeoutMax   = 600000;          // Maximal RunCommand Timeout, ms
 RunCommandPipeSizeMin  = 1024;            // Minimal RunCommand PipeSize, bytes
 RunCommandPipeSizeMax  = 1024*1024*4;     // Maximal RunCommand PipeSize, bytes
 RunCommandSleepTimeDef : Integer = 4;     // Default RunCommand SleepTime
 RunCommandTimeoutDef   : Integer = 30000; // Default TimeOut for RunCommandEx
 RunCommandPipeSizeDef  : Cardinal = 16*1024; // Default PipeBufferSize
 RunCommandSwoDef       : TShowWindowOptions = swoShowMinNoActive;

 // Run command (CmdLine) in directory, wait in Idle loop with given SleepTime
 /////////////////////////////////////////////////////////////////////////////
function RunCommandInDirIdle(const CurDir,CmdLine:LongString;
                  out OutStr,ErrStr:LongString; SleepTime:Integer=0):Boolean;

 {
 Extended version of RunCommandInDir.
 CurDir      - Current directory to run in.
 CmdLine     - command line to run process.
 OutStr      - output comes from command StdOut.
 ErrStr      - output comes from command StdErr.
 swo         - ShowWindow option (actual for Windows).
 TimeOut     - maximal execution time in milliseconds.
 SleepTime   - sleep time during process waiting loop.
 TimeOut=-1  - replaces to TimeOut=RunCommandTimeoutDef.
 SleepTime=0 - replaces to SleepTime=RunCommandSleepTimeDef.
 }
function RunCommandInDirEx(const CurDir,CmdLine:LongString;
                  out OutStr,ErrStr:LongString; out ExitStatus:Integer;
                  swo:TShowWindowOptions=swoNone; TimeOut:Integer=-1;
                  SleepTime:Integer=0; PipeSize:Cardinal=0):Boolean;

 {
 Extended version of RunCommand.
 CmdLine     - command line to run.
 OutStr      - output comes from command StdOut.
 swo         - ShowWindow option (actual for Windows).
 TimeOut     - maximal execution time in milliseconds.
 SleepTime   - sleep time during process waiting loop.
 TimeOut=-1  - replaces to TimeOut=RunCommandTimeoutDef.
 SleepTime=0 - replaces to SleepTime=RunCommandSleepTimeDef.
 }
function RunCommandEx(const CmdLine:LongString; out OutStr:LongString;
                  swo:TShowWindowOptions=swoNone; TimeOut:Integer=-1;
                  SleepTime:Integer=0; PipeSize:Cardinal=0):Boolean;

 {
 Use RunCommandEx by default instead of standard RunCommand.
 Reason: standard RunCommand polling loop don't use Sleep,
 so it takes too much CPU. RunCommandEx uses Sleep in poll
 loop so it's more nice to use.
 Also set default RunCommandEx parameters (SleepTime etc).
 }
procedure UseRunCommandEx(Def:Boolean=True; SleepTime:Integer=0;
                          Timeout:Integer=0; PipeSize:Integer=0;
                          swo:TShowWindowOptions=swoNone);

 {
 Convert ShowWindowOption (swo) to string with given Prefix.
 }
function SwoToString(swo:TShowWindowOptions; const Prefix:LongString=''):LongString;

 {
 Convert string (str) to ShowWindowOption or return default (def).
 }
function StringToSwo(const str:LongString; def:TShowWindowOptions):TShowWindowOptions;

 /////////////////////////////////////////////////////////////////////////////
 // Unix signals
 /////////////////////////////////////////////////////////////////////////////
{$IFDEF UNIX}
const // Posix signals
 SIGHUP  = baseunix.SIGHUP;   SIGINT    = baseunix.SIGINT;
 SIGQUIT = baseunix.SIGQUIT;  SIGILL    = baseunix.SIGILL;
 SIGTRAP = baseunix.SIGTRAP;  SIGABRT   = baseunix.SIGABRT;
 SIGBUS  = baseunix.SIGBUS;   SIGFPE    = baseunix.SIGFPE;
 SIGKILL = baseunix.SIGKILL;  SIGUSR1   = baseunix.SIGUSR1;
 SIGSEGV = baseunix.SIGSEGV;  SIGUSR2   = baseunix.SIGUSR2;
 SIGPIPE = baseunix.SIGPIPE;  SIGALRM   = baseunix.SIGALRM;
 SIGTERM = baseunix.SIGTERM;  SIGSTKFLT = baseunix.SIGSTKFLT;
 SIGCHLD = baseunix.SIGCHLD;  SIGCONT   = baseunix.SIGCONT;
 SIGSTOP = baseunix.SIGSTOP;  SIGTSTP   = baseunix.SIGTSTP;
 SIGTTIN = baseunix.SIGTTIN;  SIGTTOU   = baseunix.SIGTTOU;
 SIGURG  = baseunix.SIGURG;   SIGXCPU   = baseunix.SIGXCPU;
 SIGXFSZ = baseunix.SIGXFSZ;  SIGVTALRM = baseunix.SIGVTALRM;
 SIGPROF = baseunix.SIGPROF;  SIGWINCH  = baseunix.SIGWINCH;
 SIGIO   = baseunix.SIGIO;    SIGPWR    = baseunix.SIGPWR;
 SIGSYS  = baseunix.SIGUNUSED;
 SIGCLD  = SIGCHLD;
 SIGIOT  = SIGABRT;
 SIGPOLL = SIGIO;
{$ELSE}
const
 SIGHUP    = 1;  SIGINT   = 2;  SIGQUIT  = 3;  SIGILL   = 4;  SIGTRAP = 5;
 SIGABRT   = 6;  SIGBUS   = 7;  SIGFPE   = 8;  SIGKILL  = 9;  SIGUSR1 = 10;
 SIGSEGV   = 11; SIGUSR2  = 12; SIGPIPE  = 13; SIGALRM  = 14; SIGTERM = 15;
 SIGSTKFLT = 16; SIGCHLD  = 17; SIGCONT  = 18; SIGSTOP  = 19; SIGTSTP = 20;
 SIGTTIN   = 21; SIGTTOU  = 22; SIGURG   = 23; SIGXCPU  = 24; SIGXFSZ = 25;
 SIGVTALRM = 26; SIGPROF  = 27; SIGWINCH = 28; SIGIO    = 29; SIGPWR  = 30;
 SIGSYS    = 31;
 SIGCLD    = SIGCHLD;
 SIGIOT    = SIGABRT;
 SIGPOLL   = SIGIO;
{$ENDIF ~WINDOWS}

function SIGRTMIN:Integer; // Minimal realtime signal
function SIGRTMAX:Integer; // Maximal realtime signal

const
 DefaultUnixSignalNames=
  'SIGHUP'+EOL    +'SIGINT'+EOL  +'SIGQUIT'+EOL  +'SIGILL'+EOL  +'SIGTRAP'+EOL
 +'SIGABRT'+EOL   +'SIGBUS'+EOL  +'SIGFPE'+EOL   +'SIGKILL'+EOL +'SIGUSR1'+EOL
 +'SIGSEGV'+EOL   +'SIGUSR2'+EOL +'SIGPIPE'+EOL  +'SIGALRM'+EOL +'SIGTERM'+EOL
 +'SIGSTKFLT'+EOL +'SIGCHLD'+EOL +'SIGCONT'+EOL  +'SIGSTOP'+EOL +'SIGTSTP'+EOL
 +'SIGTTIN'+EOL   +'SIGTTOU'+EOL +'SIGURG'+EOL   +'SIGXCPU'+EOL +'SIGXFSZ'+EOL
 +'SIGVTALRM'+EOL +'SIGPROF'+EOL +'SIGWINCH'+EOL +'SIGIO'+EOL   +'SIGPWR'+EOL
 +'SIGSYS'+EOL;

function SigListUpdateByTable(aTable:LongString=''):Integer;
function SigListUpdateByCommand(const cmd:LongString='kill -L'):Integer;

 { Convert string to signal code. }
function StringToSigCode(str:LongString; def:Integer=0):Integer;

 { Convert signal code to string. }
function SigCodeToString(sig:Integer; Mode:Integer=0):LongString;

 { Get list of known Unix signals. }
function GetListOfUnixSignals(Mode:Integer=1):LongString;

 {
 Unix: Read /proc/pid/name file as text.
 If list of items is set (like 'pid,gid,..'),
 return EOL delimited text lines "Name=Value",
 which is ready for parsing with CookieScan(..).
 }
function read_proc_pid_file(pid:TPid; name:LongString; items:LongString=''):LongString;


type // Iterator for ForEachProcPidFd
 TProcPidFdAction = function(pid:TPid; fd:Integer; Custom:Pointer):Boolean;

 {
 Call Action for each file descriptor from /proc/pid/fd/*.
 }
function ForEachProcPidFd(pid:TPid; Action:TProcPidFdAction; Custom:Pointer):Integer;

 {
 For Delphi compatibility:
 Windows: return GetModuleHandle(nil).
 Unix     return 0.
 }
function MainInstance:QWord;

implementation

uses
 _crw_rtc,
 _crw_dbglog;

var
 dlc_RunCommand:Integer=0;
 dlc_ReNice:Integer=0;

function NICE_TO_PRIO(nice:Integer):Integer; begin Result:=nice+DEFAULT_PRIO; end;
function PRIO_TO_NICE(prio:Integer):Integer; begin Result:=prio-DEFAULT_PRIO; end;
function nice_to_rlimit(nice:Integer):Integer; begin Result:=MAX_NICE-nice+1; end;
function rlimit_to_nice(prio:Integer):Integer; begin Result:=MAX_NICE-prio+1; end;

function GetProcessNice(pid:TPid=0):Integer;
begin
 Result:=-1;
 {$IFDEF UNIX}
 if (pid=0) then pid:=GetCurrentProcessId;
 Result:=FpGetPriority(PRIO_PROCESS,pid);
 // fpGetPriority use SysCall which return NICE as rlimit [1..40]
 Result:=rlimit_to_nice(Result); // So we need to convert it back
 {$ELSE ~UNIX}
 FakeNop(dlc_ReNice);
 {$ENDIF ~UNIX}
end;

function SetProcessNice(nice:Integer; pid:TPid=0):Boolean;
{$IFDEF UNIX}var cmd,ans:LongString;{$ENDIF}
begin
 Result:=false;
 {$IFDEF UNIX}
 if (pid=0) then pid:=GetCurrentProcessId;
 nice:=EnsureRange(nice,MIN_NICE,MAX_NICE);
 if (FpSetPriority(PRIO_PROCESS,pid,nice)=0) then Result:=true else begin
  if (errno=ESysEPERM) or (errno=ESysEACCES) then begin
   cmd:=UnixSudoit(Format('renice -n %d -p %d',[nice,pid]));
   Result:=RunCommand(cmd,ans);
  end;
 end;
 if DebugLogEnabled(dlc_ReNice) then begin
  ans:=IfThen(Result,'succeed','failed');
  ans:=Format('SetNice(%d,%d) %s.',[pid,nice,ans]);
  DebugLog(dlc_ReNice,ans);
 end;
 {$ENDIF ~UNIX}
end;

const
 UnixSudoitFlag:Boolean=False;
 UnixSudoitCmnd:LongString='';

function IsGoodCmnd(Cmnd:LongString):Boolean;
var PATH,exe:LongString; i,wc,n:Integer;
const exelist='unix crwkit crwrun';
const Delims=[#0..' '];
begin
 Result:=False;
 if (Cmnd='') then Exit;
 exe:=''; n:=0;
 PATH:=GetEnvironmentVariable('PATH');
 wc:=WordCount(Cmnd,Delims); if (wc<2) then Exit;
 for i:=1 to wc do begin
  exe:=ExtractWord(i,exelist,Delims);
  if StartsStr(exe+' ',Cmnd) and (FileSearch(exe,PATH,False)<>'')
  then Inc(n);
  if (n>0) then break;
 end;
 Result:=(n>0);
end;

procedure UseUnixSudoit(Flag:Boolean; const Cmnd:LongString=DefUnixSudoitCmnd);
begin
 UnixSudoitCmnd:=Trim(Cmnd);
 UnixSudoitFlag:=Flag and IsGoodCmnd(UnixSudoitCmnd);
end;

function IsUnixSudoit:Boolean;
begin
 Result:=UnixSudoitFlag;
end;

function UnixSudoit(const CmdLine:LongString=''):LongString;
const defcmd='sudo'; defopt='-n';
begin
 if IsUnixSudoit
 then Result:=UnixSudoitCmnd
 else Result:=Trim(defcmd)+' '+Trim(defopt);
 Result:=Trim(Trim(Result)+' '+Trim(CmdLine));
end;

function HasSudoRights:Boolean;
{$IFDEF UNIX}var ans:LongString;{$ENDIF}
begin
 Result:=false;
 {$IFDEF UNIX}
 if IsIamRoot then Exit(true);
 Result:=RunCommand(UnixSudoit('-v'),ans);
 {$ENDIF ~UNIX}
end;

{$IFDEF UNIX}
const
 RLIMIT_NICE = 13;
{$ENDIF ~UNIX}

function GetNiceRLimit:Integer;
{$IFDEF UNIX}var R:TRLimit;{$ENDIF}
begin
 Result:=0;
 {$IFDEF UNIX}
 if (FpGetRLimit(RLIMIT_NICE,@R)<>-1) then Result:=R.rlim_cur;
 {$ENDIF ~UNIX}
end;

function FpGetTid:TPid;
begin
 Result:=-1;
 {$IFDEF LINUX}
 if IsLinux then Result:=do_syscall(syscall_nr_gettid);
 {$ENDIF ~LINUX}
 {$IFDEF WINDOWS}
 if IsWindows then Result:=Windows.GetCurrentThreadId;
 {$ENDIF ~WINDOWS}
end;

{$PUSH}
{$WARN 5043 off : Symbol "$1" is deprecated}
function RunCommand(cmdline:LongString; out outputstring:LongString; rcm:Integer=0):Boolean;
var s:String;
begin
 if (rcm=rcm_Default) then rcm:=rcm_Selected;
 if (rcm=rcm_Extended) then Exit(RunCommandEx(cmdline,outputstring));
 if DebugLogEnabled(dlc_RunCommand) then DebugLog(dlc_RunCommand,cmdline);
 Result:=process.RunCommand(cmdline,s);
 outputstring:=s;
end;
function RunCommandInDir(curdir,cmdline:LongString; out outputstring:LongString; rcm:Integer=0):Boolean;
var s:String; errstr:LongString; ExitStatus:Integer;
begin
 if (rcm=rcm_Default) then rcm:=rcm_Selected;
 if (rcm=rcm_Extended) then Exit(RunCommandInDirEx(curdir,cmdline,outputstring,errstr,ExitStatus));
 if DebugLogEnabled(dlc_RunCommand) then DebugLog(dlc_RunCommand,cmdline);
 Result:=process.RunCommandInDir(curdir,cmdline,s);
 outputstring:=s;
end;
{$POP}

{$IFDEF UNIX}
function sched_getaffinity(pid:Ptruint; cpusetsize:longint; cpuset:pointer):cint; cdecl; external 'c' name 'sched_getaffinity';
function sched_setaffinity(pid:Ptruint; cpusetsize:longint; cpuset:pointer):cint; cdecl; external 'c' name 'sched_setaffinity';
function pthread_getaffinity_np(pid:TThreadID; cpusetsize:longint; cpuset:pointer):cint; cdecl; external 'c' name 'pthread_getaffinity_np';
function pthread_setaffinity_np(pid:TThreadID; cpusetsize:longint; cpuset:pointer):cint; cdecl; external 'c' name 'pthread_setaffinity_np';
{$ENDIF}

{$IFDEF UNIX}
function get_nprocs:longint; cdecl; external 'c' name 'get_nprocs';
{$ENDIF}

function cpu_count:Integer;
begin
 {$IFDEF UNIX}
 Result:=get_nprocs;
 {$ELSE}
 Result:=System.GetCPUCount;
 {$ENDIF UNIX}
end;

{$IFDEF WINDOWS}
////////////////////////////////////////////////////////////////////////////////
// Readout CPU frequency from registry
// HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\System\CentralProcessor\0\~MHZ:DWORD
////////////////////////////////////////////////////////////////////////////////
function ReadNominalCpuFrequencyMhz(nCPU:Integer=0):Double;
var reg:TRegistry; key:LongString;
begin
 Result:=0;
 try
  reg:=TRegistry.Create;
  try
   reg.RootKey:=HKEY_LOCAL_MACHINE;
   key:='HARDWARE\DESCRIPTION\System\CentralProcessor\'+IntToStr(nCPU);
   if Reg.OpenKeyReadOnly(key)
   then Result:=reg.ReadInteger('~MHZ')
   else Result:=0;
  finally
   reg.CloseKey;
   reg.Free;
  end;
 except
  on E:Exception do BugReport(E,nil,'ReadNominalCpuFrequencyMhz');
 end;
end;
function ReadCpuProcessorNameString(nCPU:Integer):LongString;
var reg:TRegistry; key:LongString;
begin
 Result:='';
 try
  reg:=TRegistry.Create;
  try
   reg.RootKey:=HKEY_LOCAL_MACHINE;
   key:='HARDWARE\DESCRIPTION\System\CentralProcessor\'+IntToStr(nCPU);
   if Reg.OpenKeyReadOnly(key)
   then Result:=reg.ReadString('ProcessorNameString')
   else Result:='';
  finally
   reg.CloseKey;
   reg.Free;
  end;
 except
  on E:Exception do BugReport(E,nil,'ReadCpuProcessorNameString');
 end;
end;
function ReadProcCpuInfo(CpuMask:Int64; What:LongString):LongString;
var i:Integer;
begin
 Result:='';
 try
  if (CpuMask=0)
  then CpuMask:=-1;
  What:=Trim(What);
  if (What='') then Exit;
  for i:=0 to cpu_count-1 do begin
   if ((CpuMask and 1)<>0) then begin
    if SameText(What,'model name')
    then Result:=Result+ReadCpuProcessorNameString(i)+EOL;
   end;
   CpuMask:=CpuMask shr 1;
   if (CpuMask=0) then Break;
  end;
  Result:=Trim(Result);
 except
  on E:Exception do BugReport(E,nil,'ReadProcCpuInfo');
 end;
end;
{$ENDIF WINDOWS}
{$IFDEF UNIX}
function ReadProcCpuInfo(CpuMask:Int64; What:LongString):LongString;
var Lines:TStringList; Line,Name,Value:LongString; i,p:Integer;
begin
 Result:='';
 if FileIsReadable('/proc/cpuinfo') then
 try
  if (CpuMask=0)
  then CpuMask:=-1;
  What:=Trim(What);
  if (What='') then Exit;
  Lines:=TStringList.Create;
  try
   Lines.LoadFromFile('/proc/cpuinfo');
   for i:=0 to Lines.Count-1 do begin
    Line:=Lines[i]; p:=Pos(':',Line);
    if (p=0) then continue;
    Name:=Copy(Line,1,p-1);
    Value:=Copy(Line,p+1,Length(Line)-p);
    Name:=Trim(Name); Value:=Trim(Value);
    if SameText(Name,What) then begin
     if ((CpuMask and 1)<>0) then begin
      Result:=Result+Value+EOL;
     end;
     CpuMask:=CpuMask shr 1;
     if (CpuMask=0) then Break;
    end;
   end;
   Result:=Trim(Result);
  finally
   Lines.Free;
  end;
 except
  on E:Exception do BugReport(E,nil,'ReadProcCpuInfo');
 end;
end;
{$ENDIF UNIX}
{$IFDEF UNIX}
function ReadNominalCpuFrequencyMhz(nCPU:Integer=0):Double;
var Model,Freq:LongString; p:Integer; CpuMask:Int64;
begin
 Result:=0;
 try
  CpuMask:=1; CpuMask:=CpuMask shl nCPU;
  Model:=ReadProcCpuInfo(CpuMask,'model name');
  Model:=Copy(Model,Pos('@',Model)+1,255);
  Model:=Trim(UpperCase(Model));
  p:=Pos('GHZ',Model);
  if (p>0) then begin
   Freq:=Trim(Copy(Model,1,p-1));
   Result:=StrToFloatDef(Freq,0)*1000;
   Exit;
  end;
  p:=Pos('MHZ',Model);
  if (p>0) then begin
   Freq:=Trim(Copy(Model,1,p-1));
   Result:=StrToFloatDef(Freq,0);
   Exit;
  end;
 except
  on E:Exception do BugReport(E,nil,'ReadNominalCpuFrequencyMhz');
 end;
end;
{$ENDIF UNIX}

var // CPU frequency MHz: 0-default, 1-nominal, 2-eastimated.
 cpu_mhz_list:packed array[1..2] of Double;

function cpu_mhz(id:Integer=0; newMHz:Double=0):Double;
var i:Integer;
begin
 Result:=0;
 if IsNan(newMHz) or IsInfinite(newMHz) then Exit;
 if not InRange(id,0,High(cpu_mhz_list)) then Exit;
 if (id>0) and (newMHz<>0) then cpu_mhz_list[id]:=Max(0,newMHz);
 if (id=0) then id:=cpu_mhz_default_source_id;
 if (id=0) then begin
  for i:=Low(cpu_mhz_list) to High(cpu_mhz_list) do
  if (id=0) and (cpu_mhz_list[i]>0) then begin
   id:=i; cpu_mhz_default_source_id:=i; Break;
  end;
 end;
 id:=EnsureRange(id,Low(cpu_mhz_list),High(cpu_mhz_list));
 Result:=cpu_mhz_list[id];
end;

procedure InitCpuMhzList;
begin
 SafeFillChar(cpu_mhz_list,SizeOf(cpu_mhz_list),0);
 cpu_mhz(1,ReadNominalCpuFrequencyMhz);
end;

{$IFDEF UNIX}
function IsIamRoot:Boolean;
begin
 Result:=(FpGeteuid=0); // The root user has effective UID = 0.
end;
{$ENDIF UNIX}

function IsATTY(Handle:LongInt):Boolean;
begin
 {$IFDEF LINUX}
 Result:=(Termio.IsATTY(Handle)=1);
 {$ELSE}
 Result:=false;
 {$ENDIF LINUX}
end;

function IsATTY(var F:Text):Boolean;
begin
 {$IFDEF LINUX}
 Result:=(Termio.IsATTY(F)=1);
 {$ELSE}
 Result:=false;
 {$ENDIF LINUX}
end;

function GetProcessAffinityMask(pid:TPid=0):QWord;
{$IFDEF WINDOWS}var a1,a2:PtrUInt;{$ENDIF}
begin
 Result:=0;
 {$IFDEF WINDOWS}
 if (pid=0) then pid:=GetCurrentProcess; a1:=0; a2:=0;
 if jwawinbase.GetProcessAffinityMask(pid,a1,a2) then Result:=a1;
 {$ENDIF}
 {$IFDEF LINUX}
 if (pid=0) then pid:=GetProcessId;
 if sched_getaffinity(pid,SizeOf(Result),@Result)<>0
 then Result:=0;
 {$ENDIF}
end;

function GetThreadAffinityMask(tid:SizeInt):QWord;
begin
 Result:=SetThreadAffinityMask(tid,0);
end;

function SetThreadAffinityMask(tid:SizeInt; Mask:QWord):QWord;
begin
 Result:=0;
 {$IFDEF WINDOWS}
 if (tid=0) then tid:=GetCurrentThread;
 Result:=Windows.SetThreadAffinityMask(tid,Mask);
 {$ENDIF}
 {$IFDEF LINUX}
 if sched_getaffinity(tid,SizeOf(Result),@Result)<>0 then Result:=0;
 if (Mask=0) then Exit; // Mask cannot be 0, use it for read only
 if sched_setaffinity(tid,SizeOf(Mask),@Mask)=0 then {Ok};
 {$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////
// Print Process Status:
//    PID, PPID, PRIORITY, TASKNAME [,STATE] [,THREADS] [,CMDLINE]
// 0: PID, PPID, PRIORITY, TASKNAME
// 1: PID, PPID, PRIORITY, TASKNAME, CMDLINE
// 2: PID, PPID, PRIORITY, TASKNAME, THREADS
// 3: PID, PPID, PRIORITY, TASKNAME, THREADS, CMDLINE
// 4: PID, PPID, PRIORITY, TASKNAME, STATE
// 5: PID, PPID, PRIORITY, TASKNAME, STATE, CMDLINE
// 6: PID, PPID, PRIORITY, TASKNAME, STATE, THREADS
// 7: PID, PPID, PRIORITY, TASKNAME, STATE, THREADS, CMDLINE
////////////////////////////////////////////////////////////////////////////////
function glops_format(Pid,PPid:TPid; Priority:Integer; const TaskName:LongString;
                      State:Char; Threads:Integer; const CmdLine:LongString;
                      Flags:Integer):LongString;
const sep=glops_sep;
begin
 Result:=IntToStr(Pid)+sep+IntToStr(PPid)+sep+IntToStr(Priority)+sep+TaskName;
 if HasFlags(Flags,glops_PrState) then Result:=Result+sep+pps_ValidateState(State);
 if HasFlags(Flags,glops_Threads) then Result:=Result+sep+IntToStr(Threads);
 if HasFlags(Flags,glops_CmdLine) then Result:=Result+sep+CmdLine;
end;

function glops_need_detail(Flags:Integer):Boolean;
begin
 Result:=HasFlags(Flags,glops_Maximal);
end;

function glops_num_fields(Flags:Integer):Integer;
begin
 Result:=4;
 if HasFlags(Flags,glops_PrState) then Inc(Result);
 if HasFlags(Flags,glops_Threads) then Inc(Result);
 if HasFlags(Flags,glops_CmdLine) then Inc(Result);
end;

function glops_name_fields(num:Integer; how:Integer=0):LongString;
type TFieldNames=array[1..7] of LongString; THowDisplay=array[0..7] of TFieldNames;
const fields:THowDisplay=(
  ('PID', 'PPID',     'PRIORITY', 'TASKNAME', 'STATE', 'THREADS', 'CMDLINE'), // crw def
  ('Pid', 'ParentPid','Priority', 'Name',     'State', 'Threads', 'CmdLine'), // @pid list
  ('Pid', 'PPid',     'Priority', 'Name',     'State', 'Threads', 'CmdLine'), // crw alter
  ('PID', 'PPID',     'PRIO',     'NAME',     'STAT',  'THREADS', 'CMDLINE'), // crw short
  ('PID', 'PPID',     'PRI',      'COMM',     'S',     'NLWP',    'COMMAND'), // ps
  ('PID', 'PPID',     'PR',       'COMM',     'S',     'nTH',     'COMMAND'), // top
  ('PID', 'PPID',     'PRI',      'COMM',     'S',     'NLWP',    'Command'), // htop
  ('PID', 'PPID',     'PRIORITY', 'TASKNAME', 'STATE', 'THREADS', 'CMDLINE')  // crw def
 );
begin
 Result:='';
 how:=EnsureRange(how,Low(THowDisplay),High(THowDisplay));
 if InRange(num,Low(TFieldNames),High(TFieldNames))
 then Result:=fields[how][num];
end;

function glops_list_fields(Flags:Integer; how:Integer=0):LongString;
begin
 Result:=glops_name_fields(1,how)
    +','+glops_name_fields(2,how)
    +','+glops_name_fields(3,how)
    +','+glops_name_fields(4,how);
 if HasFlags(Flags,glops_PrState) then Result:=Result+','+glops_name_fields(5,how);
 if HasFlags(Flags,glops_Threads) then Result:=Result+','+glops_name_fields(6,how);
 if HasFlags(Flags,glops_CmdLine) then Result:=Result+','+glops_name_fields(7,how);
end;

function glops_iof_pid(Flags:Integer):Integer;
begin
 Result:=1;
end;

function glops_iof_ppid(Flags:Integer):Integer;
begin
 Result:=2;
end;

function glops_iof_prio(Flags:Integer):Integer;
begin
 Result:=3;
end;

function glops_iof_comm(Flags:Integer):Integer;
begin
 Result:=4;
end;

function glops_iof_stat(Flags:Integer):Integer;
begin
 Result:=4;
 if HasFlags(Flags,glops_PrState) then Inc(Result) else Result:=0;
end;

function glops_iof_nlwp(Flags:Integer):Integer;
begin
 Result:=4;
 if HasFlags(Flags,glops_PrState) then Inc(Result);
 if HasFlags(Flags,glops_Threads) then Inc(Result) else Result:=0;
end;

function glops_iof_cmdl(Flags:Integer):Integer;
begin
 Result:=4;
 if HasFlags(Flags,glops_PrState) then Inc(Result);
 if HasFlags(Flags,glops_Threads) then Inc(Result);
 if HasFlags(Flags,glops_CmdLine) then Inc(Result) else Result:=0;
end;

type
 TGlopsFetchPosRec=record Buf:PChar; Len:SizeInt; end;

function glops_fetch_pos(const Line:LongString; n,Flags:Integer):TGlopsFetchPosRec;
const Sep:PChar=glops_sep; SepLen=Length(glops_sep);
var P,PB,PE,PW:PChar; nw,nlast:Integer;
 function FetchIt(P1,P2:PChar):TGlopsFetchPosRec;
 begin
  Dec(P2); // Points to last char
  while (P1<=P2) and (P1[0]<=' ') do Inc(P1); // Trim left
  while (P1<=P2) and (P2[0]<=' ') do Dec(P2); // Trim right
  Inc(P2); // Points after last char
  Result.Len:=Max(0,P2-P1);
  Result.Buf:=P1;
 end;
 function StrLSame(P1,P2:PChar; L:SizeInt):Boolean;
 var P2E:PChar;
 begin
  Result:=False;
  if (L>0) then begin
   P2E:=P2+L;
   while (P2<P2E) do begin
    if (P1[0]<>P2[0]) then Exit;
    Inc(P1); Inc(P2);
   end;
   Result:=True;
  end;
 end;
begin
 Result.Len:=0;
 Result.Buf:=nil;
 if (Line='') then Exit;
 nlast:=glops_num_fields(Flags);
 if InRange(n,1,nlast) then begin
  PB:=PChar(Line);
  PE:=PB+Length(Line);
  P:=PB; PW:=PB; nw:=1;
  while (P<PE) do begin
   if (nw=nlast) then Exit(FetchIt(PW,PE));
   if (nw=n) and (P+1=PE) then Exit(FetchIt(PW,PE));
   if (P[0]=Sep[0]) and StrLSame(P,Sep,SepLen) then begin
    if (nw=n) then Exit(FetchIt(PW,P));
    PW:=P+SepLen; Inc(nw);
    Inc(P,SepLen-1);
   end;
   Inc(P);
  end;
 end;
end;

function glops_fetch_str(const Line:LongString; n,Flags:Integer):LongString;
var Rec:TGlopsFetchPosRec;
 function FetchIt(Buf:PChar; Len:SizeInt):LongString;
 begin
  Result:='';
  if Assigned(Buf) and (Len>0)
  then SetString(Result,Buf,Len);
 end;
begin
 Result:='';
 if (Line='') then Exit;
 Rec:=glops_fetch_pos(Line,n,Flags);
 Result:=FetchIt(Rec.Buf,Rec.Len);
end;

function glops_fetch_int(const Line:LongString; n,Flags:Integer; Def:Integer=0):Integer;
var Rec:TGlopsFetchPosRec;
 function FetchIt(Buf:PChar; Len:SizeInt):Integer;
 var s,v,d:Integer; P1,P2:PChar;
 begin
  Result:=Def;
  if Assigned(Buf) and (Len>0) then begin
   P1:=Buf; P2:=Buf+(Len-1); s:=1; v:=0; d:=0;
   while (P1<=P2) and (P1[0]<=' ') do Inc(P1);
   while (P1<=P2) and (P2[0]<=' ') do Dec(P2);
   if (P1<=P2) and (P1[0] in ['+','-']) then begin
    if (P1[0]='-') then s:=-1;
    Inc(P1);
   end;
   while (P1<=P2) do begin
    d:=Ord(P1[0])-Ord('0');
    if InRange(d,0,9)
    then v:=v*10+d
    else Exit(Def);
    Inc(P1);
   end;
   if (s>=0)
   then Result:=+v
   else Result:=-v;
  end;
 end;
begin
 Result:=0;
 if (Line='') then Exit;
 Rec:=glops_fetch_pos(Line,n,Flags);
 Result:=FetchIt(Rec.Buf,Rec.Len);
end;

function glops_fetch_chr(const Line:LongString; n,Flags:Integer; Def:Char=#0):Char;
var Rec:TGlopsFetchPosRec;
 function FetchIt(Buf:PChar; Len:SizeInt):Char;
 begin
  Result:=Def;
  if Assigned(Buf) and (Len>0)
  then Result:=Buf[0];
 end;
begin
 Result:=Def;
 if (Line='') then Exit;
 Rec:=glops_fetch_pos(Line,n,Flags);
 Result:=FetchIt(Rec.Buf,Rec.Len);
end;

function glops_fetch_pid(const Line:LongString; Flags:Integer):Integer;
begin
 Result:=glops_fetch_int(Line,glops_iof_pid(Flags),Flags);
end;

function glops_fetch_ppid(const Line:LongString; Flags:Integer):Integer;
begin
 Result:=glops_fetch_int(Line,glops_iof_ppid(Flags),Flags);
end;

function glops_fetch_prio(const Line:LongString; Flags:Integer):Integer;
begin
 Result:=glops_fetch_int(Line,glops_iof_prio(Flags),Flags);
end;

function glops_fetch_comm(const Line:LongString; Flags:Integer):LongString;
begin
 Result:=glops_fetch_str(Line,glops_iof_comm(Flags),Flags);
end;

function glops_fetch_stat(const Line:LongString; Flags:Integer):Char;
var s:Char;
begin
 s:=glops_fetch_chr(Line,glops_iof_stat(Flags),Flags,pps_Invalid);
 Result:=pps_ValidateState(s);
end;

function glops_fetch_nlwp(const Line:LongString; Flags:Integer):Integer;
begin
 Result:=glops_fetch_int(Line,glops_iof_nlwp(Flags),Flags);
end;

function glops_fetch_cmdl(const Line:LongString; Flags:Integer):LongString;
begin
 Result:=glops_fetch_str(Line,glops_iof_cmdl(Flags),Flags);
end;

{$IFDEF UNIX}
{$PUSH}
{$IOCHECKS OFF}
// List processes as PID, PPID, PRIORITY, TASKNAME [,THREADS] [,CMDLINE]
function GetListOfProcesses(aPid,aPPid:TPid; const aName:LongString;
         Detail:Boolean=false; Flags:Integer=glops_Default):LongString;
var Rec:TSearchRec; Pid,PPid,Prio,Threads,i:SizeInt; PrMode:Integer;
var Proc,List:TStringList; TaskName,CmdLine,FBuff:LongString;
var PrState:Char;
 function GetParamName(const Line:LongString):LongString;
 begin
  Result:=Trim(ExtractWord(1,Line,[':']));
 end;
 function GetParamValue(const Line:LongString):LongString;
 begin
  Result:=Trim(ExtractWord(2,Line,[':']));
 end;
 procedure ValidateCmdLine(var CmdLine:LongString);
 var List:TStringList; i,j:Integer; q:Char; Line:LongString;
 const QuoteMark='"'; Apostrophe='''';
 begin
  if (Pos(#0,CmdLine)>0) then begin
   List:=TStringList.Create;
   try
    List.Text:=StringReplace(CmdLine,#0,EOL,[rfReplaceAll]);
    for i:=List.Count-1 downto 0 do begin
     q:=' '; Line:=List[i];
     for j:=1 to Length(line) do begin
      case Line[j] of
       QuoteMark:  q:=Apostrophe;
       Apostrophe: begin q:=QuoteMark;  break; end;
       ' ',#9,'\','|',';','&','`','$','(',')': q:=Apostrophe;
      end;
     end;
     if (q<>' ') then List[i]:=AnsiQuotedStr(Line,q);
    end;
    CmdLine:=StringReplace(List.Text,EOL,' ',[rfReplaceAll]);
   finally
    List.Free;
   end;
  end;
  CmdLine:=Trim(CmdLine);
 end;
 procedure ApplyFBuff(var F:Text);
 begin
  if (FBuff='') then FBuff:=StringBuffer(OS_PIPE_BUF);
  if (FBuff<>'') then SetTextBuf(F,PChar(FBuff)^,Length(FBuff));
 end;
 function GetProcStatus(Pid:TPid; var PPid,Prio,Threads:SizeInt; var TaskName,CmdLine:LongString; var PrState:Char):Boolean;
 const ids=[ppsid_pid,ppsid_comm,ppsid_state,ppsid_ppid,ppsid_nice,ppsid_num_threads,ppsid_policy,ppsid_rt_priority];
 var i,p,n:SizeInt; Line,sn,sv,fn:LongString; F:Text; pps:TProcPidStat; namefix:Boolean;
 begin
  Result:=false;
  PPid:=0; Prio:=0; Threads:=0; TaskName:=''; CmdLine:=''; n:=0; namefix:=false;
  PrState:=pps_Invalid;
  if (Pid=0) then Exit;
  IoResult;
  if (n=0) and glops_prefer_proc_pid_stat then begin
   //
   // Read /proc/pid/stat & get [pid,comm,state,ppid,nice,policy,rt_priority]
   // Using of /proc/pid/stat looks faster compare to /proc/pid/status,
   // but we keep older version with /proc/pid/status as fallback code.
   //
   fn:='/proc/'+IntToStr(Pid)+'/stat';
   if FileIsReadable(fn) then begin
    Assign(F,fn);
    Reset(F);
    ApplyFBuff(F);
    try
     Readln(F,Line);
     if (IOResult=0) then
     if parse_proc_pid_stat(Line,pps,ids) then
     if (pps.pid=Pid) and (pps.comm[0]<>#0) then
     if (pps.ppid>=0) and (pps.state in pps_states_valid) then begin
      TaskName:=StrPas(pps.comm); inc(n);
      PPid:=pps.ppid; inc(n);
      Threads:=pps.num_threads; inc(n);
      if (pps.policy=SCHED_OTHER) or (pps.rt_priority<=0)
      then Prio:=NICE_TO_PRIO(pps.nice)
      else Prio:=pps.rt_priority;
      PrState:=pps_ValidateState(pps.state);
      inc(n);
     end;
    finally
     Close(F);
     IoResult;
    end;
   end;
  end;
  if (n=0) then begin
   //
   // Read /proc/pid/status Pid,Name,PPid,Threads
   //
   fn:='/proc/'+IntToStr(Pid)+'/status';
   if FileIsReadable(fn) then begin
    Assign(F,fn);
    Reset(F);
    ApplyFBuff(F);
    try
     while not Eof(F) and (n<3) do begin
      Readln(F,Line);
      sn:=GetParamName(Line);
      sv:=GetParamValue(Line);
      if (IOResult<>0) then Exit;
      if SameText(sn,'Pid') and (StrToInt64Def(sv,0)=0) then Exit;
      if SameText(sn,'Name') then begin TaskName:=sv; inc(n); end else
      if SameText(sn,'PPid') then begin PPid:=StrToInt64Def(sv,0); inc(n); end;
      if SameText(sn,'Threads') then begin Threads:=StrToInt64Def(sv,0); inc(n); end;
      if SameText(sn,'State') and (Length(sv)>0) then PrState:=pps_ValidateState(sv[1]);
     end;
    finally
     Close(F);
     IoResult;
    end;
   end else Exit;
   //
   // Read /proc/pid/sched prio:
   // This feature depends on CONFIG_SCHED_DEBUG in kernel boot config.
   // Switch parameter 'CONFIG_SCHED_DEBUG=y' to activate this feature
   // in file "/boot/config-$(uname -r)".
   //
   fn:='/proc/'+IntToStr(Pid)+'/sched';
   if FileIsReadable(fn) then begin
    Assign(F,fn);
    Reset(F);
    ApplyFBuff(F);
    try
     while not Eof(F) and (n<4) do begin
      Readln(F,Line);
      sn:=GetParamName(Line);
      sv:=GetParamValue(Line);
      if (IOResult<>0) then Exit;
      if SameText(sn,'prio') then begin Prio:=StrToIntDef(sv,0); inc(n); end;
     end;
    finally
     Close(F);
     IoResult;
    end;
   end else begin
    // If file /proc/pid/sched is not available, then use GetProcessNice.
    Prio:=NICE_TO_PRIO(GetProcessNice(Pid));
    inc(n);
   end;
  end;
  // Required name fix? The /proc/pid/stat (comm) field may be truncated.
  // Strings longer than TASK_COMM_LEN (16) characters are silently truncated.
  // Strings with length > TASK_COMM_LEN-1 are not truncated (system threads).
  // Strings with length < TASK_COMM_LEN-1 are not truncated (has short name).
  // Strings with length = TASK_COMM_LEN-1 are into doubt: it may be truncated.
  // Such names should be corrected by using CmdLine (see below).
  if Detail and HasFlags(Flags,glops_FixName) then begin
   if (Length(TaskName)=TASK_COMM_LEN-1)
   then namefix:=true;
  end;
  Result:=(n>=4);
  if not Result then Exit;
  if not Detail then Exit;
  if HasFlags(Flags,glops_CmdLine) or namefix then begin
   //
   // Read /proc/pid/cmdline
   //
   fn:='/proc/'+IntToStr(Pid)+'/cmdline';
   if FileIsReadable(fn) then begin
    Assign(F,fn);
    Reset(F);
    ApplyFBuff(F);
    try
     Readln(F,Line);
     if (IoResult=0) then begin
      CmdLine:=TrimLeft(Line);
      ValidateCmdLine(CmdLine);
     end;
    finally
     Close(F);
     IoResult;
    end;
   end;
  end;
  // Truncated name can be fixed by using CmdLine argv[0] or argv[1].
  // To fix TaskName extract argv[0,1] basename. If this name starts
  // with TaskName and has greater length, use this name for TaskName.
  if (CmdLine<>'') and namefix then begin
   for i:=1 to 2 do begin
    fn:=ExtractWord(i,CmdLine,[' ',#9,',']);
    p:=SysUtils.LastDelimiter(DirectorySeparator,fn);
    if (p>0) then Delete(fn,1,p);
    if (Length(TaskName)<Length(fn)) then
    if StartsStr(TaskName,fn) then begin
     TaskName:=fn;
     Break;
    end;
   end;
  end;
 end;
 function MatchName(const aName,TaskName:LongString):Boolean;
 var Comm:LongString;
 begin
  Result:=(aName='') or SameText(aName,TaskName);
  if not Result then
  if (Length(aName)>=TASK_COMM_LEN-1) then
  if (Length(TaskName)>=TASK_COMM_LEN-1) then begin
   if HasFlags(PrMode,glops_FixName) then begin
    if (Length(TaskName)>TASK_COMM_LEN-1) then
    if (Length(aName)=TASK_COMM_LEN-1) then begin
     Comm:=Copy(TaskName,1,TASK_COMM_LEN-1);
     Result:=SameText(aName,Comm);
    end;
   end else begin
    if (Length(aName)>TASK_COMM_LEN-1) then
    if (Length(TaskName)=TASK_COMM_LEN-1) then begin
     Comm:=Copy(aName,1,TASK_COMM_LEN-1);
     Result:=SameText(Comm,TaskName);
    end;
   end;
  end;
 end;
begin
 Result:='';
 try
  FBuff:='';
  // Calculate printing mode
  PrMode:=IfThen(Detail,Flags,0);
  // Single PID requested
  if (aPid<>0) then begin
   if FileIsReadable('/proc/'+IntToStr(aPid)+'/status') then begin
    Pid:=aPid; PPid:=0; Prio:=0; Threads:=0; TaskName:=''; CmdLine:='';
    PrState:=pps_Invalid;
    if GetProcStatus(Pid,PPid,Prio,Threads,TaskName,CmdLine,PrState) then
    if (aPPid=0) or (aPPid=PPid) then
    if (aName='') or MatchName(aName,TaskName) then
    Result:=glops_format(Pid,PPid,Prio,TaskName,PrState,Threads,CmdLine,PrMode);
   end;
   Exit;
  end;
  // Process list requested
  Proc:=TStringList.Create;
  List:=TStringList.Create;
  try
   IOResult;
   // Read /proc/pid to Proc list
   if (FindFirstUTF8('/proc/*',faDirectory,Rec)=0) then
   repeat
    Pid:=StrToIntDef(Rec.Name,0);
    if (Pid<>0) then Proc.Add(IntToStr(Pid));
   until (FindNextUTF8(Rec)<>0);
   FindCloseUTF8(Rec);
   // Select pid's by filter
   for i:=0 to Proc.Count-1 do begin
    Pid:=StrToIntDef(Proc[i],0);
    if (Pid=0) then Continue else
    if (aPid=0) or (aPid=Pid) then begin
     PPid:=0; Prio:=0; Threads:=0; TaskName:=''; CmdLine:='';
     PrState:=pps_Invalid;
     if GetProcStatus(Pid,PPid,Prio,Threads,TaskName,CmdLine,PrState) then
     if (aPPid=0) or (aPPid=PPid) then
     if (aName='') or MatchName(aName,TaskName) then
     List.Add(glops_format(Pid,PPid,Prio,TaskName,PrState,Threads,CmdLine,PrMode));
    end;
   end;
   Result:=List.Text;
  finally
    List.Free;
    Proc.Free;
    IoResult;
  end;
 except
  on E:Exception do BugReport(E,nil,'GetListOfProcesses');
 end;
end;
{$POP}
{$ENDIF UNUX}

{$IFDEF WINDOWS}
function GetPidCmdLine(pid:TPid; Mode:Integer):LongString;
begin
 Result:='';
 if (pid=0) then Exit;
 if not HasFlags(Mode,glops_CmdLine) then Exit;
 // This is fake CndLine reader, use WMI instead
end;
// List processes as PID, PPID, Priority, EXE
function GetListOfProcesses(aPid,aPPid:TPid; const aName:LongString;
         Detail:Boolean=false; Flags:Integer=glops_Default):LongString;
var hProcessSnap:THandle; pe32:PROCESSENTRY32; List:TStringList; Mode:Integer;
var UseWmi:Boolean;
begin
 Result:='';
 try
  Mode:=IfThen(Detail,Flags,0);
  UseWmi:=glops_prefer_wmi_wql_query;
  // To get CmdLine, WMI service WQL query is required.
  // WMI query is official way to read CmdLine of processes.
  if Detail and HasFlags(Flags,glops_CmdLine) then UseWmi:=true;
  if Detail and HasFlags(Flags,glops_WantWmi) then UseWmi:=true;
  if UseWmi then begin // Use WMI query instead of PSAPI
   Result:=WMI_GetListOfProcesses(aPid,aPPid,aName,Mode);
   Exit;
  end;
  List:=TStringList.Create;
  try
   hProcessSnap:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
   if(hProcessSnap<>0) and (hProcessSnap<>INVALID_HANDLE_VALUE) then
   try
    ZeroMemory(@pe32,sizeof(pe32));
    pe32.dwSize:=sizeof(pe32);
    if Process32First(hProcessSnap,pe32) then
    repeat
      Mode:=IfThen(Detail,Flags,0);
      if (aPID=0) or (LongWord(aPID)=pe32.th32ProcessID) then
      if (aPPID=0) or (LongWord(aPPID)=pe32.th32ParentProcessID) then
      if (aName='') or SameText(aName,pe32.szExeFile) then
      List.Add(glops_format(pe32.th32ProcessID,pe32.th32ParentProcessID,
               pe32.pcPriClassBase,pe32.szExeFile,pps_Running,pe32.cntThreads,
               GetPidCmdLine(pe32.th32ProcessID,Mode),Mode));
    until not Process32Next(hProcessSnap,pe32);
   finally
    CloseHandle(hProcessSnap);
   end;
   if (List.Count>0) then Result:=List.Text;
  finally
   List.Free;
  end;
 except
  on E:Exception do BugReport(E,nil,'GetListOfProcesses');
 end;
end;
{$ENDIF WINDOWS}

{$IFDEF UNIX}
function GetParentProcessID:TPid;
begin
 Result:=FpGetppid;
end;
{$ENDIF UNUX}

{$IFDEF WINDOWS}
function GetParentProcessID:SizeInt;
var list,item:LongString;
begin
 list:=GetListOfProcesses(System.GetProcessID,0,'');
 item:=ExtractWord(2,list,[' ',',']);
 Result:=StrToInt64Def(item,0);
end;
{$ENDIF WINDOWS}

function GetProcessName(pid:TPid=0):LongString;
var list:LongString;
begin
 if (pid=0) then pid:=System.GetProcessID;
 list:=GetListOfProcesses(pid,0,'');
 Result:=Trim(ExtractWord(4,list,[',']));
end;

function GetParentProcessName:LongString;
var ppid:TPid;
begin
 ppid:=GetParentProcessID;
 if (ppid<>0) then Result:=GetProcessName(ppid) else Result:='';
end;

var
 TheParentSnapshot:record PID:TPid; Name:LongString; end = (PID:0;Name:'');

procedure MakeParentSnapshot;
begin
 TheParentSnapshot.PID:=GetParentProcessID;
 TheParentSnapshot.Name:=GetParentProcessName;
end;

procedure FreeParentSnapshot;
begin
 TheParentSnapshot.PID:=0;
 TheParentSnapshot.Name:='';
end;

function GetSnapshotParentProcessID:TPid;
begin
 Result:=TheParentSnapshot.PID;
end;

function GetSnapshotParentProcessName:LongString;
begin
 Result:=TheParentSnapshot.Name;
end;

function read_proc_sys_kernel_pid_max:LongString;
var h:THandle; n:Integer; buff:TParsingBuffer;
const INVALID_HANDLE_VALUE=THandle(-1);
begin
 Result:='';
 if IsUnix then
 try
  h:=FileOpen('/proc/sys/kernel/pid_max',fmOpenRead);
  if (h<>INVALID_HANDLE_VALUE) then
  try
   buff:=Default(TParsingBuffer);
   n:=FileRead(h,buff,SizeOf(Buff)-1);
   if (n>0) then Result:=Trim(StringBuffer(@buff,n));
  finally
   FileClose(h);
  end;
 except
  on E:Exception do BugReport(E,nil,'read_proc_sys_kernel_pid_max');
 end;
end;

function proc_sys_kernel_pid_max(Mode:Integer=0):TPid;
const pid_max:TPid=0;
begin
 Result:=PID_MAX_LIMIT;
 if IsUnix then begin
  if HasFlags(Mode,1) then pid_max:=0; // Reset to read again
  if (pid_max=0) then pid_max:=StrToIntDef(read_proc_sys_kernel_pid_max,0);
  if (pid_max<1024) then pid_max:=PID_MAX_LIMIT; // Looks invalid
  if (pid_max>0) then Result:=pid_max;
 end;
end;

function PidMaxLimit(Mode:Integer=0):TPid;
begin
 Result:=proc_sys_kernel_pid_max(Mode);
end;

function PidLooksAsSystem(aPid:TPid):Boolean;
begin
 Result:=False;
 if IsUnix then begin
  // PID(init)=1 and around
  Result:=InRange(aPid,1,2);
  // Done
  Exit;
 end;
 if IsWindows then begin
  // PID(System)=4 (why?)
  Result:=InRange(aPid,1,4);
  // Done
  Exit;
 end;
end;

function PidLooksAsValid(aPid:TPid; aMode:Integer=plav_Default):Boolean;
begin
 Result:=(aPid<>0);
 // PID must be non-zero
 if not Result then Exit;
 // PID must be positive number
 if (aPid<=0) then Exit(False);
 // Skip system processes
 if HasFlags(aMode,plav_SkipSys) then
 if PidLooksAsSystem(aPid) then Exit(False);
 // Check PID_MAX_LIMIT value
 if HasFlags(aMode,plav_TestMax) then
 if not InRange(aPid,1,PidMaxLimit) then Exit(False);
end;

function QueryProcessState(aPid:TPid; aPPid:TPid=0; const aName:LongString=''; aFlags:Integer=glops_FixStat):Char;
var list:LongString;
begin
 Result:=pps_Invalid;
 LiftFlags(aFlags,glops_PrState,True);
 LiftFlags(aFlags,glops_Threads,False);
 LiftFlags(aFlags,glops_CmdLine,False);
 if IsWindows and winapi_can_use_fast_pidstate(aPid,aPPid,aName)
 then Exit(winapi_fast_pidstate(aPid,aName));
 if (aPid=0) and (aPPid=0) and IsEmptyStr(aName) then Exit;
 list:=GetListOfProcesses(aPid,aPPid,aName,True,aFlags);
 if (aPid=0) and (WordCount(list,EolnDelims)<>1) then Exit;
 if (list<>'') then Result:=glops_fetch_stat(list,aFlags);
 Result:=pps_ValidateState(Result);
end;

function ProcessStateIsExist(aState:Char):Boolean;
begin
 Result:=pps_IsStateValid(aState);
end;

function ProcessStateIsAlive(aState:Char):Boolean;
begin
 Result:=pps_IsStateAlive(aState);
end;

///////////////////////
// Simplified functions
///////////////////////

function PidState(pid,ppid:TPid; const comm:LongString; Flags:Integer=glops_FixStat):Char;
begin
 Result:=QueryProcessState(pid,ppid,comm,Flags);
end;

function PidExist(stat:Char):Boolean;
begin
 Result:=ProcessStateIsExist(stat);
end;

function PidAlive(stat:Char):Boolean;
begin
 Result:=ProcessStateIsAlive(stat);
end;

function PidDefun(stat:Char):Boolean;
begin
 Result:=ProcessStateIsExist(stat) and not ProcessStateIsAlive(stat);
end;

function PidFind(pid,ppid:Integer; const comm:LongString; Flags:Integer=glops_FixName; Mode:Integer=pfm_Default):Integer;
var list,line:LongString; wc:Integer;
begin
 Result:=0;
 if (pid=0) and (ppid=0) and IsEmptyStr(comm) then Exit;
 list:=GetListOfProcesses(pid,ppid,comm,glops_need_detail(Flags),Flags);
 wc:=WordCount(list,EolnDelims); if (wc=0) then Exit;
 if HasFlags(Mode,pfm_Single) and (wc<>1) then Exit;
 line:=ExtractWord(1,list,EolnDelims);
 Result:=glops_fetch_pid(line);
end;

function PidEnum(pid,ppid:Integer; const comm:LongString; Flags:Integer=glops_DefMaxi):LongString;
begin
 Result:=GetListOfProcesses(pid,ppid,comm,glops_need_detail(Flags),Flags);
end;

function PidCount(pid,ppid:Integer; const comm:LongString):Integer;
begin
 Result:=WordCount(GetListOfProcesses(pid,ppid,comm),EolnDelims);
end;

function PidTrio(const args:LongString):TPidTrio;
var w1,w2,w3,comm:LongString; pid,ppid:TPid; iv:LongInt;
begin
 Result:=Default(TPidTrio);
 if IsNonEmptyStr(args) then begin
  pid:=0; ppid:=0; iv:=0; comm:='';
  w1:=ExtractWord(1,args,ScanSpaces);
  w2:=ExtractWord(2,args,ScanSpaces);
  w3:=ExtractWord(3,args,ScanSpaces);
  if TryStrToInt(w1,iv) then begin
   pid:=iv;
   if TryStrToInt(w2,iv) then begin
    ppid:=iv; comm:=w3;
   end else begin
    comm:=w2;
   end;
  end else begin
   comm:=w1;
  end;
  Result.pid:=pid;
  Result.ppid:=ppid;
  Result.comm:=comm;
 end;
end;

 ////////////////////
 // getrusage related
 ////////////////////

{$IFDEF UNIX}
function getrusage(who:longint; usage:Prusage):longint;cdecl;external 'c' name 'getrusage';

function FPgetrusage(who:longint; usage:Prusage):longint;
begin
 Result:=getrusage(who,usage);
end;

function GetRusageTimesAsFileTime(who:LongInt; out s,u:Int64):Boolean; inline;
const c1=1000*1000; c2=10;
var usage:Trusage;
begin
 Result:=false; s:=0; u:=0;
 if (getrusage(who,@usage)=0) then begin
  s:=(usage.ru_stime.tv_sec*c1+usage.ru_stime.tv_usec)*c2;
  u:=(usage.ru_utime.tv_sec*c1+usage.ru_utime.tv_usec)*c2;
  Result:=true;
 end;
end;

function GetProcessTimesAsFileTime(out s,u:Int64):Boolean;
begin
 Result:=GetRusageTimesAsFileTime(RUSAGE_SELF,s,u);
 if not Result then begin s:=0; u:=0; end;
end;

function GetThreadTimesAsFileTime(out s,u:Int64):Boolean;
begin
 Result:=GetRusageTimesAsFileTime(RUSAGE_THREAD,s,u);
 if not Result then begin s:=0; u:=0; end;
end;
{$ENDIF UNIX}

{$IFDEF WINDOWS}
function GetProcessTimesAsFileTime(out s,u:Int64):Boolean;
var ct,et,kt,ut:TFileTime;
begin
 Int64(ct):=0; Int64(et):=0; Int64(kt):=0; Int64(ut):=0;
 Result:=GetProcessTimes(GetCurrentProcess,ct,et,kt,ut);
 if Result then begin s:=Int64(kt); u:=Int64(ut); end;
end;
function GetThreadTimesAsFileTime(out s,u:Int64):Boolean;
var ct,et,kt,ut:TFileTime;
begin
 Int64(ct):=0; Int64(et):=0; Int64(kt):=0; Int64(ut):=0;
 Result:=GetThreadTimes(GetCurrentThread,ct,et,kt,ut);
 if Result then begin s:=Int64(kt); u:=Int64(ut); end;
end;
{$ENDIF ~WINDOWS}

function RunCommandInDirIdle(const CurDir,CmdLine:LongString;
                  out OutStr,ErrStr:LongString; SleepTime:Integer=0):Boolean;
var ExitStatus:Integer;
begin
 Result:=RunCommandInDirEx(CurDir,CmdLine,OutStr,ErrStr,ExitStatus,swoNone,-1,SleepTime);
end;

type
 TRunCmdProcess=class(TProcess)
 public
  Deadline:QWord;
  procedure OnRunIdle(Sender:TObject; Context:TObject; Status:TRunCommandEventCode; const Message:string);
 end;

procedure TRunCmdProcess.OnRunIdle;
begin
 if (Status=RunCommandIdle) then begin
  if (GetTickCount64<Deadline) then begin
   Sleep(RunCommandSleepTime);
  end else begin
   Terminate(SIGTERM);
   if DebugLogEnabled(dlc_RunCommand)
   then DebugLog(dlc_RunCommand,'Timeout detected.');
  end;
 end;
end;

function RunCommandInDirEx(const CurDir,CmdLine:LongString;
                  out OutStr,ErrStr:LongString; out ExitStatus:Integer;
                  swo:TShowWindowOptions=swoNone; TimeOut:Integer=-1;
                  SleepTime:Integer=0; PipeSize:Cardinal=0):Boolean;
var p:TRunCmdProcess; OutputString,ErrorString:String;
const ForbiddenOptions=[poRunSuspended,poWaitOnExit];
begin
 Result:=False;
 OutStr:=''; ErrStr:=''; ExitStatus:=0;
 if (Trim(CmdLine)<>'') then
 try
  if DebugLogEnabled(dlc_RunCommand) then DebugLog(dlc_RunCommand,cmdline);
  p:=TRunCmdProcess.Create(nil);
  try
   p.Options:=p.Options+[poRunIdle]; // NB!
   p.Options:=p.Options-ForbiddenOptions; // NB!
   if (CurDir<>'') then p.CurrentDirectory:=Trim(CurDir);
   if (SleepTime<=0) then SleepTime:=RunCommandSleepTimeDef;
   if InRange(SleepTime,RunCommandSleepTimeMin,RunCommandSleepTimeMax)
   then p.RunCommandSleepTime:=SleepTime;
   p.Deadline:=High(QWord);
   p.OnRunCommandEvent:=p.OnRunIdle;
   if (TimeOut<0) then TimeOut:=RunCommandTimeOutDef;
   if (TimeOut>0) then p.Deadline:=GetTickCount64+TimeOut;
   if (swo=swoNone) then swo:=RunCommandSwoDef;
   if (swo<>swoNone) then p.ShowWindow:=swo;
   if (PipeSize=0) then PipeSize:=RunCommandPipeSizeDef;
   if (p.PipeBufferSize<PipeSize) then p.PipeBufferSize:=PipeSize;
   {$PUSH}
   {$WARN SYMBOL_DEPRECATED OFF}
   p.CommandLine:=Trim(CmdLine);
   {$POP}
   Result:=(p.RunCommandLoop(OutputString,ErrorString,ExitStatus)=0);
   if (ExitStatus<>0) then Result:=False;
   OutStr:=OutputString;
   ErrStr:=ErrorString;
  finally
   p.Free; OutputString:=''; ErrorString:='';
  end;
 except
  on E:Exception do BugReport(E,nil,'RunCommandInDirEx');
 end;
end;

function RunCommandEx(const CmdLine:LongString; out OutStr:LongString;
                  swo:TShowWindowOptions=swoNone; TimeOut:Integer=-1;
                  SleepTime:Integer=0; PipeSize:Cardinal=0):Boolean;
var ErrStr:LongString; ExitStatus:Integer;
begin
 Result:=RunCommandInDirEx('',CmdLine,OutStr,ErrStr,ExitStatus,swo,TimeOut,SleepTime,PipeSize);
end;

procedure UseRunCommandEx(Def:Boolean=True; SleepTime:Integer=0;
                          Timeout:Integer=0; PipeSize:Integer=0;
                          swo:TShowWindowOptions=swoNone);
begin
 if Def then rcm_Selected:=rcm_Extended else rcm_Selected:=rcm_Standard;
 if InRange(SleepTime,RunCommandSleepTimeMin,RunCommandSleepTimeMax)
 then RunCommandSleepTimeDef:=SleepTime;
 if InRange(Timeout,RunCommandTimeoutMin,RunCommandTimeoutMax)
 then RunCommandTimeoutDef:=Timeout;
 if InRange(PipeSize,RunCommandPipeSizeMin,RunCommandPipeSizeMax)
 then RunCommandPipeSizeDef:=PipeSize;
 if (swo<>swoNone) then RunCommandSwoDef:=swo;
end;

const
 SwoList:TStringList=nil;

procedure InitSwoList;
var swo:TShowWindowOptions;
begin
 if not Assigned(SwoList) then begin
  SwoList:=TStringList.Create;
  SwoList.Duplicates:=dupIgnore;
  SwoList.Sorted:=true;
  for swo:=Low(TShowWindowOptions) to High(TShowWindowOptions) do begin
   SwoList.Values[SwoToString(swo,'swo')]:=IntToStr(Ord(swo));
   SwoList.Values[SwoToString(swo)]:=IntToStr(Ord(swo));
  end;
 end;
end;

procedure FreeSwoList;
begin
 FreeAndNil(SwoList);
end;

function SwoToString(swo:TShowWindowOptions; const Prefix:LongString=''):LongString;
begin
 case swo of
  swoNone:            Result:='None';
  swoHIDE:            Result:='Hide';
  swoMaximize:        Result:='Minimize';
  swoMinimize:        Result:='Maximize';
  swoRestore:         Result:='Restore';
  swoShow:            Result:='Show';
  swoShowDefault:     Result:='ShowDefault';
  swoShowMaximized:   Result:='ShowMaximized';
  swoShowMinimized:   Result:='ShowMinimized';
  swoshowMinNOActive: Result:='ShowMinNoActive';
  swoShowNA:          Result:='ShowNA';
  swoShowNoActivate:  Result:='ShowNoActivate';
  swoShowNormal:      Result:='ShowNormal';
  else                Result:='None';
 end;
 if (Prefix<>'') then Result:=Prefix+Result;
end;

function StringToSwo(const str:LongString; def:TShowWindowOptions):TShowWindowOptions;
var n:Integer;
begin
 Result:=def;
 if not Assigned(SwoList) then InitSwoList;
 if not Assigned(SwoList) then Exit(def);
 n:=StrToIntDef(SwoList.Values[str],-1);
 if InRange(n,Ord(Low(def)),Ord(High(def)))
 then Result:=TShowWindowOptions(n);
end;

function read_proc_pid_file(pid:TPid; name:LongString; items:LongString=''):LongString;
var fname:LongString; List:TStringList; i,nitems:Integer; item:LongString;
const ScanSpaces=[#0..' ',',',';'];
begin
 Result:=''; List:=nil;
 if IsUnix then name:=Trim(name) else Exit;
 if (name<>'') then
 try
  if (pid=0) then pid:=GetCurrentProcessId;
  fname:='/proc/'+IntToStr(pid)+'/'+name;
  if FileIsReadable(fname) then
  try
   List:=TStringList.Create;
   List.LoadFromFile(fname);
   if (items='')
   then nitems:=0
   else nitems:=WordCount(items,ScanSpaces);
   if (nitems>0) then begin
    List.NameValueSeparator:=':';
    for i:=1 to nitems do begin
     item:=ExtractWord(i,items,ScanSpaces);
     if (List.IndexOfName(item)<0) then continue;
     Result:=Result+item+'='+Trim(List.Values[item])+EOL;
    end;
   end else
   Result:=List.Text;
  finally
   List.Free;
  end;
 except
  on F:EFOpenError do FakeNOP(F); // Process may already die.
  on E:Exception do BugReport(E,nil,'read_proc_pid_file');
 end;
end;

function ForEachProcPidFd(pid:TPid; Action:TProcPidFdAction; Custom:Pointer):Integer;
var Rec:TSearchRec; dir:LongString; fd:Integer; Terminate:Boolean;
begin
 Result:=0;
 if not IsUnix then Exit;
 if (pid=0) then pid:=GetCurrentProcessId;
 dir:='/proc/'+IntToStr(pid)+'/fd';
 if DirectoryExists(dir) then
 try
  Terminate:=false;
  // Read /proc/pid/fd/*
  if (FindFirstUTF8(dir+'/*',faAnyFile and not faDirectory,Rec)=0) then
  try
   repeat
    fd:=StrToIntDef(Rec.Name,-1);
    if (fd>=0) then begin
     if Assigned(Action)
     then Terminate:=not Action(pid,fd,Custom);
     Inc(Result);
    end;
   until (FindNextUTF8(Rec)<>0) or Terminate;
  finally
   FindCloseUTF8(Rec);
  end;
 except
  on E:Exception do BugReport(E,nil,'ForEachProcPidFd');
 end;
end;

function MainInstance:QWord;
begin
 Result:=0;
 if IsWindows then begin
  {$IFDEF WINDOWS}
  Result:=GetModuleHandle(nil);
  {$ENDIF ~WINDOWS}
 end;
end;

{$IFDEF UNIX}
const clib='c';
function strsignal(__sig:longint):Pchar;cdecl;external clib name 'strsignal';
function __libc_current_sigrtmin:longint;cdecl;external clib name '__libc_current_sigrtmin';
function __libc_current_sigrtmax:longint;cdecl;external clib name '__libc_current_sigrtmax';
{$ENDIF}

function SIGRTMIN:Integer;
begin
 {$IFDEF UNIX}
 Result:=__libc_current_sigrtmin;
 {$ELSE}
 Result:=34;
 {$ENDIF}
end;

function SIGRTMAX:Integer;
begin
 {$IFDEF UNIX}
 Result:=__libc_current_sigrtmax;
 {$ELSE}
 Result:=64;
 {$ENDIF}
end;

 ///////////////////////////////////////////////////////////////////////////////
 // Commands may be used to read list of signals:
 // /bin/bash -c "kill -L"
 // busybox kill -l
 // /bin/kill -L
 ///////////////////////////////////////////////////////////////////////////////

const
 SigListTableFallback= // Fallback list of signals by command 'kill -L'
 ' 1) SIGHUP       2) SIGINT       3) SIGQUIT      4) SIGILL       5) SIGTRAP     '+EOL+
 ' 6) SIGABRT      7) SIGBUS       8) SIGFPE       9) SIGKILL     10) SIGUSR1     '+EOL+
 '11) SIGSEGV     12) SIGUSR2     13) SIGPIPE     14) SIGALRM     15) SIGTERM     '+EOL+
 '16) SIGSTKFLT   17) SIGCHLD     18) SIGCONT     19) SIGSTOP     20) SIGTSTP     '+EOL+
 '21) SIGTTIN     22) SIGTTOU     23) SIGURG      24) SIGXCPU     25) SIGXFSZ     '+EOL+
 '26) SIGVTALRM   27) SIGPROF     28) SIGWINCH    29) SIGIO       30) SIGPWR      '+EOL+
 '31) SIGSYS      34) SIGRTMIN    35) SIGRTMIN+1  36) SIGRTMIN+2  37) SIGRTMIN+3  '+EOL+
 '38) SIGRTMIN+4  39) SIGRTMIN+5  40) SIGRTMIN+6  41) SIGRTMIN+7  42) SIGRTMIN+8  '+EOL+
 '43) SIGRTMIN+9  44) SIGRTMIN+10 45) SIGRTMIN+11 46) SIGRTMIN+12 47) SIGRTMIN+13 '+EOL+
 '48) SIGRTMIN+14 49) SIGRTMIN+15 50) SIGRTMAX-14 51) SIGRTMAX-13 52) SIGRTMAX-12 '+EOL+
 '53) SIGRTMAX-11 54) SIGRTMAX-10 55) SIGRTMAX-9  56) SIGRTMAX-8  57) SIGRTMAX-7  '+EOL+
 '58) SIGRTMAX-6  59) SIGRTMAX-5  60) SIGRTMAX-4  61) SIGRTMAX-3  62) SIGRTMAX-2  '+EOL+
 '63) SIGRTMAX-1  64) SIGRTMAX                                                    '+EOL;

const
 SigList:TStringList=nil;

procedure InitSigList;
begin
 if not Assigned(SigList) then
 try
  SigList:=TStringList.Create;
  SigList.Duplicates:=dupIgnore;
  SigList.CaseSensitive:=false;
  SigList.Sorted:=true;
  SigListUpdateByTable;
 except
  on E:Exception do BugReport(E,nil,'InitSigList');
 end;
end;

procedure FreeSigList;
begin
 Kill(SigList);
end;

function SigListValues(const key:LongString):LongString;
begin
 if Assigned(SigList) and (key<>'')
 then Result:=SigList.Values[key]
 else Result:='';
end;

function SigListUpdateByTable(aTable:LongString=''):Integer;
var iw,wc,sig:Integer; tab,sn,sv,ss:LongString;
const Delims=[#0..' ',')']; Prefix='SIG';
begin
 Result:=0;
 try
  if not Assigned(SigList) then InitSigList;
  if Assigned(SigList) then begin
   SigList.Clear; tab:=Trim(aTable);
   if (WordCount(tab,Delims)<SIGSYS*2) then tab:='';
   if (tab='') then tab:=SigListTableFallback;
   iw:=1; wc:=WordCount(tab,Delims);
   while (iw<wc) do begin
    sn:=ExtractWord(iw,tab,Delims);
    sig:=StrToIntDef(sn,0);
    if InRange(sig,1,SIGRTMAX) then begin
     sn:=IntToStr(sig);
     sv:=Uppercase(ExtractWord(iw+1,tab,Delims));
     if not StartsText(Prefix,sv) then sv:=Prefix+sv;
     ss:=Copy(sv,1+Length(Prefix),Length(sv)-Length(Prefix));
     SigList.Values[sn]:=sv;
     SigList.Values[sv]:=sn;
     SigList.Values[ss]:=sn;
     Inc(Result);
     Inc(iw);
    end;
    Inc(iw);
   end;
  end;
 except
  on E:Exception do BugReport(E,nil,'StringToSigCode');
 end;
end;

function SigListUpdateByCommand(const cmd:LongString='kill -L'):Integer;
const Delims=[#0..' ',')']; var ans:LongString;
begin
 Result:=0;
 if RunCommand(cmd,ans) then
 if WordCount(ans,Delims)>=SIGSYS*2
 then Result:=SigListUpdateByTable(ans);
end;

function fpStrSignal(sig:Integer):LongString;
var P:PChar;
begin
 {$IFDEF UNIX}P:=strsignal(sig);{$ELSE}P:=nil;{$ENDIF}
 if Assigned(P) then Result:=StrPas(P) else Result:='';
end;

function StringToSigCode(str:LongString; def:Integer=0):Integer;
var sig:Integer;
begin
 Result:=def;
 try
  str:=Trim(str);
  sig:=StrToIntDef(str,0);
  if not Assigned(SigList) then InitSigList;
  if (sig<=0) then sig:=StrToIntDef(SigListValues(str),0);
  if (sig<=0) then sig:=def;
  Result:=sig;
 except
  on E:Exception do BugReport(E,nil,'StringToSigCode');
 end;
end;

function SigCodeToString(sig:Integer; Mode:Integer=0):LongString;
const Delims=[#0..' '];
begin
 Result:='';
 try
  if not Assigned(SigList) then InitSigList;
  if (Result='') and HasFlags(Mode,1) then Result:=fpStrSignal(sig);
  if (Result='') and InRange(sig,1,SIGRTMAX) then Result:=SigListValues(IntToStr(sig));
  if (Result='') and InRange(sig,1,SIGRTMAX) then Result:=ExtractWord(sig,DefaultUnixSignalNames,Delims);
  if (Result='') then Result:=IntToStr(sig);
 except
  on E:Exception do BugReport(E,nil,'SigCodeToString');
 end;
end;

function GetListOfUnixSignals(Mode:Integer=1):LongString;
var sig,msl:Integer; List:TStringList; sn,sc,sl:LongString;
begin
 Result:='';
 try
  List:=TStringList.Create;
  try
   msl:=0;
   for sig:=1 to SIGRTMAX do begin
    sn:=SigCodeToString(sig);
    msl:=Max(msl,Length(sn));
   end;
   for sig:=1 to SIGRTMAX do begin
    sn:=SigCodeToString(sig);
    sc:=SigCodeToString(sig,1);
    sl:=Format('%2d) %-*s ',[sig,msl,sn]);
    if HasFlags(Mode,1) then sl:=sl+' - '+sc;
    List.Add(sl);
   end;
   Result:=List.Text;
  finally
   List.Free;
  end;
 except
  on E:Exception do BugReport(E,nil,'GetListOfUnixSignals');
 end;
end;

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

procedure Init_crw_proc;
begin
 dlc_RunCommand:=RegisterDebugLogChannel('_RunCommand');
 dlc_ReNice:=RegisterDebugLogChannel('_ReNice');
 if IsUnix then PidMaxLimit;
 UseUnixSudoit(True);
 MakeParentSnapshot;
 InitCpuMhzList;
 InitSigList;
 InitSwoList;
end;

procedure Free_crw_proc;
begin
 FreeParentSnapshot;
 FreeSigList;
 FreeSwoList;
end;

initialization

 Init_crw_proc;

finalization

 Free_crw_proc;

end.

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

