laz-doublcmd/components/doublecmd/dcunix.pas

{
   Double commander
   -------------------------------------------------------------------------
   This unit contains Unix specific functions

   Copyright (C) 2015-2024 Alexander Koblov ([email protected])

   This library is free software; you can redistribute it and/or
   modify it under the terms of the GNU Lesser General Public
   License as published by the Free Software Foundation; either
   version 2.1 of the License, or (at your option) any later version.

   This library is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   Lesser General Public License for more details.

   You should have received a copy of the GNU Lesser General Public
   License along with this library; if not, write to the Free Software
   Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301 USA

   Notes:
   1. TDarwinStat64 is the workaround for the bug of BaseUnix.Stat in FPC.
      on MacOS with x86_64, Stat64 should be used instead of Stat.
      and lstat64() should be called instead of lstat().
}

unit DCUnix;

{$mode objfpc}{$H+}
{$modeswitch advancedrecords}
{$packrecords c}

interface

uses
  InitC, BaseUnix, UnixType, DCBasicTypes, SysUtils;

const
{$IF DEFINED(LINUX)}
  FD_CLOEXEC = 1;
  O_CLOEXEC  = &02000000;
  O_PATH     = &010000000;
  _SC_NPROCESSORS_ONLN = 84;
{$ELSEIF DEFINED(FREEBSD)}
  O_CLOEXEC  = &04000000;
  _SC_NPROCESSORS_ONLN = 58;
  CLOSE_RANGE_CLOEXEC = (1 << 2);
{$ELSEIF DEFINED(NETBSD)}
  O_CLOEXEC  = $00400000;
{$ELSEIF DEFINED(HAIKU)}
  FD_CLOEXEC = 1;
  O_CLOEXEC  = $00000040;
{$ELSEIF DEFINED(DARWIN)}
  F_NOCACHE  = 48;
  O_CLOEXEC  = $1000000;
  _SC_NPROCESSORS_ONLN = 58;
{$ELSE}
  O_CLOEXEC  = 0;
{$ENDIF}

{$IF DEFINED(LINUX)}
  {$I dclinuxmagic.inc}
{$ENDIF}

type
{$IF DEFINED(LINUX)}
  TUnixTime =
    {$IF DEFINED(CPUAARCH64)}
      Int64
    {$ELSEIF DEFINED(CPUMIPS)}
      LongInt
    {$ELSE}UIntPtr{$ENDIF};
  TUnixMode =
    {$IF DEFINED(CPUPOWERPC)}
      LongInt
    {$ELSE}Cardinal{$ENDIF};
{$ELSE}
  TUnixTime = TTime;
  TUnixMode = TMode;
{$ENDIF}

type
  PTimeStruct = ^TTimeStruct;
  TTimeStruct = record
    tm_sec:    cint;      //* Seconds.      [0-60] (1 leap second)
    tm_min:    cint;      //* Minutes.      [0-59]
    tm_hour:   cint;      //* Hours.        [0-23]
    tm_mday:   cint;      //* Day.          [1-31]
    tm_mon:    cint;      //* Month.        [0-11]
    tm_year:   cint;      //* Year - 1900.
    tm_wday:   cint;      //* Day of week.  [0-6]
    tm_yday:   cint;      //* Days in year. [0-365]
    tm_isdst:  cint;      //* DST.          [-1/0/1]
    tm_gmtoff: clong;     //* Seconds east of UTC.
    tm_zone:   pansichar; //* Timezone abbreviation.
  end;

type
  //en Password file entry record
  passwd = record
    pw_name: PChar;    //en< user name
    pw_passwd: PChar;  //en< user password
    pw_uid: uid_t;     //en< user ID
    pw_gid: gid_t;     //en< group ID
{$IF DEFINED(BSD)}
    pw_change: time_t; //en< password change time
    pw_class: PChar;   //en< user access class
{$ENDIF}
{$IF NOT DEFINED(HAIKU)}
    pw_gecos: PChar;   //en< real name
{$ENDIF}
    pw_dir: PChar;     //en< home directory
    pw_shell: PChar;   //en< shell program
{$IF DEFINED(HAIKU)}
    pw_gecos: PChar;   //en< real name
{$ENDIF}
{$IF DEFINED(BSD)}
    pw_expire: time_t; //en< account expiration
    pw_fields: cint;   //en< internal: fields filled in
{$ENDIF}
  end;
  TPasswordRecord = passwd;
  PPasswordRecord = ^TPasswordRecord;
  //en Group file entry record
  group = record
    gr_name: PChar;   //en< group name
    gr_passwd: PChar; //en< group password
    gr_gid: gid_t;    //en< group ID
    gr_mem: ^PChar;   //en< group members
  end;
  TGroupRecord = group;
  PGroupRecord = ^TGroupRecord;

type
{$IF DEFINED(DARWIN)}
  TDarwinStat64 = record { the types are real}
       st_dev        : dev_t;             // inode's device
       st_mode       : mode_t;            // inode protection mode
       st_nlink      : nlink_t;           // number of hard links
       st_ino        : cuint64;           // inode's number
       st_uid        : uid_t;             // user ID of the file's owner
       st_gid        : gid_t;             // group ID of the file's group
       st_rdev       : dev_t;             // device type
       st_atime      : time_t;            // time of last access
       st_atimensec  : clong;             // nsec of last access
       st_mtime      : time_t;            // time of last data modification
       st_mtimensec  : clong;             // nsec of last data modification
       st_ctime      : time_t;            // time of last file status change
       st_ctimensec  : clong;             // nsec of last file status change
       st_birthtime  : time_t;            // File creation time
       st_birthtimensec : clong;          // nsec of file creation time
       st_size       : off_t;             // file size, in bytes
       st_blocks     : cint64;            // blocks allocated for file
       st_blksize    : cuint32;           // optimal blocksize for I/O
       st_flags      : cuint32;           // user defined flags for file
       st_gen        : cuint32;           // file generation number
       st_lspare     : cint32;
       st_qspare     : array[0..1] Of cint64;
  end;

  TDCStat = TDarwinStat64;
{$ELSE}
  TDCStat = BaseUnix.Stat;
{$ENDIF}
  PDCStat = ^TDCStat;

  TDCStatHelper = record Helper for TDCStat
  Public
    function birthtime: TFileTimeEx; inline;
    function mtime:     TFileTimeEx; inline;
    function atime:     TFileTimeEx; inline;
    function ctime:     TFileTimeEx; inline;
  end;

Function DC_fpLstat( const path:RawByteString; var Info:TDCStat ): cint; inline;

// nanoseconds supported
function DC_FileSetTime(const FileName: String;
                        const mtime    : TFileTimeEx;
                        const birthtime: TFileTimeEx;
                        const atime    : TFileTimeEx ): Boolean;


{en
   Set the close-on-exec flag to all
}
procedure FileCloseOnExecAll;
{en
   Set the close-on-exec (FD_CLOEXEC) flag
}
procedure FileCloseOnExec(Handle: System.THandle); inline;
{en
   Find mount point of file system where file is located
   @param(FileName File name)
   @returns(Mount point of file system)
}
function FindMountPointPath(const FileName: String): String;
{en
   Change owner and group of a file (does not follow symbolic links)
   @param(path Full path to file)
   @param(owner User ID)
   @param(group Group ID)
   @returns(On success, zero is returned. On error, -1 is returned, and errno is set appropriately)
}
function fpLChown(path : String; owner : TUid; group : TGid): cInt;
{en
   Set process group ID for job control
}
function setpgid(pid, pgid: pid_t): cint; cdecl; external clib;
{en
   The getenv() function searches the environment list to find the
   environment variable name, and returns a pointer to the corresponding
   value string.
}
function getenv(name: PAnsiChar): PAnsiChar; cdecl; external clib;
{en
   Change or add an environment variable
   @param(name Environment variable name)
   @param(value Environment variable value)
   @param(overwrite Overwrite environment variable if exist)
   @returns(The function returns zero on success, or -1 if there was
            insufficient space in the environment)
}
function setenv(const name, value: PAnsiChar; overwrite: cint): cint; cdecl; external clib;
{en
   Remove an environment variable
   @param(name Environment variable name)
   @returns(The function returns zero on success, or -1 on error)
}
function unsetenv(const name: PAnsiChar): cint; cdecl; external clib;
{en
   Get password file entry
   @param(uid User ID)
   @returns(The function returns a pointer to a structure containing the broken-out
            fields of the record in the password database that matches the user ID)
}
function getpwuid(uid: uid_t): PPasswordRecord; cdecl; external clib;
{en
   Get password file entry
   @param(name User name)
   @returns(The function returns a pointer to a structure containing the broken-out
            fields of the record in the password database that matches the user name)
}
function getpwnam(const name: PChar): PPasswordRecord; cdecl; external clib;
{en
   Get group file entry
   @param(gid Group ID)
   @returns(The function returns a pointer to a structure containing the broken-out
            fields of the record in the group database that matches the group ID)
}
function getgrgid(gid: gid_t): PGroupRecord; cdecl; external clib;
{en
   Get group file entry
   @param(name Group name)
   @returns(The function returns a pointer to a structure containing the broken-out
            fields of the record in the group database that matches the group name)
}
function getgrnam(name: PChar): PGroupRecord; cdecl; external clib;
{en
   Get configuration information at run time
}
function sysconf(name: cint): clong; cdecl; external clib;

function FileLock(Handle: System.THandle; Mode: cInt): System.THandle;

function fpMkTime(tm: PTimeStruct): TTime;
function fpLocalTime(timer: PTime; tp: PTimeStruct): PTimeStruct;

{$IF DEFINED(LINUX)}
var
  KernVersion: UInt16;

function fpFDataSync(fd: cint): cint;
function fpCloneFile(src_fd, dst_fd: cint): Boolean;
function fpFAllocate(fd: cint; mode: cint; offset, len: coff_t): cint;
{$ENDIF}

{$IF DEFINED(UNIX) AND NOT DEFINED(DARWIN)}
function fnmatch(const pattern: PAnsiChar; const str: PAnsiChar; flags: cint): cint; cdecl; external clib;
{$ENDIF}

implementation

uses
  Unix, DCConvertEncoding, LazUTF8
{$IF DEFINED(DARWIN)}
  , DCDarwin
{$ELSEIF DEFINED(LINUX)}
  , Dos, DCLinux, DCOSUtils
{$ELSEIF DEFINED(FREEBSD)}
  , DCOSUtils
{$ENDIF}
  ;

{$IF not DEFINED(LINUX)}
function TDCStatHelper.birthtime: TFileTimeEx;
begin
{$IF DEFINED(HAIKU)}
  Result.sec:= st_crtime;
  Result.nanosec:= st_crtimensec;
{$ELSE}
  Result.sec:= st_birthtime;
  Result.nanosec:= st_birthtimensec;
{$ENDIF}
end;

function TDCStatHelper.mtime: TFileTimeEx;
begin
  Result.sec:= st_mtime;
  Result.nanosec:= st_mtimensec;
end;

function TDCStatHelper.atime: TFileTimeEx;
begin
  Result.sec:= st_atime;
  Result.nanosec:= st_atimensec;
end;

function TDCStatHelper.ctime: TFileTimeEx;
begin
  Result.sec:= st_ctime;
  Result.nanosec:= st_ctimensec;
end;
{$ELSE}
function TDCStatHelper.birthtime: TFileTimeEx;
begin
  Result:= TFileTimeExNull;
end;

function TDCStatHelper.mtime: TFileTimeEx;
begin
  Result.sec:= Int64(st_mtime);
  Result.nanosec:= Int64(st_mtime_nsec);
end;

function TDCStatHelper.atime: TFileTimeEx;
begin
  Result.sec:= Int64(st_atime);
  Result.nanosec:= Int64(st_atime_nsec);
end;

function TDCStatHelper.ctime: TFileTimeEx;
begin
  Result.sec:= Int64(st_ctime);
  Result.nanosec:= Int64(st_ctime_nsec);
end;
{$ENDIF}


{$IF DEFINED(DARWIN)}

Function fpLstat64( path:pchar; Info:pstat ): cint; cdecl; external clib name 'lstat64';

Function DC_fpLstat( const path:RawByteString; var Info:TDCStat ): cint; inline;
var
  SystemPath: RawByteString;
begin
  SystemPath:=ToSingleByteFileSystemEncodedFileName( path );
  Result:= fpLstat64( pchar(SystemPath), @info );
end;

{$ELSE}

Function DC_fpLstat( const path:RawByteString; var Info:TDCStat ): cint; inline;
begin
  Result:= fpLstat( path, info );
end;

{$ENDIF}

function fputimes( path:pchar; times:Array of UnixType.timeval ): cint; cdecl; external clib name 'utimes';

function DC_FileSetTime(const FileName: String;
                        const mtime    : TFileTimeEx;
                        const birthtime: TFileTimeEx;
                        const atime    : TFileTimeEx ): Boolean;
var
  timevals: Array[0..1] of UnixType.timeval;
begin
  Result:= false;

  // last access time
  timevals[0].tv_sec:= atime.sec;
  timevals[0].tv_usec:= round( Extended(atime.nanosec) / 1000.0 );
  // last modification time
  timevals[1].tv_sec:= mtime.sec;
  timevals[1].tv_usec:= round( Extended(mtime.nanosec) / 1000.0 );
  if fputimes(pchar(UTF8ToSys(FileName)), timevals) <> 0 then exit;

  {$IF not DEFINED(DARWIN)}
  Result:= true;
  {$ELSE}
  Result:= MacosFileSetCreationTime( FileName, birthtime );
  {$ENDIF}
end;

{$IF DEFINED(BSD)}
type rlim_t = Int64;
{$ENDIF}

const
  {$IF DEFINED(LINUX)}
  _SC_OPEN_MAX  = 4;
  FICLONE       = $40049409;
  RLIM_INFINITY = rlim_t(-1);
  {$ELSEIF DEFINED(BSD)}
  _SC_OPEN_MAX  = 5;
  RLIM_INFINITY = rlim_t(High(QWord) shr 1);
  {$ELSEIF DEFINED(HAIKU)}
  _SC_OPEN_MAX  = 20;
  RLIMIT_NOFILE = 4;
  RLIM_INFINITY = $ffffffff;
  {$ENDIF}

procedure tzset(); cdecl; external clib;
function mktime(tp: PTimeStruct): TTime; cdecl; external clib;
function localtime_r(timer: PTime; tp: PTimeStruct): PTimeStruct; cdecl; external clib;
function lchown(path : PChar; owner : TUid; group : TGid): cInt; cdecl; external clib;
{$IF DEFINED(LINUX)}
function fdatasync(fd: cint): cint; cdecl; external clib;
function fallocate(fd: cint; mode: cint; offset, len: coff_t): cint; cdecl; external clib;
{$ENDIF}

{$IF DEFINED(LINUX) OR DEFINED(FREEBSD)}
var
  hLibC: TLibHandle = NilHandle;

procedure LoadCLibrary;
begin
  hLibC:= mbLoadLibrary(mbGetModuleName(@tzset));
end;
{$ENDIF}

{$IF DEFINED(LINUX) OR DEFINED(BSD)}
var
  close_range: function(first: cuint; last: cuint; flags: cint): cint; cdecl = nil;
{$ENDIF}

procedure FileCloseOnExecAll;
const
  MAX_FD = 1024;
var
  fd: cint;
  p: TRLimit;
  fd_max: rlim_t = RLIM_INFINITY;
begin
{$IF DEFINED(LINUX) OR DEFINED(BSD)}
  if Assigned(close_range) then
  begin
    close_range(3, High(Int32), CLOSE_RANGE_CLOEXEC);
    Exit;
  end;
{$ENDIF}
  if (FpGetRLimit(RLIMIT_NOFILE, @p) = 0) and (p.rlim_cur <> RLIM_INFINITY) then
    fd_max:= p.rlim_cur
  else begin
    {$IF DECLARED(_SC_OPEN_MAX)}
    fd_max:= sysconf(_SC_OPEN_MAX);
    {$ENDIF}
  end;
  if (fd_max = RLIM_INFINITY) or (fd_max > MAX_FD) then
    fd_max:= MAX_FD;
  for fd:= 3 to cint(fd_max) do
    FileCloseOnExec(fd);
end;

procedure FileCloseOnExec(Handle: System.THandle);
begin
{$IF DECLARED(FD_CLOEXEC)}
  FpFcntl(Handle, F_SETFD, FpFcntl(Handle, F_GETFD) or FD_CLOEXEC);
{$ENDIF}
end;

function FindMountPointPath(const FileName: String): String;
var
  I, J: LongInt;
  sTemp: String;
  recStat: Stat;
  st_dev: QWord;
begin
  // Set root directory as mount point by default
  Result:= PathDelim;
  // Get stat info for original file
  if (fpLStat(FileName, recStat) < 0) then Exit;
  // Save device ID of original file
  st_dev:= recStat.st_dev;
  J:= Length(FileName);
  for I:= J downto 1 do
  begin
    if FileName[I] = PathDelim then
    begin
      if (I = 1) then
        sTemp:= PathDelim
      else
        sTemp:= Copy(FileName, 1, I - 1);
      // Stat for current directory
      if (fpLStat(sTemp, recStat) < 0) then Continue;
      // If it is a link then checking link destination
      if fpS_ISLNK(recStat.st_mode) then
      begin
        sTemp:= fpReadlink(sTemp);
        Result:= FindMountPointPath(sTemp);
        Exit;
      end;
      // Check device ID
      if (recStat.st_dev <> st_dev) then
      begin
        Result:= Copy(FileName, 1, J);
        Exit;
      end;
      J:= I;
    end;
  end;
end;

function fpLChown(path: String; owner: TUid; group: TGid): cInt;
begin
  Result := lchown(PAnsiChar(CeUtf8ToSys(path)), owner, group);
  if Result = -1 then fpseterrno(fpgetCerrno);
end;

function FileLock(Handle: System.THandle; Mode: cInt): System.THandle;
var
  lockop: cint;
  lockres: cint;
  lockerr: cint;
{$IFDEF LINUX}
  Sbfs: TStatFS;
{$ENDIF}
begin
  Result:= Handle;
  case (Mode and $F0) of
    fmShareCompat,
    fmShareExclusive:
      lockop:= LOCK_EX or LOCK_NB;
    fmShareDenyWrite:
      lockop:= LOCK_SH or LOCK_NB;
    else
      Exit;
  end;
{$IFDEF LINUX}
  if (fpFStatFS(Handle, @Sbfs) = 0) then
  begin
    case UInt32(Sbfs.fstype) of
      NFS_SUPER_MAGIC,
      SMB_SUPER_MAGIC,
      SMB2_MAGIC_NUMBER,
      CIFS_MAGIC_NUMBER: Exit;
    end;
  end;
{$ENDIF}
  repeat
    lockres:= fpFlock(Handle, lockop);
  until (lockres = 0) or (fpgeterrno <> ESysEIntr);
  lockerr:= fpgeterrno;
  {
    Only return an error if locks are working and the file was already
    locked. Not if locks are simply unsupported (e.g., on Angstrom Linux
    you always get ESysNOLCK in the default configuration)
  }
  if (lockres <> 0) and ((lockerr = ESysEAGAIN) or (lockerr = ESysEDEADLK)) then
  begin
    Result:= -1;
    FileClose(Handle);
  end;
end;

function fpMkTime(tm: PTimeStruct): TTime;
begin
  Result := mktime(tm);
  if (Result = TTime(-1)) then fpseterrno(fpgetCerrno);
end;

function fpLocalTime(timer: PTime; tp: PTimeStruct): PTimeStruct;
begin
  Result := localtime_r(timer, tp);
  if (Result = nil) then fpseterrno(fpgetCerrno);
end;

{$IF DEFINED(LINUX)}
function fpFDataSync(fd: cint): cint;
begin
  Result := fdatasync(fd);
  if Result = -1 then fpseterrno(fpgetCerrno);
end;

function fpCloneFile(src_fd, dst_fd: cint): Boolean;
var
  ASource: Pointer absolute src_fd;
begin
  Result:= (FpIOCtl(dst_fd, FICLONE, ASource) = 0);
end;

function fpFAllocate(fd: cint; mode: cint; offset, len: coff_t): cint;
begin
  Result := fallocate(fd, mode, offset, len);
  if Result = -1 then fpseterrno(fpgetCerrno);
end;
{$ENDIF}

procedure Initialize;
begin
  tzset();
{$IF DEFINED(LINUX) OR DEFINED(FREEBSD)}
  LoadCLibrary;
  {$IF DEFINED(LINUX)}
  KernVersion:= BEtoN(DosVersion);
  // Linux kernel >= 5.11
  if KernVersion >= $50B then
  {$ENDIF}
  begin
    Pointer(close_range):= GetProcAddress(hLibC, 'close_range');
  end;
{$ELSEIF DEFINED(DARWIN)}
  close_range:= @CloseRange;
{$ENDIF}
end;

initialization
  Initialize;

end.