mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-02 23:53:44 +02:00
816 lines
21 KiB
PHP
816 lines
21 KiB
PHP
{
|
|
$Id$
|
|
This file is part of the Free Pascal run time library.
|
|
Copyright (c) 1999-2000 by Michael Van Canneyt,
|
|
member of 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.
|
|
|
|
**********************************************************************}
|
|
|
|
//- libc funktions
|
|
const _MKNOD_VER=2;
|
|
|
|
Function cFork:longint;cdecl; external name 'fork1'; // fork1 is better here then fork
|
|
Procedure cExecve(path:pchar;args:ppchar;ep:ppchar); cdecl; external name 'execve';
|
|
Function cWaitPid(Pid:longint;Status:pointer;Options:Longint):Longint; cdecl; external name 'waitpid';
|
|
Function cGetTimeOfDay(var tv:timeval;var tz:timezone):integer;cdecl;external name 'gettimeofday';
|
|
Function cNice(n:LongInt):LongInt; cdecl; external name 'nice';
|
|
Function cGetPid:LongInt;cdecl; external name 'getpid';
|
|
Function cGetPPid:LongInt;cdecl; external name 'getppid';
|
|
Function cGetUid:Longint;cdecl; external name 'getuid';
|
|
Function cGetEUid:Longint;cdecl; external name 'geteuid';
|
|
Function cGetGid:Longint;cdecl; external name 'getgid';
|
|
Function cGetEGid:Longint;cdecl; external name 'getgid';
|
|
Function cSetUid(aUID:longint):longint;cdecl; external name 'setuid';
|
|
Function cSetGid(aGID:longint):longint;cdecl; external name 'setuid';
|
|
function cSetreUid(aRealUID,aEffUid:Longint):Longint; cdecl; external name 'setreuid';
|
|
function cSetreGid(aRealGID,aEffGid:Longint):Longint; cdecl; external name 'setreuid';
|
|
Function cfTruncate(fd,size:longint):Longint;cdecl; external name 'ftruncate';
|
|
Function cfSync (fd : Longint) : Longint; cdecl; external name 'fsync';
|
|
Function cChmod(path:pathstr;Newmode:longint):Longint; cdecl; external name 'chmod';
|
|
Function cChown(path:pathstr;NewUid,NewGid:longint):Longint;cdecl; external name 'chown';
|
|
Function cUmask(Mask:Longint):Longint;cdecl;external name 'umask';
|
|
//Function cFlock (fd,mode : longint) : longint; cdecl; external name 'flock';
|
|
Function cDup(oldfile:longint):longint;cdecl;external name 'dup';
|
|
Function cDup2(oldfile,newfile:longint):longint;cdecl;external name 'dup2';
|
|
Function cGetPriority(Which,Who:LongInt):LongInt;cdecl; external name 'getpriority';
|
|
Function cSetPriority(Which:LongInt;Who:LongInt;What:LongInt):LongInt;cdecl; external name 'setpriority';
|
|
Function cFcntl(Fd:longint;Cmd:LongInt):LongInt;cdecl;external name 'fcntl';
|
|
Function cFcntlArg(Fd:longint;Cmd:LongInt; arg:LongInt):LongInt;cdecl;external name 'fcntl';
|
|
Function cAccess(Path:pCHar; mode:LongInt):LongInt; cdecl; external name 'access';
|
|
Function cPipe(var pip:tpipe):LongInt; cdecl; external name 'pipe';
|
|
Function cUtime(path:pchar; var utim:utimebuf):LongInt; cdecl; external name 'utime';
|
|
Function cSelect(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):LongInt;cdecl; external name 'select';
|
|
Function cKill(Pid:longint;Sig:longint):LongINt;cdecl; external name 'kill';
|
|
Function cIOCtl(Handle,Ndx: Longint;Data: Pointer):LongInt; cdecl; external name 'ioctl';
|
|
Function cAlarm(Sec : Longint) : longint;cdecl; external name 'alarm';
|
|
Function cmknod(Vers:LongInt;pathname:pchar;mode,dev:longint):longint; cdecl; external name '_xmknod';
|
|
Function clStat(Vers:LongInt; Filename:pchar;var Buffer: Stat):longint; cdecl; external name '_lxstat';
|
|
Function cfStatfs(fd:LongInt; var Info:StatFs):LongInt; cdecl; external name 'fstatvfs';
|
|
Function cStatfs(Filename:pchar;var Buffer: StatFs):longint; cdecl; external name 'statvfs';
|
|
function cMUnMap(p:pointer;size:longint):integer;cdecl;external name 'munmap';
|
|
function cNanoSleep(const req : timespec;var rem : timespec) : longint; cdecl;external name 'nanosleep';
|
|
function cPause:longint; cdecl; external name 'pause';
|
|
function cSigProcMask(How:longint;SSet,OldSSet:PSigSet):longint; cdecl; external name 'sigprocmask';
|
|
function cSigPending(var s:SigSet):integer;cdecl; external name 'sigpending';
|
|
function cSigSuspend(s:PSigSet):longint;cdecl;external name 'sigsuspend';
|
|
function _cSignal(Signum:longint;Handler:Longint):SignalHandler; cdecl; external name 'signal';
|
|
function cSysInfo(cmd:longint; buff:pchar; len:longint):longint; cdecl; external name 'sysinfo';
|
|
{$LinkLib rt} // nanosleep
|
|
|
|
procedure libcerrorfix(fl:boolean); inline;
|
|
|
|
begin
|
|
if fl then
|
|
begin
|
|
Linuxerror:=libcerrno;
|
|
errno:=liberrno;
|
|
end
|
|
else
|
|
begin
|
|
Linuxerror:=0;
|
|
ErrNo:=0;
|
|
end;
|
|
end;
|
|
|
|
|
|
Function Fork:longint;
|
|
{
|
|
This function issues the 'fork' System call. the program is duplicated in memory
|
|
and Execution continues in parent and child process.
|
|
In the parent process, fork returns the PID of the child. In the child process,
|
|
zero is returned.
|
|
A negative value indicates that an error has occurred, the error is returned in
|
|
LinuxError.
|
|
}
|
|
var r : LongInt;
|
|
begin
|
|
r:=cFork; Fork:=r;
|
|
libcerrorfix((r=-1));
|
|
end;
|
|
|
|
{ Solaris has no clone, there thread funktion (libthread), like thr_create, but they haven't
|
|
the same options with flags and return a TID istead of a PID.
|
|
If one is interestet he might look to a Hack for lxrun which is contributed as diff.
|
|
Allthough the lxrun-hack dos not work at all, it shows what to take care of }
|
|
|
|
function clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
|
|
var pid : Longint;
|
|
begin // Quick Hack, never tested, but should work if func does not believe on the Stack
|
|
if (pointer(func)=nil) or (sp=nil) then
|
|
begin
|
|
LinuxError:=Sys_EInval;
|
|
Errno:=sys_einval;
|
|
exit(-1);
|
|
end;
|
|
pid:=fork;
|
|
if (pid=0) then begin //Child
|
|
func(args) ;
|
|
ExitProcess(0);
|
|
end;
|
|
clone:=pid;
|
|
end;
|
|
|
|
|
|
Procedure Execve(path:pchar;args:ppchar;ep:ppchar);
|
|
{
|
|
Replaces the current program by the program specified in path,
|
|
arguments in args are passed to Execve.
|
|
environment specified in ep is passed on.
|
|
}
|
|
begin
|
|
cExecve(path,args,ep);
|
|
{ This only gets set when the call fails, otherwise we don't get here ! }
|
|
Linuxerror:=libcerrno;
|
|
errno:=libcerrno;
|
|
end;
|
|
|
|
|
|
Procedure Execve(path:pathstr;args:ppchar;ep:ppchar);
|
|
{
|
|
Replaces the current program by the program specified in path,
|
|
arguments in args are passed to Execve.
|
|
environment specified in ep is passed on.
|
|
}
|
|
begin
|
|
path:=path+#0; cExecve(@path[1],args,ep);
|
|
{ This only gets set when the call fails, otherwise we don't get here ! }
|
|
Linuxerror:=libcerrno;
|
|
errno:=libcerrno;
|
|
end;
|
|
|
|
|
|
Procedure ExitProcess(val:longint);external name '_exit'; // not 'exit' ('exit' close the shared handle)
|
|
|
|
|
|
Function WaitPid(Pid:longint;Status:pointer;Options:Longint):Longint;
|
|
{
|
|
Waits until a child with PID Pid exits, or returns if it is exited already.
|
|
Any resources used by the child are freed.
|
|
The exit status is reported in the adress referred to by Status. It should
|
|
be a longint.
|
|
}
|
|
begin
|
|
WaitPid:=cWaitPid(Pid,Status,Options); { =>PID, -1+errno=eintr: Signal, -1+errno, 0=Ok }
|
|
libcerrorfix(WaitPid=-1));
|
|
end;
|
|
|
|
|
|
|
|
Procedure GetTimeOfDay(var tv:timeval);
|
|
{
|
|
Get the number of seconds since 00:00, January 1 1970, GMT
|
|
the time NOT corrected any way
|
|
}
|
|
var tz : timezone;
|
|
r : Integer;
|
|
begin
|
|
r:=cGetTimeOfDay(tv,tz);
|
|
libcerrorfix (r=-1);
|
|
end;
|
|
|
|
Function GetTimeOfDay: longint;
|
|
{
|
|
Get the number of seconds since 00:00, January 1 1970, GMT
|
|
the time NOT corrected any way
|
|
}
|
|
var tz : timezone;
|
|
tv : timeval;
|
|
begin
|
|
libcerrorfix(cGetTimeOfDay(tv,tz)=-1);
|
|
GetTimeOfDay:=tv.sec;
|
|
end;
|
|
|
|
|
|
Function GetPriority(Which,Who:Integer):integer;
|
|
{
|
|
Get Priority of process, process group, or user.
|
|
Which : selects what kind of priority is used.
|
|
can be one of the following predefined Constants :
|
|
Prio_User.
|
|
Prio_PGrp.
|
|
Prio_Process.
|
|
Who : depending on which, this is , respectively :
|
|
Uid
|
|
Pid
|
|
Process Group id
|
|
Errors are reported in linuxerror _only_. (priority can be negative)
|
|
}
|
|
begin
|
|
errno:=0;
|
|
if (which<prio_process) or (which>prio_user) then
|
|
begin
|
|
{ We can save an interrupt here }
|
|
getpriority:=0;
|
|
linuxerror:=Sys_einval;
|
|
Errno:=sys_einval;
|
|
end
|
|
else
|
|
begin
|
|
GetPriority:=cGetPriority(Which,Who);
|
|
libcerrorfix(getpriority=-1);
|
|
end;
|
|
end;
|
|
|
|
|
|
Procedure SetPriority(Which:Integer;Who:Integer;What:Integer);
|
|
{
|
|
Set Priority of process, process group, or user.
|
|
Which : selects what kind of priority is used.
|
|
can be one of the following predefined Constants :
|
|
Prio_User.
|
|
Prio_PGrp.
|
|
Prio_Process.
|
|
Who : depending on value of which, this is, respectively :
|
|
Uid
|
|
Pid
|
|
Process Group id
|
|
what : A number between -20 and 20. -20 is most favorable, 20 least.
|
|
0 is the default.
|
|
}
|
|
var r : Integer;
|
|
begin
|
|
errno:=0;
|
|
if ((which<prio_process) or (which>prio_user)) or ((what<-20) or (what>20)) then
|
|
begin
|
|
linuxerror:=Sys_einval { We can save an interrupt here }
|
|
errno:=libcerrno;
|
|
end
|
|
else
|
|
begin
|
|
r:=cSetPriority(Which,Who,What);
|
|
libcerrorfix(r=-1);
|
|
end;
|
|
end;
|
|
|
|
Procedure Nice(N:integer);
|
|
{
|
|
Set process priority. A positive N means a lower priority.
|
|
A negative N decreases priority.
|
|
}
|
|
begin
|
|
libcerrorfix(cNice(n)=-1);
|
|
end;
|
|
|
|
|
|
Function GetPid:LongInt;
|
|
{
|
|
Get Process ID.
|
|
}
|
|
begin
|
|
GetPid:=cGetPid;
|
|
libcerrorfix(GetPID=-1);
|
|
end;
|
|
|
|
Function GetPPid:LongInt;
|
|
{
|
|
Get Process ID of parent process.
|
|
}
|
|
begin
|
|
GetPPid:=cGetPPid;
|
|
libcerrorfix(GetPPID=-1);
|
|
end;
|
|
|
|
|
|
Function GetUid:Longint;
|
|
{
|
|
Get User ID.
|
|
}
|
|
begin
|
|
GetUid:=cGetUid;
|
|
libcerrorfix (GetUid=-1);
|
|
end;
|
|
|
|
|
|
Function GetEUid:Longint;
|
|
{
|
|
Get _effective_ User ID.
|
|
}
|
|
begin
|
|
GetEUid:=cGetEUid;
|
|
libcerrorfix(GetEUid=-1);
|
|
end;
|
|
|
|
|
|
Function GetGid:Longint;
|
|
{
|
|
Get Group ID.
|
|
}
|
|
begin
|
|
GetGid:=cGetGid;
|
|
libcerrorfix(GetGid=-1);
|
|
end;
|
|
|
|
Function GetEGid:Longint;
|
|
{
|
|
Get _effective_ Group ID.
|
|
}
|
|
begin
|
|
GetEGid:=cGetEGid;
|
|
libcerrorfix (GetEGid=-1);
|
|
end;
|
|
|
|
// Set the real userid/groupid (uid/gid from calling process)
|
|
function SetUid(aUID:Longint):Boolean;
|
|
begin
|
|
SetUid:=(cSetUid(aUid)=0);
|
|
libcerrorfix( not(SetUid));
|
|
end;
|
|
|
|
function SetGid(aGID:Longint):Boolean;
|
|
begin
|
|
SetGid:=(cSetGid(aGid)=0);
|
|
libcerrorfix( not(SetGid));
|
|
end;
|
|
|
|
// Set the real and effective userid/groupid (like setuid/setgid bit in file permissions)
|
|
function SetreUid(aRealUID,aEffUid:Longint):Boolean;
|
|
begin
|
|
SetreUid:=(cSetreUid(aRealUID,aEffUID)=0);
|
|
libcerrorfix( not(SetreUid));
|
|
end;
|
|
|
|
function SetreUid(aUID:Longint):Boolean;
|
|
begin
|
|
SetreUid:=SetreUid(aUID,aUID);
|
|
end;
|
|
|
|
function SetreGid(aRealGid,aEffGid:Longint):Boolean; overload;
|
|
begin
|
|
SetreGid:=(cSetreUid(aRealGID,aEffGID)=0);
|
|
libcerrorfix(not(SetreGid));
|
|
end;
|
|
|
|
function SetreGid(aGid:Longint):Boolean;overload;
|
|
begin
|
|
SetreGid:=SetreGid(aGID,aGID);
|
|
end;
|
|
|
|
Function fdTruncate(fd,size:longint):boolean;
|
|
begin
|
|
fdTruncate:=cfTruncate(fd,size)<>-1;
|
|
libcerrorfix(not fdTruncate);
|
|
end;
|
|
|
|
Function fdFlush (fd : Longint) : Boolean;
|
|
begin
|
|
fdFlush:=cfSync(fd)<>-1;
|
|
libcerrorfix( not fdFlush);
|
|
end;
|
|
|
|
Function Fcntl(Fd:longint;Cmd:integer):integer;
|
|
{
|
|
Read or manipulate a file.(See also fcntl (2) )
|
|
Possible values for Cmd are :
|
|
F_GetFd,F_GetFl,F_GetOwn F_DUPFd, F_Dup2FD...
|
|
Errors are reported in Linuxerror;
|
|
If Cmd is different from the allowed values, linuxerror=Sys_eninval.
|
|
}
|
|
begin
|
|
// the retun is not compatible to the linux-definition (returning 0 on -1 (err)), but 0 may be a valid return
|
|
if (cmd in [F_GetFd,F_GetFl,F_GetOwn, {solaris:} F_DupFd]) then
|
|
begin
|
|
Fcntl:=cFcntl(fd,Cmd);
|
|
libcerrorfix(Fcntl=-1);
|
|
end
|
|
else
|
|
begin
|
|
linuxerror:=Sys_einval;
|
|
Errno:=sys_einval;
|
|
Fcntl:=-1;
|
|
end;
|
|
end;
|
|
|
|
Procedure Fcntl(Fd:longint;Cmd:Integer;Arg:Longint);
|
|
{
|
|
Read or manipulate a file. (See also fcntl (2) )
|
|
Possible values for Cmd are :
|
|
F_setFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkW,F_SetOwn;
|
|
Errors are reported in Linuxerror;
|
|
If Cmd is different from the allowed values, linuxerror=Sys_eninval.
|
|
F_DupFD is not allowed, due to the structure of Files in Pascal.
|
|
}
|
|
|
|
begin
|
|
if (cmd in [F_SetFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkw,F_SetOwn {Solaris:} ,F_Dup2Fd,F_FreeSp{,F_GetLk64,F_SetLk64,F_SetLkw64}]) then
|
|
begin
|
|
libcerrorfix( cFcntlArg(fd,Cmd,Arg)=-1);
|
|
end
|
|
else begin
|
|
linuxerror:=Sys_einval;
|
|
errno:=sys_einval;
|
|
end;
|
|
end;
|
|
|
|
|
|
Function Chmod(path:pathstr;Newmode:longint):Boolean;
|
|
{
|
|
Changes the permissions of a file.
|
|
}
|
|
begin
|
|
Chmod:=cChmod(path,NewMode)=0;
|
|
libcerrorfix( not Chmod);
|
|
end;
|
|
|
|
|
|
Function Chown(path:pathstr;NewUid,NewGid:longint):boolean;
|
|
{
|
|
Change the owner and group of a file.
|
|
A user can only change the group to a group of which he is a member.
|
|
The super-user can change uid and gid of any file.
|
|
}
|
|
begin
|
|
Chown:=cChown(path,NewUid,NewGid)=0;
|
|
libcerrorfix(not Chown);
|
|
end;
|
|
|
|
|
|
Function Utime(path:pathstr;utim:utimebuf):boolean;
|
|
begin
|
|
path:=path+#0;
|
|
UTime:=cUtime(@Path[1],utim)=0;
|
|
libcerrorfix( not UTime);
|
|
end;
|
|
|
|
|
|
Function Flock (fd,mode : longint) : boolean;
|
|
begin
|
|
FLock:=TRUE;
|
|
// FLock:=cFLock(fd,mode)=0;
|
|
libcerrorfix(not FLock);
|
|
end;
|
|
|
|
|
|
|
|
Function Fstat(Fd:Longint;var Info:stat):Boolean;
|
|
{
|
|
Get all information on a file descriptor, and return it in info.
|
|
}
|
|
begin
|
|
FStat:=Sys_fstat(fd,Info)=0;
|
|
libcerrorfix( not FStat);
|
|
end;
|
|
|
|
|
|
Function Lstat(Filename: PathStr;var Info:stat):Boolean;
|
|
{
|
|
Get all information on a link (the link itself), and return it in info.
|
|
}
|
|
begin
|
|
FileName:=FileName+#0;
|
|
LStat:=clstat(STAT_VERS,@FileName[1],Info)=0;
|
|
libcerrorfix( not LStat);
|
|
end;
|
|
|
|
|
|
|
|
Function FSStat(Path:Pathstr;Var Info:statfs):Boolean;
|
|
{
|
|
Get all information on a fileSystem, and return it in Info.
|
|
Path is the name of a file/directory on the fileSystem you wish to
|
|
investigate.
|
|
}
|
|
begin
|
|
path:=path+#0;
|
|
FSStat:=cstatfs(@path[1],Info)=0;
|
|
libcerrorfix(not FSStat);
|
|
end;
|
|
|
|
|
|
|
|
Function FSStat(Fd:Longint;Var Info:statfs):Boolean;
|
|
{
|
|
Get all information on a fileSystem, and return it in Info.
|
|
Fd is the file descriptor of a file/directory on the fileSystem
|
|
you wish to investigate.
|
|
}
|
|
begin
|
|
FSStat:=cfstatfs(fd,Info)=0;
|
|
libcerrorfix( not FSStat);
|
|
end;
|
|
|
|
|
|
|
|
Function Link(OldPath,NewPath:pathstr):boolean;
|
|
{
|
|
Proceduces a hard link from new to old.
|
|
In effect, new will be the same file as old.
|
|
}
|
|
begin
|
|
OldPath:=OldPath+#0; NewPath:=NewPath+#0;
|
|
Link:=Sys_SymLink(@OldPath[1],@NewPath[1])<>-1;
|
|
libcerrorfix( not Link);
|
|
end;
|
|
|
|
|
|
Function Umask(Mask:Integer):integer;
|
|
{
|
|
Sets file creation mask to (Mask and 0777 (octal) ), and returns the
|
|
previous value.
|
|
}
|
|
begin
|
|
Umask:=cUmask(Mask);
|
|
libcerrorfix (Umask=-1);
|
|
end;
|
|
|
|
|
|
Function Access(Path:Pathstr ;mode:integer):boolean;
|
|
{
|
|
Test users access rights on the specified file.
|
|
Mode is a mask xosisting of one or more of R_OK, W_OK, X_OK, F_OK.
|
|
R,W,X stand for read,write and Execute access, simultaneously.
|
|
F_OK checks whether the test would be allowed on the file.
|
|
i.e. It checks the search permissions in all directory components
|
|
of the path.
|
|
The test is done with the real user-ID, instead of the effective.
|
|
If access is denied, or an error occurred, false is returned.
|
|
If access is granted, true is returned.
|
|
Errors other than no access,are reported in linuxerror.
|
|
}
|
|
begin
|
|
path:=path+#0;
|
|
Access:=cAccess(@Path[1],mode)=0;
|
|
libcerrorfix( not Access);
|
|
end;
|
|
|
|
Function Dup(oldfile:longint;var newfile:longint):Boolean;
|
|
{
|
|
Copies the filedescriptor oldfile to newfile
|
|
}
|
|
begin
|
|
NewFile:=cDup(OldFile);
|
|
Dup:=(NewFile<>-1);
|
|
libcerrorfix( not Dup);
|
|
end;
|
|
|
|
Function Dup2(oldfile,newfile:longint):Boolean;
|
|
{
|
|
Copies the filedescriptor oldfile to newfile
|
|
}
|
|
begin
|
|
Dup2:=cDup2(OldFile,NewFile)<>-1;
|
|
libcerrorfix( not Dup2);
|
|
end;
|
|
|
|
|
|
Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint;
|
|
{
|
|
Select checks whether the file descriptor sets in readfs/writefs/exceptfs
|
|
have changed.
|
|
}
|
|
Var
|
|
SelectArray : Array[1..5] of longint;
|
|
begin
|
|
Select:=cSelect(N,readfds,writefds,exceptfds,TimeOut);
|
|
libcerrorfix( Select=-1);
|
|
end;
|
|
|
|
Function AssignPipe(var pipe_in,pipe_out:longint):boolean;
|
|
{
|
|
Sets up a pair of file variables, which act as a pipe. The first one can
|
|
be read from, the second one can be written to.
|
|
If the operation was unsuccesful, linuxerror is set.
|
|
}
|
|
var
|
|
pip : tpipe;
|
|
begin
|
|
AssignPipe:=cPipe(pip)=0;
|
|
if AssignPipe then begin
|
|
pipe_in:=pip[1];
|
|
pipe_out:=pip[2];
|
|
LinuxError:=0;
|
|
Errno:=0;
|
|
end
|
|
else
|
|
begin
|
|
LinuxError:=libcErrNo;
|
|
Errno:=libcerrno;
|
|
end;
|
|
end;
|
|
|
|
Function PClose(Var F:text) :longint;
|
|
var
|
|
pl : ^longint;
|
|
begin
|
|
Sys_Close(Textrec(F).Handle);
|
|
{ closed our side, Now wait for the other - this appears to be needed ?? }
|
|
pl:=@(textrec(f).userdata[2]);
|
|
pclose:=WaitProcess(pl^);
|
|
end;
|
|
|
|
|
|
Function PClose(Var F:file) : longint;
|
|
var
|
|
pl : ^longint;
|
|
begin
|
|
Sys_Close(Filerec(F).Handle);
|
|
{ closed our side, Now wait for the other - this appears to be needed ?? }
|
|
pl:=@(filerec(f).userdata[2]);
|
|
pclose:=WaitProcess(pl^);
|
|
end;
|
|
|
|
|
|
Function Sysinfo(var Info:TSysinfo):Boolean; // ToDO
|
|
{
|
|
Get system info
|
|
(Mvdv:Linux specific, not implemented under FreeBSD too.
|
|
Under FreeBSD I will simply implement a sysctl unit)
|
|
}
|
|
var
|
|
regs : SysCallregs;
|
|
Begin
|
|
(* regs.reg2:=longint(@info);
|
|
Sysinfo:=SysCall(SysCall_nr_Sysinfo,regs)=0;*)
|
|
WriteLN('SysInfo not supported yet ');
|
|
End;
|
|
|
|
|
|
Function mkFifo(pathname:string;mode:longint):boolean;
|
|
begin
|
|
pathname:=pathname+#0;
|
|
mode:=mode or STAT_IFIFO;
|
|
mkFifo:=cmknod(_MKNOD_VER,@pathname[1],mode,0)=0;
|
|
libcerrorfix(not mkFifo);
|
|
end;
|
|
|
|
{
|
|
Function Uname(var unamerec:utsname):Boolean; // ToDo
|
|
{
|
|
Get machine's names
|
|
}
|
|
var
|
|
regs : SysCallregs;
|
|
Begin
|
|
Errno:=0;
|
|
cSysInfo(SI_SYSNAME,@unamerec.sysname,SizeOf(unamerec.sysname));
|
|
cSysInfo(SI_HOSTNAME,@unamerec.nodename,SizeOf(unamerec.nodename));
|
|
cSysInfo(SI_RELEASE,@unamerec.release,SizeOf(unamerec.release));
|
|
cSysInfo(SI_VERSION,@unamerec.version,SizeOf(unamerec.version));
|
|
cSysInfo(SI_MACHINE,@unamerec.machine,SizeOf(unamerec.machine));
|
|
cSysInfo(SI_SRPC_DOMAIN,@unamerec.domainname,SizeOf(unamerec.domainname));
|
|
LinuxError:=Errno;
|
|
End;
|
|
}
|
|
|
|
Function Kill(Pid:longint;Sig:longint):integer;
|
|
{
|
|
Send signal 'sig' to a process, or a group of processes.
|
|
If Pid > 0 then the signal is sent to pid
|
|
pid=-1 to all processes except process 1
|
|
pid < -1 to process group -pid
|
|
Return value is zero, except for case three, where the return value
|
|
is the number of processes to which the signal was sent.
|
|
}
|
|
begin
|
|
Kill:=cKill(PID,Sig);
|
|
libcerrorfix( Kill=-1);
|
|
if kill<0 then Kill:=0; // from the linux source
|
|
end;
|
|
|
|
|
|
|
|
Procedure SigProcMask(How:longint;SSet,OldSSet:PSigSet); //ToDo
|
|
{
|
|
Change the list of currently blocked signals.
|
|
How determines which signals will be blocked :
|
|
SigBlock : Add SSet to the current list of blocked signals
|
|
SigUnBlock : Remove the signals in SSet from the list of blocked signals.
|
|
SigSetMask : Set the list of blocked signals to SSet
|
|
if OldSSet is non-null, the old set will be saved there.
|
|
}
|
|
begin
|
|
libcerrorfix( cSigProcMask(How,SSet,OldSSet)=0);
|
|
end;
|
|
|
|
|
|
Function SigPending:SigSet;
|
|
{
|
|
Allows examination of pending signals. The signal mask of pending
|
|
signals is set in SSet
|
|
}
|
|
Var
|
|
dummy : Sigset;
|
|
begin
|
|
libcerrorfix(cSigPending(dummy)=0);
|
|
Sigpending:=dummy;
|
|
end;
|
|
|
|
|
|
Procedure SigSuspend(Mask:Sigset); // ToDo
|
|
{
|
|
Set the signal mask with Mask, and suspend the program until a signal
|
|
is received.
|
|
}
|
|
begin
|
|
libcerrorfix (cSigSuspend(@Mask)=0);
|
|
end;
|
|
|
|
Function Signal(Signum:longint;Handler:SignalHandler):SignalHandler;
|
|
{
|
|
Install a new handler for signal Signum.
|
|
The old signal handler is returned.
|
|
This call does, in fact, the same as SigAction.
|
|
}
|
|
var
|
|
r :LongInt;
|
|
begin
|
|
Signal:=NIL;
|
|
r:=longint(_cSignal(Signum,longint(Handler)));
|
|
if (r=-1) then begin
|
|
Signal:=nil;
|
|
LinuxError:=libcerrno;
|
|
Errno:=libcerrno;
|
|
end
|
|
else
|
|
begin
|
|
Signal:=signalhandler(r);
|
|
LinuxError:=0;
|
|
ErrNo:=0;
|
|
end;
|
|
exit;
|
|
end;
|
|
|
|
|
|
Function Alarm(Sec : Longint) : longint;
|
|
begin
|
|
Alarm:=cAlarm(Sec);
|
|
LinuxError:=0; // no error
|
|
Errno:=0;
|
|
end;
|
|
|
|
Procedure Pause;
|
|
begin cPause;end;
|
|
|
|
|
|
Function NanoSleep(const req : timespec;var rem : timespec) : longint;
|
|
begin
|
|
NanoSleep:=cNanoSleep(req,rem);
|
|
Libcerrorfix( NanoSleep=-1);
|
|
end;
|
|
|
|
|
|
Function IOCtl(Handle,Ndx: Longint;Data: Pointer):boolean;
|
|
{
|
|
Interface to Unix ioctl call.
|
|
Performs various operations on the filedescriptor Handle.
|
|
Ndx describes the operation to perform.
|
|
Data points to data needed for the Ndx function. The structure of this
|
|
data is function-dependent.
|
|
}
|
|
begin
|
|
IOCtl:=cIOCtl(Handle,Ndx,Data)<>-1;
|
|
libcerrorfix( not IOCtl);
|
|
end;
|
|
|
|
function MUnMap (P : Pointer; Size : Longint) : Boolean;
|
|
begin
|
|
MUnMap:=cMUnMap(p,size)=0;
|
|
libcerrorfix( not MUnMap);
|
|
end;
|
|
|
|
{--------------------------------
|
|
Port IO functions
|
|
--------------------------------}
|
|
{
|
|
// all of them has to be checked for soalris
|
|
Function IOperm (From,Num : Cardinal; Value : Longint) : boolean;
|
|
{
|
|
Set permissions on NUM ports starting with port FROM to VALUE
|
|
this works ONLY as root.
|
|
}
|
|
|
|
Var
|
|
Sr : Syscallregs;
|
|
begin
|
|
(* Sr.Reg2:=From;
|
|
Sr.Reg3:=Num;
|
|
Sr.Reg4:=Value;
|
|
IOPerm:=Syscall(Syscall_nr_ioperm,sr)=0;
|
|
LinuxError:=Errno;*)
|
|
WriteLN('IOperm not suppoted yet');
|
|
end;
|
|
|
|
Function IoPL(Level : longint) : Boolean;
|
|
|
|
Var
|
|
Sr : Syscallregs;
|
|
begin
|
|
(* Sr.Reg2:=Level;
|
|
IOPL:=Syscall(Syscall_nr_iopl,sr)=0;
|
|
LinuxError:=Errno;*)
|
|
WriteLN('IoPL not suppoted yet');
|
|
end;
|
|
|
|
{
|
|
$Log$
|
|
Revision 1.3 2002-09-07 16:01:26 peter
|
|
* old logs removed and tabs fixed
|
|
|
|
}
|