freepascal.compiler/packages/base/libc/unixutils.pp

{
    $Id$
    This file is part of the Free Pascal run time library.
    Copyright (c) 1999-2000 by the Free Pascal development team.

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program 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.

 **********************************************************************}
{$mode objfpc}
{$h+}

Unit UnixUtils;

Interface

uses 
  SysUtils,Libc,Classes;

{ ---------------------------------------------------------------------
    Error handling
  ---------------------------------------------------------------------}
  

Type
  EUnixOperationFailed = Class(Exception)
  Private
    FErrorCode : Integer;
  Public
    Constructor Create (AnErrorCode : Longint);
    Property ErrorCode: Integer Read FErrorCode;
  end;

Function  StrError(Error:longint):string;
Function  CheckUnixError (Error : Integer) : Integer;

{ ---------------------------------------------------------------------
    File handling
  ---------------------------------------------------------------------}
  

Const
  PathSeparator = '/';

Type
  TUnixFileStream = Class(TFileStream)
    Procedure GetInfo(Var StatInfo: TStatBuf);
    Procedure LockRegion(Cmd,LockType,Whence : Integer;
                         Offset,Len : __off_t);
    Procedure ReadLock(Whence : Integer;Offset,Len : __off_t; Wait : Boolean);
    Procedure WriteLock(Whence : Integer;Offset,Len : __off_t; Wait : Boolean);
    Procedure UnLock(Whence : Integer;Offset,Len : __off_t);
  end;


{ Useful constants and structures }

Const
  PermissionBits : Array [1..9] of Integer =
         (S_IRUSR,S_IWUSR,S_IXUSR,
          S_IRGRP,S_IWGRP,S_IXGRP,
          S_IROTH,S_IWOTH,S_IXOTH);
  PermissionChars : Array[1..9] of char =
          ('r','w','x','r','w','x','r','w','x');

  SuidBits  : array[1..3] of Integer = (S_ISUID,S_ISGID,S_ISVTX);
  SuidChars : Array[1..3] of char = ('s','s','t') ;


{ Utility functions }

Type
 TPermissionString = String[9];

Type 
  TGlobFlag = (gfErr,gfMark,gfNoSort,gfNoCheck,gfAppend,gfNoEscape,
               gfPeriod,gfBrace,gfNoMagic,gfTilde,gfOnlyDir,gfTildeCheck);
  TGlobFlags = Set of TGlobFlag;
  
  TFnmFlag = (fnmNoEscape,fnmPathName,fnmPeriod,fnmLeadingDir,fnmCaseFold); 
  TFnmFlags = Set of TFnmFlag;
  
Procedure Stat  (Const FileName : String; Var StatInfo : TStatBuf);
Procedure LStat  (Const FileName : String; Var StatInfo : TStatBuf);
Procedure StatFS  (Const FileName : String; Var StatInfo : TStatFS);
Procedure UnLink(Const FileName: String);
Procedure Link  (Const FromName, ToName: String);
Procedure SymLink  (Const FromName, ToName: String);
Function  ReadLink (Const FileName : String) : String;
Function  FilePermString (Const Mode : __mode_t) : TPermissionString;
Function  PermStringToMask (Const Perm : TPermissionstring) : __mode_t;
Procedure ChMod(Const FileName : String; Mode : __mode_t);
Procedure ReName(Const OldName,NewName : String);
Function  Access(Const FileName : String; Mode :Integer) : Boolean;
Procedure Glob(Const Pattern : String; Flags : TGlobFlags; List : TStrings);
// Globfree call with correct calling conventions.
Procedure globfree(__pglob: PGlobData);cdecl;
Function  OpenDir(Const Dir : String) : PDirectoryStream;
Function  FNMatch(Const Pattern,Name : String; Flags : TFnmFlags) : Boolean;
Procedure GetDirectoryListing(Const Dir : String; List : TStrings);overload;
Procedure GetDirectoryListing(Const Dir,Pattern : String;
                              Flags : TFnmFlags; List : TStrings);overload;
Procedure GetSubdirectories(Const Dir : String; List : TStrings);
Function  StripTrailingSeparator(Const Dir : String) : String;
Function  AddTraiLingSeparator(Const Dir : String) : String;
Function  FileSizeToString(Size: Int64) : String;
Function  SetMntEnt(FileName,Mode : String) : PIOFile;
Procedure Mount(Const Device,Directory,FileSystemType : String; Flags : Cardinal; Data: Pointer);
Procedure Umount(Const FileName);
Function  FSTypeToString(FSType : Integer) : String;
Procedure fcntl(Handle: Integer; Command: Integer; Var Lock: TFlock);
Procedure  Dup2(Stream1,Stream2 : THandleStream); 
Function  Dup(Stream : THandleStream) : THandleStream;


{ ---------------------------------------------------------------------
  Process management routines.  
  ---------------------------------------------------------------------}

function SetUID(UID: __uid_t):Boolean;
function SetEUID(UID: __uid_t):Boolean;
function SetGID(GroupID: __gid_t):Boolean;
function SetEGID(GroupID: __gid_t):Boolean;
function SetREUID(RUID: __uid_t; EUID: __uid_t):Boolean;
function SetREGID(RGID: __gid_t; EGID: __gid_t):Boolean;
Function GetGroups(Var A : Array of __gid_t) : Integer;
Function Group_member(GroupID : __gid_t) : Boolean;
Function Fork : __pid_t;
Function wait(var Status : Integer) : pid_t;
Function waitpid(PID : pid_t;var Status : Integer;options : Integer) : pid_t;
Function ConvertStatusToString(Status : Integer) : String;
Procedure Execve(ProgName : String; Args,Env : TStrings);
Procedure Execv(ProgName : String; Args : TStrings);
Procedure Execvp(ProgName : String; Args : TStrings);
Procedure Execle(ProgName : String; Args : Array of string;Env : TStrings);
Procedure Execl(ProgName : String; Args : Array of string);
Procedure Execlp(ProgName : String; Args : Array of string);

{ ---------------------------------------------------------------------
    User/group management routines
  ---------------------------------------------------------------------}
  
Type
  EUserLookupError = Class(Exception);
  EGroupLookupError = Class(Exception);
  EShadowLookupError = Class(Exception);
  
{ User functions }  
  
Function  getpwnam(Const UserName: String) : PPasswordRecord;
Procedure GetUserData(Const UserName : String; Var Data : TPasswordRecord); overload;
Procedure GetUserData(Uid : Integer; Var Data : TPasswordRecord); overload;
function  GetUserName(UID : Integer) : String;
function  GetUserId(Const UserName : String) : Integer;
function  GetUserGid(Const UserName : String) : Integer;
function  GetUserDir(Const UserName : String): String;
function  GetUserDescription(Const UserName : String): String;
Procedure GetUserList(List : Tstrings);overload;
Procedure GetUserList(List : TStrings; WithIDs : Boolean);overload;

{ Group functions }  

Function  getgrnam(Const GroupName: String) : PGroup;
Procedure GetGroupData(Const GroupName : String; Var Data : TGroup); overload;
Procedure GetGroupData(Gid : Integer; Var Data : TGroup); overload;
function  GetGroupName(GID : Integer) : String;
function  GetGroupId(Const GroupName : String) : Integer;
Procedure GetGroupList(List : Tstrings);overload;
Procedure GetGroupList(List : TStrings; WithIDs : Boolean);overload;
Procedure GetGroupMembers(GID : Integer;List : TStrings);overload;
Procedure GetGroupMembers(Const GroupName : String;List : TStrings);overload;

{ Shadow password functions }

function getspnam(UserName : String): PPasswordFileEntry;
function sgetspent(Line : String): PPasswordFileEntry;
Procedure GetUserShadowData(Const UserName : String; Var Data : TPasswordFileEntry);overload;
Procedure GetUserShadowData(UID : Integer; Var Data : TPasswordFileEntry);overload;

{ Extra functions }  

Function GetUserGroup(Const UserName : String) : String;




Implementation

ResourceString
  SErrOpeningDir = 'Could not open directory "%s" for reading';
  SUnknownFileSystemType = 'Unknown filesystem (%x)';
  SNormalExitWithErrCode = 'Child exited with error code %d';
  SNormalExit            = 'Child exited normally';
  SSignalExit            = 'Child exited abnormally due to signal %d';
  SStopped               = 'Child stopped due to signal %d';
  SErrUnknowStatusCode   = 'Unknown exit status : %d';
  EnoSuchUserName = 'Unknown username: "%s"';
  EnoSuchUserID = 'Unknown user ID: %d';
  EnoSuchGroupName = 'Unknown groupname: "%s"';
  EnoSuchGroupID = 'Unknown group ID: %d';
  ENoShadowEntry = 'No shadow file entry for "%s"';
  EShadowNotPermitted = 'Not enough permissions to access shadow password file';

{ ---------------------------------------------------------------------
    Error handling 
  ---------------------------------------------------------------------}
  

Function StrError(Error:longint):string;

begin
  StrError:=strpas(libc.strerror(Error));
end;

Constructor EUnixOperationFailed.Create(AnErrorCode : Longint);

begin
  FErrorCode:=AnErrorCode;
  Inherited Create(StrError(Abs(AnErrorCode)));
end;

Function CheckUnixError (Error : Integer) : Integer;

begin
  If (Error<0) then
    Raise EUnixOperationFailed.Create(Error);
  Result:=Error;
end;


Procedure globfree(__pglob: PGlobData);cdecl;external 'libc.so.6' name 'globfree';


Procedure Stat(Const FileName : String; Var StatInfo : TStatBuf); 

begin
  CheckUnixError(Libc.Stat(Pchar(FileName),StatInfo));
end;

Procedure LStat(Const FileName : String; Var StatInfo : TStatBuf);

begin
  CheckUnixError(Libc.LStat(Pchar(FileName),StatInfo));
end;

Procedure StatFS  (Const FileName : String; Var StatInfo : TStatFS);

begin
  CheckUnixError(Libc.statfs(PChar(FileName),STatinfo));
end;

Procedure UnLink(const FileName: String);

begin
  CheckUnixError(Libc.unlink(PChar(FileName)));
end;

Procedure Link  (Const FromName, ToName: String);

begin
  CheckUnixError(Libc.Link(PChar(FromName),Pchar(ToName)));
end;

Procedure SymLink  (Const FromName, ToName: String);

begin
  CheckUnixError(Libc.SymLink(PChar(FromName),Pchar(ToName)));
end;

Function  ReadLink (Const FileName : String) : String;

Const
  NameBufSize = 1024;

begin
  SetLength(Result,NameBufSize);
  Try
    SetLength(Result,CheckUnixError(Libc.readlink(pchar(FileName),PChar(Result),NameBufSize)));
  except
    SetLength(Result,0);
    raise
  end;
end;


Function  FilePermString (Const Mode : __mode_t) : TPermissionString;

Var
  i : longint;

    Function ModeToSUIBit (C,RC : Char) : Char;

    begin
      If C='x' then
        Result:=RC
      else
        Result:=Upcase(RC);
    end;

begin
  Result:=StringOfChar('-',9);
  For I:=1 to 9 do
    If ((Mode and PermissionBits[i])=PermissionBits[i]) then
      Result[i]:=PermissionChars[i];
  For I:=1 to 3 do
    If ((Mode and SuidBits[i])=SuidBits[i]) then
      If Result[I*3]='x' then
        Result[i*3]:=SuidChars[i]
      else
        Result[i*3]:=UpCase(SuidChars[i]);
end;

Function  PermStringToMask (Const Perm : TPermissionstring) : __mode_t;

Var 
  I : integer;

begin
  Result := 0;
  For I:=1 to 9 do
    If Perm[i]=PermissionChars[i] Then
      Result:=Result or PermissionBits[i]
    else
      If (I mod 3)=0 then
        If Perm[i]=suidchars[i] then
          Result:=(Result or PermissionBits[I]) or (SuidBits[I div 3])
        else if (Perm[i]=upcase(SuidChars[I])) then
          Result:=(Result or SuidBits[I div 3])
end;

Procedure ChMod(Const FileName : String; Mode : __mode_t);

begin
  CheckUnixError(Libc.Chmod(PChar(FileName),Mode));
end;

Procedure ReName(Const OldName,NewName : String);

begin
  CheckUnixError(Libc.__rename(Pchar(OldName),Pchar(NewName)));
end;

Function Access(Const FileName : String; Mode :Integer) : Boolean;

begin
  Result:=Libc.Access(Pchar(FileName),Mode)=0;
end;



Procedure Glob(Const Pattern : String; Flags : TGlobFlags; List : TStrings);

Const 
  // Append and offset are masked to 0, since they're useless.
  GF : Array[TGlobFlag] of Integer 
     = (GLOB_ERR,GLOB_MARK,GLOB_NOSORT,GLOB_NOCHECK,0,
        GLOB_NOESCAPE,GLOB_PERIOD,GLOB_BRACE,GLOB_NOMAGIC,
        GLOB_TILDE,GLOB_ONLYDIR, GLOB_TILDE_CHECK);

Type
  TPCharArray = Array[Word] of PChar;
  PPCharArray = ^TPcharArray;
Var 
  gd : TGlobData;
  i  : TGlobFlag;
  f  : Integer;

begin
  FillChar(gd,SizeOf(TGlobData),#0);
  f:=0;
  For i:=gfErr to gfTildeCheck do
    If i in Flags then
      F:=F or GF[i];
  Try
    CheckUnixError(Libc.Glob(Pchar(Pattern),F,Nil,@gd));
    If Not (gfAppend in Flags) then
      List.Clear;
    for f:=0 to gd.gl_pathc-1 do
      List.add(Strpas(PPCharArray(gd.gl_pathv)^[f]));
  finally
    globFree(@gd);
  end;    
end;

Function OpenDir(Const Dir : String) : PDirectoryStream;

begin
  Result:=Libc.OpenDir(Pchar(Dir));
  If (Result=Nil) then
    Raise EUnixOperationFailed.CreateFmt(SErrOpeningDir,[Dir]);
end;


Procedure GetDirectoryListing(Const Dir : String; List : TStrings);overload;

Var
  P : PDirent;
  D : PDirectoryStream;

begin
  D:=OpenDir(Dir);
  Try
    P:=ReadDir(D);
    List.Clear;
    While P<>Nil do
      begin
      List.Add(StrPas(@p^.d_name[0]));
      P:=ReadDir(D);
      end;
  Finally
    CloseDir(D);
  end;
end;

Function FNtoFNFlags(Flags :TFnmFlags) : Integer;

Const
  FV : Array[TFnmFlag] of integer =
       (FNM_NOESCAPE,FNM_PATHNAME,FNM_PERIOD,FNM_LEADING_DIR,FNM_CASEFOLD);

Var i : TFnmFlag;

begin
  Result:=0;
  For I:=fnmNoEscape to fnmCaseFold do
    If i in Flags then
      Result:=Result or FV[i];
end;

Function FNMatch(Const Pattern,Name : String; Flags : TFnmFlags) : Boolean;

begin
  Result:=Libc.FNMatch(PChar(Pattern),PChar(Name),FNtoFNFlags(Flags))=0;
end;

Procedure GetDirectoryListing(Const Dir,Pattern : String; Flags : TFnmFlags; List : TStrings);overload;

Var
  P     : PDirent;
  D     : PDirectoryStream;
  PP,PF : PChar;
  F     : Integer;

begin
  D:=OpenDir(Dir);
  PP:=PChar(Pattern);
  F:=FNtoFNFlags(Flags);
  Try
    P:=ReadDir(D);
    List.Clear;
    While P<>Nil do
      begin
      PF:=@p^.d_name[0];
      If Libc.FNMatch(PP,PF,F)=0 then
        List.Add(StrPas(PF));
      P:=ReadDir(D);
      end;
  Finally
    CloseDir(D);
  end;
end;

Procedure GetSubdirectories(Const Dir : String; List : TStrings);

Var
  P : PDirent;
  D : PDirectoryStream;
  S : String;
  StatInfo : TStatBuf;

begin
  D:=OpenDir(Dir);
  Try
    P:=ReadDir(D);
    List.Clear;
    While P<>Nil do
      begin
      S:=StrPas(@p^.d_name[0]);
      LStat(Dir+'/'+S,StatInfo);
      If S_ISDIR(StatInfo.st_mode) then
        List.Add(S);
      P:=ReadDir(D);
      end;
  Finally
    CloseDir(D);
  end;
end;

Function  StripTrailingSeparator(Const Dir : String) : String;

Var
  L : Integer;

begin
  Result:=Dir;
  L:=Length(result);
  If (L>1) and (Result[l]=PathSeparator) then
    SetLength(Result,L-1);
end;

Function  AddTraiLingSeparator(Const Dir : String) : String;

Var
  L : Integer;

begin
  Result:=Dir;
  L:=Length(Result);
  If (L>0) and (Result[l]<>PathSeparator) then
    Result:=Result+PathSeparator;
end;

Function  FileSizeToString(Size: Int64) : String;

Const
  Sizes : Array [0..4] of String =
     ('Bytes','Kb','Mb','Gb','Tb');
Var
    F : Double;
    I : longint;

begin
  If Size>1024 Then
    begin
    F:=Size;
    I:=0;
    While (F>1024) and (I<4) do
      begin
      F:=F / 1024;
      Inc(i);
      end;
    Result:=Format('%4.2f %s',[F,Sizes[i]]);
    end
  else
    Result:=Format('%d %s',[Size,Sizes[0]]);
end;

Function  SetMntEnt(FileName,Mode : String) : PIOFile;

begin
  Result:=Libc.setmntent(PChar(FileName),Pchar(Mode));
end;

Procedure Mount(Const Device,Directory,FileSystemType : String; Flags : Cardinal; Data: Pointer);

begin
  If Libc.Mount(PChar(Device),PChar(Directory),PChar(FileSystemType),Flags,Data)<>0 then
    CheckUnixError(Libc.errno);
end;

Procedure Umount(Const FileName);

begin
  If Libc.umount(PChar(FileName))<>0 then
    CheckUnixError(Libc.Errno);
end;

Function  FSTypeToString(FSType : Integer) : String;

begin
  Case FStype of
    $ADFF : Result:='affs';
    $137D : Result:='ext';
    $EF51,$EF53 : Result:='ext2';
    $F995E849 : Result := 'hpfs';
    $9660 : Result:='iso9660';
    $137F,$138F,$2468,$2478 : Result:='minix';
    $4d44 : Result:='msdos';
    $564c : Result:='ncp';
    $6969 : Result:='nfs';
    $9fa0 : Result:='proc';
    $517B : Result:='smb';
    $012FF7B4,$012FFB5,$012FFB6,$012FFB7 : Result:='xenix';
    $00011954 : Result:='ufs';
    $012FD16D : Result:='xia';
    $1CD1 : Result:='devpts';
    $5346544E : Result:='ntfs';
  else
    Result:=Format(SUnknownFileSystemType,[FStype]);
  end;  
end;

Procedure fcntl(Handle: Integer; Command: Integer; Var Lock: TFlock);

begin
  CheckUnixError(Libc.fcntl(Handle,Command,Lock));
end;

Procedure Dup2(Stream1,Stream2 : THandleStream); 

begin
  CheckUnixError(Libc.Dup2(Stream1.Handle,Stream2.Handle));
end;

Function Dup(Stream : THandleStream) : THandleStream;

begin
  Result:=ThandleStream.Create(CheckUnixError(Libc.Dup(Stream.Handle)));
end;


{ ---------------------------------------------------------------------
  TUnixFileStream implementation
  ---------------------------------------------------------------------}

Procedure TUnixFileStream.GetInfo(Var StatInfo: TStatBuf);

begin
  CheckUnixError(FStat(Handle,StatInfo));
end;

procedure TUnixFileStream.LockRegion(Cmd, LockType, Whence: Integer;
  Offset, Len: __off_t);

Var
  Lock : TFlock;

begin
  With Lock do
    begin
    L_type:=LockType;
    L_start:=Offset;
    L_Len:=Len;
    L_whence:=Whence;
    end;
  fcntl(Handle,cmd,Lock);
end;

procedure TUnixFileStream.ReadLock(Whence: Integer; Offset, Len: __off_t;
  Wait: Boolean);

begin
  If Wait then
    LockRegion(F_SETLKW,F_RDLCK,whence,offset,len)
  else
    LockRegion(F_SETLK,F_RDLCK,whence,offset,len)
end;

procedure TUnixFileStream.UnLock(Whence: Integer; Offset, Len: __off_t);
begin
  LockRegion(F_SETLK,F_UNLCK,whence,offset,len)
end;

procedure TUnixFileStream.WriteLock(Whence: Integer; Offset, Len: __off_t;
  Wait: Boolean);
begin
  If Wait then
    LockRegion(F_SETLKW,F_WRLCK,whence,offset,len)
  else
    LockRegion(F_SETLK,F_WRLCK,whence,offset,len)
end;

{ ---------------------------------------------------------------------
    Process utilities
  ---------------------------------------------------------------------}
  
function SetUID(UID: __uid_t):Boolean;

begin
  Result:=LibC.setuid(UID)=0;
end;

function SetEUID(UID: __uid_t):Boolean;

begin
  Result:=LibC.seteuid(UID)=0;
end;

function SetGID(GroupID: __gid_t):Boolean;

begin
  Result:=LibC.setgid(GroupID)=0;
end;

function SetEGID(GroupID: __gid_t):Boolean;

begin
  Result:=LibC.setegid(GroupID)=0;

end;

function SetREUID(RUID: __uid_t; EUID: __uid_t):Boolean;

begin
  Result:=LibC.setreuid(RUID,EUID)=0;
end;

function SetREGID(RGID: __gid_t; EGID: __gid_t):Boolean;

begin
  Result:=LibC.setregid(RGID,EGID)=0;
end;



Function GetGroups(var A : Array of __gid_t) : Integer;

begin
  Result:=LibC.GetGroups(High(A)+1,A);
end;

Function Group_member(GroupID : __gid_t) : Boolean;

begin
  Result:=LibC.group_member(GroupID)<>0;
end;

Function Fork : __pid_t;

begin
  Result:=CheckUnixError(LibC.Fork);
end;

Function wait(var Status : Integer) : pid_t;

begin
  Result:=Libc.wait(@Status);
end;

Function waitpid(PID : pid_t;var Status : Integer;options : Integer) : pid_t;

begin
  Result:=Libc.WaitPid(Pid,@Status,Options);
end;

Function ConvertStatusToString(Status : Integer) : String;

begin
  If WIfExited(Status) then
    If WExitStatus(Status)=0 then
      Result:=SNormalExit
    else
      Result:=Format(SNormalExitWithErrCode,[WExitStatus(Status)])
  else If WIfSIgnaled(Status) then
    Result:=Format(SSignalExit,[WTermSig(Status)])
  else if WIfStopped(Status) then
    Result:=Format(SStopped,[WStopSig(Status)])
  else
    Result:=Format(SErrUnknowStatusCode,[Status])
end;


Type
  TPCharArray = Array[Word] of pchar;
  PPCharArray = ^TPcharArray;


Function StringsToPCharList(Arg0 : String;List : TStrings) : PPChar;

Var
  I,Org : Integer;
  S : String;

begin
  I:=(List.Count)+1;
  If Arg0<>'' Then
    begin
    Inc(i);
    Org:=1;
    end
  else
    org:=0;
  GetMem(Result,I*sizeOf(PChar));
  PPCharArray(Result)^[List.Count+org]:=Nil;
  If Arg0<>'' Then
    PPCharArray(Result)^[0]:=StrNew(PChar(Arg0));
  For I:=0 to List.Count-1 do
    begin
    S:=List[i];
    PPCharArray(Result)^[i+org]:=StrNew(PChar(S));
    end;
end;

Procedure FreePCharList(List : PPChar);

Var
  I : integer;

begin
  I:=0;
  While List[i]<>Nil do
    begin
    StrDispose(List[i]);
    Inc(I);
    end;
  FreeMem(List);
end;

Procedure Execve(ProgName : String; Args,Env : TStrings);

Var
  ArgP,EnvP : PPChar;

begin
  ArgP:=StringsToPCharList(ExtractFileName(ProgName),Args);
  try
    EnvP:=StringsToPCharList('',Env);
    try
      CheckUnixError(Libc.execve(PChar(ProgName),ArgP,EnvP));
    finally
      FreePCharList(EnvP);
    end;
  finally
    FreePCharList(ArgP);
  end;
end;


Procedure Execv(ProgName : String; Args : TStrings);

Var
  ArgP : PPChar;

begin
  ArgP:=StringsToPCharList(ExtractFileName(ProgName),Args);
  try
    CheckUnixError(Libc.execv(PChar(ProgName),ArgP));
  finally
    FreePCharList(ArgP);
  end;
end;

Procedure Execvp(ProgName : String; Args : TStrings);

Var
  ArgP : PPChar;

begin
  ArgP:=StringsToPCharList(ExtractFileName(ProgName),Args);
  try
    CheckUnixError(Libc.execvp(PChar(ProgName),ArgP));
  finally
    FreePCharList(ArgP);
  end;
end;

Function CommandArgsToPCharList(Arg0 :String;Args : Array of string) : PPChar;

Var
  I,Org : Integer;

begin
  I:=High(Args)+2;
  If Arg0<>'' Then
    begin
    Inc(i);
    Org:=1;
    end
  else
    org:=0;
  GetMem(Result,I*sizeOf(PChar));
  PPCharArray(Result)^[i-1]:=Nil;
  If Arg0<>'' Then
    PPCharArray(Result)^[0]:=StrNew(PChar(Arg0));
  For I:=0 to High(Args) do
    PPCharArray(Result)^[i+org]:=StrNew(PChar(Args[i]));
end;

Procedure Execle(ProgName : String; Args : Array of string;Env : TStrings);

Var
  ArgP,EnvP : PPChar;

begin
  ArgP:=CommandArgsToPCharList(ExtractFileName(ProgName),Args);
  try
    EnvP:=StringsToPCharList('',Env);
    try
      CheckUnixError(Libc.execve(PChar(ProgName),ArgP,EnvP));
    finally
    FreePCharList(EnvP);
    end;
  finally
    FreePCharList(ArgP);
  end;
end;

Procedure Execl(ProgName : String; Args : Array of string);

Var
  ArgP : PPChar;

begin
  ArgP:=CommandArgsToPCharList(ExtractFileName(ProgName),Args);
  try
    CheckUnixError(Libc.execv(PChar(ProgName),ArgP));
  finally
    FreePCharList(ArgP);
  end;
end;

Procedure Execlp(ProgName : String; Args : Array of string);

Var
  ArgP : PPChar;

begin
  ArgP:=CommandArgsToPCharList(ExtractFileName(ProgName),Args);
  try
    CheckUnixError(Libc.execvp(PChar(ProgName),ArgP));
  finally
    FreePCharList(ArgP);
  end;
end;

{ ---------------------------------------------------------------------
    User/Group management routines.
  ---------------------------------------------------------------------}
  

Function getpwnam(Const UserName: String) : PPasswordRecord;

begin
  Result:=libc.getpwnam(Pchar(UserName));
end;

Procedure GetUserData(Const UserName : String; Var Data : TPasswordRecord);

Var P : PPasswordRecord;

begin
  P:=Getpwnam(UserName); 
  If P<>Nil then
    Data:=P^
  else
    Raise EUserLookupError.CreateFmt(ENoSuchUserName,[UserName]);
end;

Procedure GetUserData(Uid : Integer; Var Data : TPasswordRecord);

Var P : PPasswordRecord;

begin
  P:=Getpwuid(Uid); 
  If P<>Nil then
    Data:=P^
  else
    Raise EUserLookupError.CreateFmt(ENoSuchUserID,[Uid]);
end;

function GetUserName(UID : Integer) : String;

Var
  UserData : TPasswordRecord;

begin
  GetuserData(UID,UserData);   
  Result:=strpas(UserData.pw_Name);
end;

function  GetUserId(Const UserName : String) : Integer;

Var 
  UserData : TPasswordRecord;

begin
  GetUserData(UserName,UserData);
  Result:=UserData.pw_uid;
end;

function  GetUserGId(Const UserName : String) : Integer;

Var 
  UserData : TPasswordRecord;

begin
  GetUserData(UserName,UserData);
  Result:=UserData.pw_gid;
end;

function GetUserDir(Const UserName : String): String;

Var 
  UserData : TPasswordRecord;

begin
  GetUserData(UserName,UserData);
  Result:=strpas(UserData.pw_dir);
end;

function  GetUserDescription(Const UserName : String): String;

Var 
  UserData : TPasswordRecord;

begin
  GetUserData(UserName,UserData);
  Result:=strpas(UserData.pw_gecos);
end;

Procedure GetUserList(List : Tstrings);

begin
  GetUserList(List,False);
end;

Procedure GetUserList(List : TStrings; WithIDs : Boolean);

Var
  P : PPasswordRecord;

begin
  List.Clear;
  setpwent;
  try
    Repeat
      P:=getpwent;
      If P<>Nil then
        begin
        If WithIDs then
          List.Add(Format('%d=%s',[P^.pw_uid,strpas(p^.pw_name)]))
        else
          List.Add(strpas(p^.pw_name));  
        end;
    until (P=Nil); 
  finally
    endpwent;
  end;   
end;  

{ ---------------------------------------------------------------------
    Group Functions
  ---------------------------------------------------------------------}
  

Function  getgrnam(Const GroupName: String) : PGroup;

begin
  Result:=libc.getgrnam(Pchar(GroupName));
end;

Procedure GetGroupData(Const GroupName : String; Var Data : TGroup); overload;

Var P : PGroup;

begin
  P:=Getgrnam(GroupName); 
  If P<>Nil then
    Data:=P^
  else
    Raise EGroupLookupError.CreateFmt(ENoSuchGroupName,[GroupName]);
end;

Procedure GetGroupData(Gid : Integer; Var Data : TGroup); overload;

Var P : PGroup;

begin
  P:=Getgrgid(gid); 
  If P<>Nil then
    Data:=P^
  else
    Raise EGroupLookupError.CreateFmt(ENoSuchGroupID,[Gid]);
end;

function GetGroupName(GID : Integer) : String;

Var
  G : TGroup;

begin
  GetGroupData(Gid,G);
  Result:=StrPas(G.gr_name);
end;

function  GetGroupId(Const GroupName : String) : Integer;

Var
  G : TGroup;

begin
  GetGroupData(GroupName,G);
  Result:=G.gr_gid;
end;

Procedure GetGroupList(List : Tstrings);overload;

begin
  GetGroupList(List,False);
end;

Procedure GetGroupList(List : TStrings; WithIDs : Boolean);overload;

Var
  G : PGroup;

begin
  List.Clear;
  setgrent;
  try
    Repeat
      G:=getgrent;
      If G<>Nil then
        begin
        If WithIDs then
          List.Add(Format('%d=%s',[G^.gr_gid,strpas(G^.gr_name)]))
        else
          List.Add(strpas(G^.gr_name));  
        end;
    until (G=Nil); 
  finally
    endgrent;
  end;   
end;

Function PCharListToStrings(P : PPChar; List : TStrings) : Integer;

begin
  List.Clear;
  While P^<>Nil do
    begin
    List.Add(StrPas(P^));
    P:=PPChar(PChar(P)+SizeOf(PChar));
    end;
  Result:=List.Count;  
end;


Procedure GetGroupMembers(GID : Integer;List : TStrings);

Var 
  G : TGroup;

begin
  GetGroupData(GID,G);
  PCharListToStrings(G.gr_mem,List);
end;

Procedure GetGroupMembers(Const GroupName : String;List : TStrings);

Var 
  G : TGroup;

begin
  GetGroupData(GroupName,G);
  PCharListToStrings(g.gr_mem,List);
end;

{ Shadow password functions }

function getspnam(UserName : String): PPasswordFileEntry; 

begin
  result:=Libc.getspnam(Pchar(UserName));
end;

function sgetspent(Line : String): PPasswordFileEntry;

begin
  Result:=libc.sgetspent(Pchar(Line));
end;

Procedure GetUserShadowData(Const UserName : String; Var Data : TPasswordFileEntry);

Var 
  P : PPasswordFileEntry;

begin
  P:=getspnam(UserName);
  If P=Nil then
    If (GetUID<>0) and (GetEUID<>0) then
      Raise EShadowLookupError.Create(EShadowNotPermitted)
    else  
      Raise EShadowLookupError.CreateFmt(ENoShadowEntry,[UserName])
  else
    Data:=P^;
end;

Procedure GetUserShadowData(UID : Integer; Var Data : TPasswordFileEntry);

begin
  GetUserShadowData(GetUserName(UID),Data);
end;

{ Extra functions }  

Function GetUserGroup(Const UserName : String) : String;

begin
  GetGroupName(GetUserGid(UserName));
end;





end.