From 3e755a3222ad047dc6338691764e18bfdaeffd9c Mon Sep 17 00:00:00 2001 From: michael Date: Fri, 15 Aug 2003 19:01:07 +0000 Subject: [PATCH] + Initial import of unixutils.pp --- packages/base/libc/Makefile | 4 +- packages/base/libc/Makefile.fpc | 2 +- packages/base/libc/unixutils.pp | 1191 +++++++++++++++++++++++++++++++ 3 files changed, 1194 insertions(+), 3 deletions(-) create mode 100644 packages/base/libc/unixutils.pp diff --git a/packages/base/libc/Makefile b/packages/base/libc/Makefile index 7e4e019e04..d16b527dc1 100644 --- a/packages/base/libc/Makefile +++ b/packages/base/libc/Makefile @@ -1,5 +1,5 @@ # -# Don't edit, this file is generated by FPCMake Version 1.1 [2003/06/14] +# Don't edit, this file is generated by FPCMake Version 1.1 [2003/06/26] # default: all MAKEFILETARGETS=linux @@ -205,7 +205,7 @@ endif PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra) override PACKAGE_NAME=libc override PACKAGE_VERSION=1.0.8 -override TARGET_UNITS+=kerneldefs kernelioctl libc +override TARGET_UNITS+=kerneldefs kernelioctl libc unixutils override INSTALL_FPCPACKAGE=y ifdef REQUIRE_UNITSDIR override UNITSDIR+=$(REQUIRE_UNITSDIR) diff --git a/packages/base/libc/Makefile.fpc b/packages/base/libc/Makefile.fpc index 7a5da6d63c..3e2e25dbd5 100644 --- a/packages/base/libc/Makefile.fpc +++ b/packages/base/libc/Makefile.fpc @@ -7,7 +7,7 @@ name=libc version=1.0.8 [target] -units=kerneldefs kernelioctl libc +units=kerneldefs kernelioctl libc unixutils [require] libc=y diff --git a/packages/base/libc/unixutils.pp b/packages/base/libc/unixutils.pp new file mode 100644 index 0000000000..519f9c497f --- /dev/null +++ b/packages/base/libc/unixutils.pp @@ -0,0 +1,1191 @@ +{ + $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.