////////////////////////////////////////////////////////////////////////////////
// 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:                                                                   //
// Linux process capabilities.                                                //
////////////////////////////////////////////////////////////////////////////////

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

unit _crw_pscap; //  Process capabilities

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math, strutils, lazfileutils, process,
 _crw_alloc, _crw_ef;

 {
 Based on libcap-2.73 - "linux/capability.h".
 }

 {
 POSIX-draft defined capabilities.
 }

 {
 In a system with the [_POSIX_CHOWN_RESTRICTED] option defined, this
 overrides the restriction of changing file ownership and group ownership.
 }

const CAP_CHOWN            = 0;

 {
 Override all DAC access, including ACL execute access if
 [_POSIX_ACL] is defined. Excluding DAC access covered by
 CAP_LINUX_IMMUTABLE.
 }

const CAP_DAC_OVERRIDE     = 1;

 {
 Overrides all DAC restrictions regarding read and search on files
 and directories, including ACL restrictions if [_POSIX_ACL] is
 defined. Excluding DAC access covered by CAP_LINUX_IMMUTABLE.
 }

const CAP_DAC_READ_SEARCH  = 2;

 {
 Overrides all restrictions about allowed operations on files, where
 file owner ID must be equal to the user ID, except where CAP_FSETID
 is applicable. It doesn't override MAC and DAC restrictions.
 }

const CAP_FOWNER           = 3;

 {
 Overrides the following restrictions that the effective user ID
 shall match the file owner ID when setting the S_ISUID and S_ISGID
 bits on that file; that the effective group ID (or one of the
 supplementary group IDs) shall match the file owner ID when setting
 the S_ISGID bit on that file; that the S_ISUID and S_ISGID bits are
 cleared on successful return from chown(2) (not implemented).
 }

const CAP_FSETID           = 4;

 {
 Overrides the restriction that the real or effective user ID of a
 process sending a signal must match the real or effective user ID
 of the process receiving the signal.
 }
const CAP_KILL             = 5;

 { Allows setgid(2) manipulation }
 { Allows setgroups(2) }
 { Allows forged gids on socket credentials passing. }

const CAP_SETGID           = 6;

 { Allows set*uid(2) manipulation (including fsuid). }
 { Allows forged pids on socket credentials passing. }

const CAP_SETUID           = 7;

 {
 Linux-specific capabilities
 }

 { Without VFS support for capabilities:
 *   Transfer any capability in your permitted set to any pid,
 *   remove any capability in your permitted set from any pid
 * With VFS support for capabilities (neither of above, but)
 *   Add any capability from current's capability bounding set
 *       to the current process' inheritable set
 *   Allow taking bits out of capability bounding set
 *   Allow modification of the securebits for a process
 }

const CAP_SETPCAP          = 8;

 { Allow modification of S_IMMUTABLE and S_APPEND file attributes }

const CAP_LINUX_IMMUTABLE  = 9;

 { Allows binding to TCP/UDP sockets below 1024 }
 { Allows binding to ATM VCIs below 32 }

const CAP_NET_BIND_SERVICE = 10;

 { Allow broadcasting, listen to multicast }

const CAP_NET_BROADCAST    = 11;

 { Allow interface configuration }
 { Allow administration of IP firewall, masquerading and accounting }
 { Allow setting debug option on sockets }
 { Allow modification of routing tables }
 { Allow setting arbitrary process / process group ownership on sockets }
 { Allow binding to any address for transparent proxying (also via NET_RAW) }
 { Allow setting TOS (type of service) }
 { Allow setting promiscuous mode }
 { Allow clearing driver statistics }
 { Allow multicasting }
 { Allow read/write of device-specific registers }
 { Allow activation of ATM control sockets }

const CAP_NET_ADMIN        = 12;

 { Allow use of RAW sockets }
 { Allow use of PACKET sockets }
 { Allow binding to any address for transparent proxying (also via NET_ADMIN) }

const CAP_NET_RAW          = 13;

 { Allow locking of shared memory segments }
 { Allow mlock and mlockall (which doesn't really have anything to do with IPC) }

const CAP_IPC_LOCK         = 14;

 { Override IPC ownership checks }

const CAP_IPC_OWNER        = 15;

 { Insert and remove kernel modules - modify kernel without limit }
const CAP_SYS_MODULE       = 16;

 { Allow ioperm/iopl access }
 { Allow sending USB messages to any device via /dev/bus/usb }

const CAP_SYS_RAWIO        = 17;

 { Allow use of chroot() }

const CAP_SYS_CHROOT       = 18;

 { Allow ptrace() of any process }

const CAP_SYS_PTRACE       = 19;

 { Allow configuration of process accounting }

const CAP_SYS_PACCT        = 20;

 { Allow configuration of the secure attention key }
 { Allow administration of the random device }
 { Allow examination and configuration of disk quotas }
 { Allow setting the domainname }
 { Allow setting the hostname }
 { Allow calling bdflush() }
 { Allow mount() and umount(), setting up new smb connection }
 { Allow some autofs root ioctls }
 { Allow nfsservctl }
 { Allow VM86_REQUEST_IRQ }
 { Allow to read/write pci config on alpha }
 { Allow irix_prctl on mips (setstacksize) }
 { Allow flushing all cache on m68k (sys_cacheflush) }
 { Allow removing semaphores }
 { Used instead of CAP_CHOWN to "chown" IPC message queues, semaphores and shared memory }
 { Allow locking/unlocking of shared memory segment }
 { Allow turning swap on/off }
 { Allow forged pids on socket credentials passing }
 { Allow setting readahead and flushing buffers on block devices }
 { Allow setting geometry in floppy driver }
 { Allow turning DMA on/off in xd driver }
 { Allow administration of md devices (mostly the above, but some extra ioctls) }
 { Allow tuning the ide driver }
 { Allow access to the nvram device }
 { Allow administration of apm_bios, serial and bttv (TV) device }
 { Allow manufacturer commands in isdn CAPI support driver }
 { Allow reading non-standardized portions of pci configuration space }
 { Allow DDI debug ioctl on sbpcd driver }
 { Allow setting up serial ports }
 { Allow sending raw qic-117 commands }
 { Allow enabling/disabling tagged queuing on SCSI controllers and sending arbitrary SCSI commands }
 { Allow setting encryption key on loopback filesystem }
 { Allow setting zone reclaim policy }

const CAP_SYS_ADMIN        = 21;

 { Allow use of reboot() }

const CAP_SYS_BOOT         = 22;

 { Allow raising priority and setting priority on other (different UID) processes }
 { Allow use of FIFO and round-robin (realtime) scheduling on own
   processes and setting the scheduling algorithm used by another
   process. }
 { Allow setting cpu affinity on other processes }

const CAP_SYS_NICE         = 23;

 { Override resource limits. Set resource limits. }
 { Override quota limits. }
 { Override reserved space on ext2 filesystem }
 { Modify data journaling mode on ext3 filesystem (uses journaling resources) }
 { NOTE: ext2 honors fsuid when checking for resource overrides, so you can override using fsuid too }
 { Override size restrictions on IPC message queues }
 { Allow more than 64hz interrupts from the real-time clock }
 { Override max number of consoles on console allocation }
 { Override max number of keymaps }

const CAP_SYS_RESOURCE     = 24;

 { Allow manipulation of system clock }
 { Allow irix_stime on mips }
 { Allow setting the real-time clock }

const CAP_SYS_TIME         = 25;

 { Allow configuration of tty devices }
 { Allow vhangup() of tty }

const CAP_SYS_TTY_CONFIG   = 26;

 { Allow the privileged aspects of mknod() }

const CAP_MKNOD            = 27;

 { Allow taking of leases on files }

const CAP_LEASE            = 28;

 { Allow writing the audit log via unicast netlink socket }

const CAP_AUDIT_WRITE      = 29;

 { Allow configuration of audit via unicast netlink socket }

const CAP_AUDIT_CONTROL    = 30;

 { Set capabilities on files. }

const CAP_SETFCAP          = 31;

 { Override MAC access.
   The base kernel enforces no MAC policy.
   An LSM may enforce a MAC policy, and if it does and it chooses
   to implement capability based overrides of that policy, this is
   the capability it should use to do so. }

const CAP_MAC_OVERRIDE     = 32;

 { Allow MAC configuration or state changes.
   The base kernel requires no MAC configuration.
   An LSM may enforce a MAC policy, and if it does and it chooses
   to implement capability based checks on modifications to that
   policy or the data required to maintain it, this is the
   capability it should use to do so. }

const CAP_MAC_ADMIN        = 33;

 { Allow configuring the kernel's syslog (printk behaviour) }

const CAP_SYSLOG           = 34;

 { Allow triggering something that will wake the system }

const CAP_WAKE_ALARM       = 35;

 { Allow preventing system suspends }

const CAP_BLOCK_SUSPEND    = 36;

 { Allow reading the audit log via multicast netlink socket }

const CAP_AUDIT_READ       = 37;

 { Allow system performance and observability privileged operations using
 * perf_events, i915_perf and other kernel subsystems. }

const CAP_PERFMON          = 38;

 {
 * CAP_BPF allows the following BPF operations:
 * - Creating all types of BPF maps
 * - Advanced verifier features
 *   - Indirect variable access
 *   - Bounded loops
 *   - BPF to BPF function calls
 *   - Scalar precision tracking
 *   - Larger complexity limits
 *   - Dead code elimination
 *   - And potentially other features
 * - Loading BPF Type Format (BTF) data
 * - Retrieve xlated and JITed code of BPF programs
 * - Use bpf_spin_lock() helper
 *
 * CAP_PERFMON relaxes the verifier checks further:
 * - BPF progs can use of pointer-to-integer conversions
 * - speculation attack hardening measures are bypassed
 * - bpf_probe_read to read arbitrary kernel memory is allowed
 * - bpf_trace_printk to print kernel memory is allowed
 *
 * CAP_SYS_ADMIN is required to use bpf_probe_write_user.
 *
 * CAP_SYS_ADMIN is required to iterate system wide loaded
 * programs, maps, links, BTFs and convert their IDs to file descriptors.
 *
 * CAP_PERFMON and CAP_BPF are required to load tracing programs.
 * CAP_NET_ADMIN and CAP_BPF are required to load networking programs.
 }

const CAP_BPF           = 39;

 { Allow checkpoint/restore related operations }
 { Allow PID selection during clone3() }
 { Allow writing to ns_last_pid }

const CAP_CHECKPOINT_RESTORE = 40;

 { Define low range of capabilities }
const CAP_FIRST_CAP          = CAP_CHOWN;

 { Define high range of capabilities }
const CAP_LAST_CAP           = CAP_CHECKPOINT_RESTORE;

 { Bitmap of all available capabilities }
const CAP_ALL_CAPS           = (QWord(1) shl (CAP_LAST_CAP+1))-1;

 {
 Record for process capabilities.
 To be read from /proc/pid/status.
 }
type // proc/pid/status capabilities
 TProcPidStatusCaps=record
  CapInh:QWord; // Inherited capabilities set
  CapPrm:QWord; // Permitted capabilities set
  CapEff:QWord; // Effective capabilities set
  CapBnd:QWord; // Bounding  capabilities set
  CapAmb:QWord; // Ambient   capabilities set
 public // Human readable string
  function CapInhStr:LongString;
  function CapPrmStr:LongString;
  function CapEffStr:LongString;
  function CapBndStr:LongString;
  function CapAmbStr:LongString;
 public // Hexadecimal string
  function CapInhHex:LongString;
  function CapPrmHex:LongString;
  function CapEffHex:LongString;
  function CapBndHex:LongString;
  function CapAmbHex:LongString;
 end;
 {
 General class for process capabilities.
 PsCap is the only one instance of this.
 }
type
 TPsCap = class(TMasterObject)
 private
  myCap : TProcPidStatusCaps;
  myPid : TPid;
 public
  {
  Check capability identifier (cap) is valid.
  }
  class function cap_valid(cap:Integer):Boolean;
  {
  Convert capability identifier (cap) to string.
  }
  class function cap_to_string(cap:Integer):LongString;
  {
  Check set of capabilities (caps) has capability (cap).
  }
  class function caps_has_cap(caps:QWord; cap:Integer):Boolean;
  {
  Convert capabilities (caps) to list.
  }
  class function caps_to_list(caps:QWord; sep:LongString=','):LongString;
  {
  Convert capabilities (caps) to hex string.
  }
  class function caps_to_hex(caps:QWord):LongString;
  {
  Run command (cmd), read output (ans).
  }
  class function RunCommand(const cmd:LongString; out ans:LongString):Boolean;
  {
  Find command (getcap).
  }
  class function find_getcap:LongString;
  {
  Find command (getpcaps).
  }
  class function find_getpcaps:LongString;
  {
  Run getcap command with given arguments (args).
  Usually args is executable filename.
  }
  class function run_getcap(const args:LongString):LongString;
  {
  Run getpcaps command with given arguments (args).
  Usually args is IntToStr(pid).
  }
  class function run_getpcaps(const args:LongString):LongString;
  {
  Find command (cmd) with FileSearch, which or whereis.
  }
  class function whichis(const cmd:LongString):LongString;
  {
  Read process capabilities from /proc/pid/status.
  If (pid=0), use cached caps for current process.
  }
  function read_proc_pid_status_caps(pid:TPid=0):TProcPidStatusCaps;
  {
  Read exe file capabilities by getcap command.
  By default use current process EXE.
  }
  class function read_exe_getcap(exe:LongString=''):LongString;
  {
  Read proccess (pid) capabilities by getpcaps command.
  By default use current process PID.
  }
  class function read_pid_getpcaps(pid:TPid=0):LongString;
  {
  Check process (pid) has capability (cap).
  }
  function pid_has_cap(pid:TPid; cap:Integer):Boolean;
 end;

 {
 General object for process capabilities.
 }
function PsCap:TPsCap;


implementation

 ////////////////////////////////////
 // TProcPidStatusCaps implementation
 ////////////////////////////////////

function TProcPidStatusCaps.CapInhStr:LongString;
begin
 Result:=LowerCase(TPsCap.caps_to_list(CapInh));
end;

function TProcPidStatusCaps.CapPrmStr:LongString;
begin
 Result:=LowerCase(TPsCap.caps_to_list(CapPrm));
end;

function TProcPidStatusCaps.CapEffStr:LongString;
begin
 Result:=LowerCase(TPsCap.caps_to_list(CapEff));
end;

function TProcPidStatusCaps.CapBndStr:LongString;
begin
 Result:=LowerCase(TPsCap.caps_to_list(CapBnd));
end;

function TProcPidStatusCaps.CapAmbStr:LongString;
begin
 Result:=LowerCase(TPsCap.caps_to_list(CapAmb));
end;

function TProcPidStatusCaps.CapInhHex:LongString;
begin
 Result:=TPsCap.caps_to_hex(CapInh);
end;

function TProcPidStatusCaps.CapPrmHex:LongString;
begin
 Result:=TPsCap.caps_to_hex(CapPrm);
end;

function TProcPidStatusCaps.CapEffHex:LongString;
begin
 Result:=TPsCap.caps_to_hex(CapEff);
end;

function TProcPidStatusCaps.CapBndHex:LongString;
begin
 Result:=TPsCap.caps_to_hex(CapBnd);
end;

function TProcPidStatusCaps.CapAmbHex:LongString;
begin
 Result:=TPsCap.caps_to_hex(CapAmb);
end;

////////////////////////
// TPsCap implementation
////////////////////////

class function TPsCap.cap_valid(cap:Integer):Boolean;
begin
 Result:=InRange(cap,CAP_FIRST_CAP,CAP_LAST_CAP);
end;

class function TPsCap.cap_to_string(cap:Integer):LongString;
begin
 case cap of
  CAP_CHOWN:                Result:='CAP_CHOWN';
  CAP_DAC_OVERRIDE:         Result:='CAP_DAC_OVERRIDE';
  CAP_DAC_READ_SEARCH:      Result:='CAP_DAC_READ_SEARCH';
  CAP_FOWNER:               Result:='CAP_FOWNER';
  CAP_FSETID:               Result:='CAP_FSETID';
  CAP_KILL:                 Result:='CAP_KILL';
  CAP_SETGID:               Result:='CAP_SETGID';
  CAP_SETUID:               Result:='CAP_SETUID';
  CAP_SETPCAP:              Result:='CAP_SETPCAP';
  CAP_LINUX_IMMUTABLE:      Result:='CAP_LINUX_IMMUTABLE';
  CAP_NET_BIND_SERVICE:     Result:='CAP_NET_BIND_SERVICE';
  CAP_NET_BROADCAST:        Result:='CAP_NET_BROADCAST';
  CAP_NET_ADMIN:            Result:='CAP_NET_ADMIN';
  CAP_NET_RAW:              Result:='CAP_NET_RAW';
  CAP_IPC_LOCK:             Result:='CAP_IPC_LOCK';
  CAP_IPC_OWNER:            Result:='CAP_IPC_OWNER';
  CAP_SYS_MODULE:           Result:='CAP_SYS_MODULE';
  CAP_SYS_RAWIO:            Result:='CAP_SYS_RAWIO';
  CAP_SYS_CHROOT:           Result:='CAP_SYS_CHROOT';
  CAP_SYS_PTRACE:           Result:='CAP_SYS_PTRACE';
  CAP_SYS_PACCT:            Result:='CAP_SYS_PACCT';
  CAP_SYS_ADMIN:            Result:='CAP_SYS_ADMIN';
  CAP_SYS_BOOT:             Result:='CAP_SYS_BOOT';
  CAP_SYS_NICE:             Result:='CAP_SYS_NICE';
  CAP_SYS_RESOURCE:         Result:='CAP_SYS_RESOURCE';
  CAP_SYS_TIME:             Result:='CAP_SYS_TIME';
  CAP_SYS_TTY_CONFIG:       Result:='CAP_SYS_TTY_CONFIG';
  CAP_MKNOD:                Result:='CAP_MKNOD';
  CAP_LEASE:                Result:='CAP_LEASE';
  CAP_AUDIT_WRITE:          Result:='CAP_AUDIT_WRITE';
  CAP_AUDIT_CONTROL:        Result:='CAP_AUDIT_CONTROL';
  CAP_SETFCAP:              Result:='CAP_SETFCAP';
  CAP_MAC_OVERRIDE:         Result:='CAP_MAC_OVERRIDE';
  CAP_MAC_ADMIN:            Result:='CAP_MAC_ADMIN';
  CAP_SYSLOG:               Result:='CAP_SYSLOG';
  CAP_WAKE_ALARM:           Result:='CAP_WAKE_ALARM';
  CAP_BLOCK_SUSPEND:        Result:='CAP_BLOCK_SUSPEND';
  CAP_AUDIT_READ:           Result:='CAP_AUDIT_READ';
  CAP_PERFMON:              Result:='CAP_PERFMON';
  CAP_BPF:                  Result:='CAP_BPF';
  CAP_CHECKPOINT_RESTORE:   Result:='CAP_CHECKPOINT_RESTORE';
  else                      Result:='';
 end;
end;

class function TPsCap.caps_has_cap(caps:QWord; cap:Integer):Boolean;
begin
 if cap_valid(cap)
 then Result:=HasFlags(caps shr cap,1)
 else Result:=false;
end;

class function TPsCap.caps_to_list(caps:QWord; sep:LongString=','):LongString;
var cap:Integer;
begin
 Result:='';
 if (caps=0) then Exit;
 if (sep='') then sep:=' ';
 for cap:=CAP_FIRST_CAP to CAP_LAST_CAP do
 if caps_has_cap(caps,cap) then begin
  if (Result<>'') then Result:=Result+sep;
  Result:=Result+cap_to_string(cap);
 end;
end;

class function TPsCap.caps_to_hex(caps:QWord):LongString;
begin
 Result:=Format('%16.16x',[caps])
end;

function TPsCap.read_proc_pid_status_caps(pid:TPid=0):TProcPidStatusCaps;
var fn:LongString; i:Integer; Lines:TStringList; Line,sn,sv:LongString; Cache:Boolean;
const Spaces=[#0..' '];
begin
 Result:=Default(TProcPidStatusCaps);
 if not Assigned(Self) then Exit;
 try
  if (pid<0) then Exit;
  if not IsUnix then Exit;
  if (pid=0) then Cache:=true;
  if (pid=0) then pid:=GetCurrentProcessId;
  if Cache and (myPid>0) then begin
   Result:=myCap;
   Exit;
  end;
  fn:=Format('/proc/%d/status',[pid]);
  if not FileIsReadable(fn) then Exit;
  Lines:=TStringList.Create;
  try
   Lines.LoadFromFile(fn);
   for i:=0 to Lines.Count-1 do begin
    Line:=Lines.Strings[i];
    sn:=ExtractWord(1,Line,Spaces);
    sv:=ExtractWord(2,Line,Spaces);
    if SameText(sn,'CapInh:') then Result.CapInh:=StrToInt64Def('$'+sv,0);
    if SameText(sn,'CapPrm:') then Result.CapPrm:=StrToInt64Def('$'+sv,0);
    if SameText(sn,'CapEff:') then Result.CapEff:=StrToInt64Def('$'+sv,0);
    if SameText(sn,'CapBnd:') then Result.CapBnd:=StrToInt64Def('$'+sv,0);
    if SameText(sn,'CapAmb:') then Result.CapAmb:=StrToInt64Def('$'+sv,0);
   end;
   if (Cache) and (myPid<=0) then begin
    myCap:=Result;
    myPid:=pid;
   end;
  finally
   Lines.Free;
  end;
 except
  on E:Exception do BugReport(E,nil,'proc_pid_status_caps');
 end;
end;

{$PUSH}
{$WARN 5043 off : Symbol "$1" is deprecated}
class function TPsCap.RunCommand(const cmd:LongString; out ans:LongString):Boolean;
var c,a:String;
begin
 c:=cmd; a:=''; ans:='';
 Result:=Process.RunCommand(c,a);
 ans:=a;
end;
{$POP}

class function TPsCap.whichis(const cmd:LongString):LongString;
var ans:LongString; const Spaces=[#0..' '];
begin
 Result:=''; if (cmd='') then Exit;
 if IsUnix then
 try
  ans:=FileSearch(cmd,GetEnvironmentVariable('PATH'),false);
  if (ans<>'') and FileIsExecutable(ans) then Exit(ans);
  if RunCommand('which '+cmd,ans) then begin
   ans:=ExtractWord(1,ans,Spaces);
   if (ans<>'') then
   if FileIsExecutable(ans)
   then Exit(ans);
  end;
  if RunCommand('whereis -b '+cmd,ans) then begin
   ans:=ExtractWord(2,ans,Spaces);
   if (ans<>'') then
   if FileIsExecutable(ans)
   then Exit(ans);
  end;
 except
  on E:Exception do BugReport(E,nil,'whichis');
 end;
end;

const
 path_getcap:LongString='?';
 path_getpcaps:LongString='?';

class function TPsCap.find_getcap:LongString;
begin
 if (path_getcap='?') then path_getcap:=whichis('getcap');
 Result:=path_getcap;
end;

class function TPsCap.find_getpcaps:LongString;
begin
 if (path_getpcaps='?') then path_getpcaps:=whichis('getpcaps');
 Result:=path_getpcaps;
end;

class function TPsCap.run_getcap(const args:LongString):LongString;
var cmd,ans:LongString;
begin
 Result:='';
 if IsUnix then
 try
  cmd:=find_getcap;
  if RunCommand(Trim(cmd+' '+args),ans)
  then Result:=ans;
 except
  on E:Exception do BugReport(E,nil,'run_getcap');
 end;
end;

class function TPsCap.run_getpcaps(const args:LongString):LongString;
var cmd,ans:LongString;
begin
 Result:='';
 if IsUnix then
 try
  cmd:=find_getpcaps;
  if RunCommand(Trim(cmd+' '+args),ans)
  then Result:=ans;
 except
  on E:Exception do BugReport(E,nil,'run_getpcaps');
 end;
end;

class function TPsCap.read_exe_getcap(exe:LongString=''):LongString;
var ans:LongString; p:Integer;
begin
 Result:='';
 if IsUnix then
 try
  if (exe='') then exe:=ParamStr(0);
  if FileIsExecutable(exe) then begin
   ans:=run_getcap(exe); p:=Pos(' ',ans);
   if (p>0) then Result:=Trim(Copy(ans,p+1,MaxInt));
  end;
 except
  on E:Exception do BugReport(E,nil,'read_exe_getcap');
 end;
end;

class function TPsCap.read_pid_getpcaps(pid:TPid=0):LongString;
var ans:LongString; p:Integer;
begin
 Result:='';
 if IsUnix then
 try
  if (pid=0) then pid:=GetCurrentProcessId;
  if FileIsReadable(Format('/proc/%d/stat',[pid])) then begin
   ans:=run_getpcaps(IntToStr(pid)); p:=Pos(':',ans);
   if (p>0) then Result:=Trim(Copy(ans,p+1,MaxInt));
  end;
 except
  on E:Exception do BugReport(E,nil,'read_pid_getpcaps');
 end;
end;

function TPsCap.pid_has_cap(pid:TPid; cap:Integer):Boolean;
var caps:TProcPidStatusCaps;
begin
 Result:=false;
 if not IsUnix then Exit;
 if not Assigned(Self) then Exit;
 if not cap_valid(cap) then Exit;
 caps:=read_proc_pid_status_caps(pid);
 Result:=caps_has_cap(caps.CapEff,cap);
end;

///////////////////////
// PsCap implementation
///////////////////////

const ThePsCap:TPsCap=nil;

function PsCap:TPsCap;
begin
 if not Assigned(ThePsCap) then begin
  ThePsCap:=TPsCap.Create;
  ThePsCap.Master:=@ThePsCap;
 end;
 Result:=ThePsCap;
end;

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

procedure Init_crw_pscap;
begin
end;

procedure Free_crw_pscap;
begin
 path_getcap:='';
 path_getpcaps:='';
 Kill(TObject(ThePsCap));
end;

initialization

 Init_crw_pscap;

finalization

 Free_crw_pscap;

end.

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

